Skip to content
Snippets Groups Projects
Commit d52a7640 authored by Lionel GUEZ's avatar Lionel GUEZ
Browse files

Merge branch 'master' into two_programs.

parents 056a838d 4ad2bfc8
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 160 additions and 128 deletions
Documentation_texfol/Graphiques/test_max_speed_contour_ssh.pdf 0 → 100644
+ 0
− 0
View file @ d52a7640
File added
Documentation_texfol/documentation.tex
+ 12
− 0
View file @ d52a7640
......@@ -884,6 +884,18 @@ max\_radius : un facteur \np{2.7} environ entre max\_radius = 12 et
max\_radius = 20. Le temps d'exécution semble donc proportionnel à
max\_radius$^2$, ce qui peut se comprendre.
Test de
\verb+max_speed_contour_ssh+. Cf. figure~\ref{fig:test_max_speed_contour_ssh}.
\begin{figure}[htbp]
\centering
\includegraphics[width=\textwidth]{test_max_speed_contour_ssh}
\caption{SSH pour le test de max\_speed\_contour\_ssh. Données du 29
novembre 2015. La région est à l'embouchure de l'Amazone.}
\label{fig:test_max_speed_contour_ssh}
\end{figure}
Bizarrement, la vitesse n'est pas définie à certains points alors
qu'il n'y a pas de terres.
\section{Recouvrements}
\subsection{Divers}
......
GNUmakefile
+ 15
− 12
View file @ d52a7640
......@@ -9,27 +9,29 @@ VPATH += ${makefile_dir}/Tests
src_test_local_extrema = test_local_extrema.f local_extrema.f
src_test_get_1_outerm = good_contour.f test_get_1_outerm.f derived_types.f get_1_outerm.f outermost_possible_level.f spherical_polyline_area.f
src_test_get_1_outerm = good_contour.f test_get_1_outerm.f derived_types.f get_1_outerm.f outermost_possible_level.f spher_polyline_area.f
src_test_set_max_speed = test_set_max_speed.f derived_types.f set_max_speed.f good_contour.f max_speed_contour_ssh.f mean_speed.f spherical_polyline_area.f inside_4.f
src_test_set_max_speed = test_set_max_speed.f derived_types.f set_max_speed.f good_contour.f max_speed_contour_ssh.f mean_speed.f spher_polyline_area.f inside_4.f
src_test_get_snapshot = test_get_snapshot.f write_eddy.f local_extrema.f set_max_speed.f outermost_possible_level.f get_1_outerm.f max_speed_contour_ssh.f good_contour.f spherical_polyline_area.f mean_speed.f inside_4.f set_all_outerm.f derived_types.f init_shapefiles.f nearby_extr.f get_var.f
src_test_get_snapshot = test_get_snapshot.f write_eddy.f local_extrema.f set_max_speed.f outermost_possible_level.f get_1_outerm.f max_speed_contour_ssh.f good_contour.f spher_polyline_area.f mean_speed.f inside_4.f set_all_outerm.f derived_types.f init_shapefiles.f nearby_extr.f get_var.f
src_test_set_all_outerm = test_set_all_outerm.f derived_types.f set_all_outerm.f local_extrema.f get_1_outerm.f good_contour.f spherical_polyline_area.f nearby_extr.f get_var.f
src_test_set_all_outerm = test_set_all_outerm.f derived_types.f set_all_outerm.f local_extrema.f get_1_outerm.f good_contour.f spher_polyline_area.f nearby_extr.f get_var.f
src_test_weight = test_weight.f weight.f derived_types.f
src_test_spherical_polygon_area = spherical_polygon_area.f test_spherical_polygon_area.f spherical_polyline_area.f
src_test_spher_polygon_area = spher_polygon_area.f test_spher_polygon_area.f spher_polyline_area.f
src_test_read_eddy = test_read_eddy.f derived_types.f init_shapefiles.f read_eddy.f write_eddy.f read_field_indices.f
src_test_read_snapshot = test_read_snapshot.f derived_types.f init_shapefiles.f read_snapshot.f write_eddy.f read_eddy.f read_field_indices.f
src_test_successive_overlap = test_successive_overlap.f derived_types.f successive_overlap.f read_snapshot.f spherical_polygon_area.f spherical_polyline_area.f weight.f read_eddy.f read_field_indices.f
src_test_successive_overlap = test_successive_overlap.f derived_types.f successive_overlap.f read_snapshot.f spher_polygon_area.f spher_polyline_area.f weight.f read_eddy.f read_field_indices.f
src_test_nearby_extr = test_nearby_extr.f nearby_extr.f derived_types.f
sources := $(sort ${src_test_local_extrema} ${src_test_get_1_outerm} ${src_test_set_max_speed} ${src_test_get_snapshot} ${src_test_set_all_outerm} ${src_test_weight} ${src_test_spherical_polygon_area} ${src_test_read_eddy} ${src_test_read_snapshot} ${src_test_successive_overlap} ${src_test_nearby_extr}) test_good_contour.f test_inside_4.f test_max_speed_contour_ssh.f test_mean_speed.f test_spherical_polyline_area.f
src_test_max_speed_contour_ssh = test_max_speed_contour_ssh.f max_speed_contour_ssh.f get_var.f
sources := $(sort ${src_test_local_extrema} ${src_test_get_1_outerm} ${src_test_set_max_speed} ${src_test_get_snapshot} ${src_test_set_all_outerm} ${src_test_weight} ${src_test_spher_polygon_area} ${src_test_read_eddy} ${src_test_read_snapshot} ${src_test_successive_overlap} ${src_test_nearby_extr} ${src_test_max_speed_contour_ssh}) test_good_contour.f test_inside_4.f test_mean_speed.f test_spher_polyline_area.f
lib_list = GPC_F contour_531 numer_rec_95 GPC shapelib_03 netcdf95 geometry jumble netcdff fortrangis shp fortranc nr_util
......@@ -41,15 +43,16 @@ obj_test_set_max_speed := $(src_test_set_max_speed:.f=.o)
obj_test_get_snapshot := $(src_test_get_snapshot:.f=.o)
obj_test_set_all_outerm := $(src_test_set_all_outerm:.f=.o)
obj_test_weight := $(src_test_weight:.f=.o)
obj_test_spherical_polygon_area := $(src_test_spherical_polygon_area:.f=.o)
obj_test_spher_polygon_area := $(src_test_spher_polygon_area:.f=.o)
obj_test_read_eddy := $(src_test_read_eddy:.f=.o)
obj_test_read_snapshot := $(src_test_read_snapshot:.f=.o)
obj_test_successive_overlap := $(src_test_successive_overlap:.f=.o)
obj_test_nearby_extr := $(src_test_nearby_extr:.f=.o)
obj_test_max_speed_contour_ssh := $(src_test_max_speed_contour_ssh:.f=.o)
objects := $(sources:.f=.o)
execut = test_good_contour test_inside_4 test_get_1_outerm test_local_extrema test_max_speed_contour_ssh test_mean_speed test_set_max_speed test_get_snapshot test_set_all_outerm test_weight test_spherical_polyline_area test_spherical_polygon_area test_read_eddy test_read_snapshot test_successive_overlap test_nearby_extr
execut = test_good_contour test_inside_4 test_get_1_outerm test_local_extrema test_max_speed_contour_ssh test_mean_speed test_set_max_speed test_get_snapshot test_set_all_outerm test_weight test_spher_polyline_area test_spher_polygon_area test_read_eddy test_read_snapshot test_successive_overlap test_nearby_extr
# 3. Compiler-dependent part
......@@ -63,7 +66,7 @@ endif
all: ${execut} log
test_get_1_outerm: ${obj_test_get_1_outerm}
test_set_max_speed: ${obj_test_set_max_speed}
test_max_speed_contour_ssh: max_speed_contour_ssh.o
test_max_speed_contour_ssh: ${obj_test_max_speed_contour_ssh}
test_good_contour: good_contour.o
test_inside_4: inside_4.o
test_local_extrema: ${obj_test_local_extrema}
......@@ -71,8 +74,8 @@ test_mean_speed: mean_speed.o
test_get_snapshot: ${obj_test_get_snapshot}
test_set_all_outerm: ${obj_test_set_all_outerm}
test_weight: ${obj_test_weight}
test_spherical_polyline_area: spherical_polyline_area.o
test_spherical_polygon_area: ${obj_test_spherical_polygon_area}
test_spher_polyline_area: spher_polyline_area.o
test_spher_polygon_area: ${obj_test_spher_polygon_area}
test_read_eddy: ${obj_test_read_eddy}
test_read_snapshot: ${obj_test_read_snapshot}
test_successive_overlap: ${obj_test_successive_overlap}
......
Tests/Input/huv_2015_11_29.nc 0 → 100644
+ 0
− 0
View file @ d52a7640
File added
Tests/Input/max_speed_contour_ssh_nml.txt deleted 100644 → 0
+ 0
− 2
View file @ 056a838d
! direction = 2 with 2006_01_01 data
&main_nml IND_EXTR= 4,14 RADIUS= 3/
Tests/short_tests.json
+ 17
− 10
View file @ d52a7640
......@@ -73,17 +73,24 @@
},
{
"args" : ["$compil_prod_dir/test_max_speed_contour_ssh",
"$large_input_dir/h_2006_01_01.nc",
"$large_input_dir/uv_2006_01_01.nc"],
"$input_dir/h_region_1.nc", "$input_dir/uv_region_1.nc"],
"title" : "Max_speed_contour_ssh",
"input" : "&main_nml /\n"
},
{
"args" : ["$compil_prod_dir/test_max_speed_contour_ssh",
"$large_input_dir/h_2006_01_01.nc",
"$large_input_dir/uv_2006_01_01.nc"],
"$input_dir/h_region_1.nc", "$input_dir/uv_region_1.nc"],
"title" : "Max_speed_contour_ssh_north",
"stdin_filename" : "$input_dir/max_speed_contour_ssh_nml.txt"
"input" : "&main_nml IND_EXTR= 4,14/\n",
"description": "direction = 2"
},
{
"args" : ["$compil_prod_dir/test_max_speed_contour_ssh",
"$input_dir/huv_2015_11_29.nc",
"$input_dir/huv_2015_11_29.nc"],
"title" : "Max_speed_contour_ssh_missing",
"input" : "&main_nml IND_EXTR= 3, 4/\n",
"description": "Missing value in speed."
},
{
"args" : "$compil_prod_dir/test_mean_speed",
......@@ -179,16 +186,16 @@
},
{"args": "$compil_prod_dir/test_weight", "title": "Weight"},
{
"args": "$compil_prod_dir/test_spherical_polyline_area",
"title": "Spherical_polyline_area"
"args": "$compil_prod_dir/test_spher_polyline_area",
"title": "Spher_polyline_area"
},
{
"args": ["$compil_prod_dir/test_spherical_polygon_area",
"args": ["$compil_prod_dir/test_spher_polygon_area",
"$input_dir/triangle"],
"title": "Spherical_polygon_area"
"title": "Spher_polygon_area"
},
{
"args": ["$compil_prod_dir/test_spherical_polygon_area",
"args": ["$compil_prod_dir/test_spher_polygon_area",
"$input_dir/tri_square_hole"],
"title": "Area_multi_polygon",
"description": "Area of a multipolygon, with a hole in one polygon."
......
Tests/test_get_snapshot.f
+ 3
− 2
View file @ d52a7640
......@@ -124,8 +124,9 @@ program test_get_snapshot
new_fill_value = ieee_value(0., IEEE_QUIET_NAN))
call get_var(periodic, max_radius(1), v, ncid, nlon, k, name = "v", &
new_fill_value = ieee_value(0., IEEE_QUIET_NAN))
! (We will need quiet NaNs rather the original fill values for u
! and v when we compute the max-speed contours.)
! (We will need quiet NaNs rather the original fill values for u and
! v when we compute the max-speed contours and when we search the
! ssh of max-speed contours.)
call nf95_close(ncid)
call set_all_outerm(s, min_amp, max_radius, step, periodic, ssh, &
......
Tests/test_max_speed_contour_ssh.f
+ 23
− 24
View file @ d52a7640
program test_max_speed_contour_ssh
use, intrinsic:: ieee_arithmetic, only: ieee_value, IEEE_QUIET_NAN
use, intrinsic:: ISO_FORTRAN_ENV
! Libraries:
use jumble, only: get_command_arg_dyn
use netcdf, only: nf90_nowrite
use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var
use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, nf95_gw_var
use nr_util, only: assert
use get_var_m, only: get_var
use max_speed_contour_ssh_m, only: max_speed_contour_ssh
implicit none
integer:: ilon_llc = 21, ilat_llc = 215 ! lower left corner
integer:: ilon_urc = 49, ilat_urc = 231 ! upper right corner
integer n_lon, n_lat
integer nlon, nlat
character(len = :), allocatable:: adt_file, velocity_file
integer ncid, varid
real, allocatable:: ssh(:, :) ! (n_lon, n_lat) sea-surface height, in m
real, allocatable:: u(:, :), v(:, :) ! (n_lon, n_lat) wind, in m s-1
integer:: ind_extr(2) = [19, 11] ! indices in the two dimensions of
! the extremum
real, allocatable:: ssh(:, :, :) ! (nlon, nlat, 1) sea-surface height, in m
real, allocatable:: u(:, :), v(:, :) ! (nlon, nlat) wind, in m s-1
integer:: ind_extr(2) = [19, 11]
! indices in the two dimensions of the extremum
integer:: radius = 3
namelist /main_nml/ ilon_llc, ilat_llc, ilon_urc, ilat_urc, ind_extr, radius
namelist /main_nml/ ind_extr, radius
!----------------------------------------------------------------
......@@ -38,31 +40,28 @@ program test_max_speed_contour_ssh
read(unit = *, nml = main_nml)
write(unit = *, nml = main_nml)
n_lon = ilon_urc - ilon_llc + 1
n_lat = ilat_urc - ilat_llc + 1
allocate(ssh(n_lon, n_lat))
print *, "Reading from ", adt_file, "..."
call nf95_open(adt_file, nf90_nowrite, ncid)
call nf95_inq_varid(ncid, "adt", varid)
call nf95_get_var(ncid, varid, ssh, start = [ilon_llc, ilat_llc, 1])
call nf95_gw_var(ncid, varid, ssh)
call nf95_close(ncid)
allocate(u(n_lon, n_lat), v(n_lon, n_lat))
nlon = size(ssh, 1)
nlat = size(ssh, 2)
allocate(u(nlon, nlat), v(nlon, nlat))
print *, "Reading from ", velocity_file, "..."
call nf95_open(velocity_file, nf90_nowrite, ncid)
call nf95_inq_varid(ncid, "u", varid)
call nf95_get_var(ncid, varid, u, start = [ilon_llc, ilat_llc, 1])
call nf95_inq_varid(ncid, "v", varid)
call nf95_get_var(ncid, varid, v, start = [ilon_llc, ilat_llc, 1])
call get_var(periodic = .false., max_rad_lon = 0, values = u, ncid = ncid, &
nlon = nlon, k = 1, name = "u", &
new_fill_value = ieee_value(0., IEEE_QUIET_NAN))
call get_var(periodic = .false., max_rad_lon = 0, values = v, ncid = ncid, &
nlon = nlon, k = 1, name = "v", &
new_fill_value = ieee_value(0., IEEE_QUIET_NAN))
call nf95_close(ncid)
print *, "level = ", max_speed_contour_ssh(ssh, u, v, ind_extr, radius)
print *, "level = ", max_speed_contour_ssh(ssh(:, :, 1), u, v, ind_extr, &
radius)
end program test_max_speed_contour_ssh
Tests/test_spherical_polygon_area.f → Tests/test_spher_polygon_area.f
+ 4
− 4
View file @ d52a7640
program test_spherical_polygon_area
program test_spher_polygon_area
! Libraries:
use gpc_f, only: polygon, shpobj2pol
......@@ -7,7 +7,7 @@ program test_spherical_polygon_area
use shapelib, only: shpfileobject, shpobject, shpclose, shpdestroyobject
use shapelib_03, only: shp_open_03, shp_read_object_03, shp_get_info_03
use spherical_polygon_area_m, only: spherical_polygon_area
use spher_polygon_area_m, only: spher_polygon_area
implicit none
......@@ -49,6 +49,6 @@ program test_spherical_polygon_area
forall (j = 1:merged_p%nparts) &
merged_p%part(j)%points = merged_p%part(j)%points * deg_to_rad
print *, "Area = ", spherical_polygon_area(merged_p) / 1e6, "km2"
print *, "Area = ", spher_polygon_area(merged_p) / 1e6, "km2"
end program test_spherical_polygon_area
end program test_spher_polygon_area
Tests/test_spherical_polyline_area.f → Tests/test_spher_polyline_area.f
+ 4
− 4
View file @ d52a7640
program test_spherical_polyline_area
program test_spher_polyline_area
! Libraries:
use contour_531, only: polyline
use nr_util, only: deg_to_rad
use spherical_polyline_area_m, only: spherical_polyline_area
use spher_polyline_area_m, only: spher_polyline_area
implicit none
......@@ -17,7 +17,7 @@ program test_spherical_polyline_area
points(:, 3) = [0., 30. * deg_to_rad]
points(:, 4) = points(:, 1)
print *, "Area = ", spherical_polyline_area(polyline(n_points = 4, &
print *, "Area = ", spher_polyline_area(polyline(n_points = 4, &
closed = .true., points = points)) / 1e6, "km2"
end program test_spherical_polyline_area
end program test_spher_polyline_area
depend.mk
+ 8
− 7
View file @ d52a7640
get_1_outerm.o : spherical_polyline_area.o good_contour.o derived_types.o
get_1_outerm.o : spher_polyline_area.o good_contour.o derived_types.o
max_speed_contour_ssh.o : derived_types.o
nearby_extr.o : derived_types.o
read_eddy.o : read_field_indices.o derived_types.o
read_snapshot.o : read_field_indices.o read_eddy.o derived_types.o
set_all_outerm.o : local_extrema.o nearby_extr.o get_1_outerm.o derived_types.o
set_max_speed.o : spherical_polyline_area.o mean_speed.o max_speed_contour_ssh.o inside_4.o good_contour.o derived_types.o
spherical_polygon_area.o : spherical_polyline_area.o
successive_overlap.o : weight.o spherical_polyline_area.o spherical_polygon_area.o derived_types.o
set_max_speed.o : spher_polyline_area.o mean_speed.o max_speed_contour_ssh.o inside_4.o good_contour.o derived_types.o
spher_polygon_area.o : spher_polyline_area.o
successive_overlap.o : weight.o spher_polyline_area.o spher_polygon_area.o derived_types.o
test_get_1_outerm.o : get_1_outerm.o derived_types.o
test_get_snapshot.o : write_eddy.o set_max_speed.o set_all_outerm.o nearby_extr.o init_shapefiles.o get_var.o derived_types.o
test_local_extrema.o : local_extrema.o
test_max_speed_contour_ssh.o : max_speed_contour_ssh.o get_var.o
test_nearby_extr.o : nearby_extr.o derived_types.o
test_read_eddy.o : write_eddy.o read_field_indices.o read_eddy.o init_shapefiles.o derived_types.o
test_read_snapshot.o : write_eddy.o read_snapshot.o init_shapefiles.o derived_types.o
test_set_all_outerm.o : set_all_outerm.o get_var.o derived_types.o
test_set_max_speed.o : set_max_speed.o derived_types.o
test_spherical_polygon_area.o : spherical_polygon_area.o
test_spher_polygon_area.o : spher_polygon_area.o
test_successive_overlap.o : successive_overlap.o read_snapshot.o derived_types.o
test_weight.o : weight.o derived_types.o
weight.o : derived_types.o
write_eddy.o : init_shapefiles.o derived_types.o
test_good_contour.o : good_contour.o
test_inside_4.o : inside_4.o
test_max_speed_contour_ssh.o : max_speed_contour_ssh.o
test_mean_speed.o : mean_speed.o
test_spherical_polyline_area.o : spherical_polyline_area.o
test_spher_polyline_area.o : spher_polyline_area.o
derived_types.f
+ 1
− 1
View file @ d52a7640
......@@ -59,7 +59,7 @@ module derived_types
integer number_eddies ! number of eddies, including interpolated eddies
end type snapshot
real, parameter:: missing_ssh = 1e4 ! flag for undefined contour
real, parameter:: missing_ssh = 1e4 ! flag for undefined SSH
real, parameter:: missing_speed = 1e4 ! flag for missing max speed
contains
......
get_1_outerm.f
+ 2
− 2
View file @ d52a7640
......@@ -28,7 +28,7 @@ contains
use derived_types, only: ssh_contour, missing_ssh
use good_contour_m, only: good_contour
use spherical_polyline_area_m, only: spherical_polyline_area
use spher_polyline_area_m, only: spher_polyline_area
logical, intent(in):: cyclone
real, intent(in):: coord_extr(:) ! (2)
......@@ -104,7 +104,7 @@ contains
get_1_outerm%ssh = level_good
end if
get_1_outerm%area = spherical_polyline_area(get_1_outerm%polyline)
get_1_outerm%area = spher_polyline_area(get_1_outerm%polyline)
end if
end function get_1_outerm
......
get_var.f
+ 6
− 4
View file @ d52a7640
......@@ -8,7 +8,7 @@ contains
new_fill_value)
! Read a NetCDF variable, change the missing value and extend it
! in longitude.
! in longitude if periodic.
! Libraries:
use netcdf95, only: nf95_inq_varid, nf95_get_var, nf95_get_att
......@@ -16,11 +16,13 @@ contains
logical, intent(in):: periodic ! grid is periodic in longitude
integer, intent(in):: max_rad_lon ! maximum radius of an eddy in
! longitude, in number of grid points
! longitude, in number of grid points, used only if periodic
real, intent(out):: values(1 - merge(max_rad_lon, 0, periodic):, :)
! (1 - merge(max_rad_lon, 0, periodic):nlon + merge(max_rad_lon, 0,
! periodic), nlat) ssh, u or v
! (1 - merge(max_rad_lon, 0, periodic):nlon + merge(max_rad_lon,
! 0, periodic), nlat) ssh, u or v. We cannot place this argument
! first because the declaration references max_rad_lon and
! periodic.
integer, intent(in):: ncid, nlon
integer, intent(in):: k ! date index
......
max_speed_contour_ssh.f
+ 22
− 19
View file @ d52a7640
......@@ -4,14 +4,14 @@ module max_speed_contour_ssh_m
contains
real function max_speed_contour_ssh(ssh, u, v, ind_extr, radius)
pure real function max_speed_contour_ssh(ssh, u, v, ind_extr, radius)
! Choose an SSH level by examining the values of velocities inside
! radius.
use, intrinsic:: IEEE_ARITHMETIC, only: IEEE_IS_NAN
use nr_util, only: assert
use derived_types, only: missing_ssh
real, intent(in):: ssh(:, :), u(:, :), v(:, :)
integer, intent(in):: ind_extr(:) ! (2) indices of the extremum in ssh
......@@ -44,23 +44,26 @@ contains
v_azim(south, :) = u(ind_extr(1), ind_extr(2) - 1:ind_extr(2) - radius &
+ 1:- 1)
! We are inside an outermost contour, there should be no missing value:
call assert(.not. any(ieee_is_nan(v_azim)), &
"max_speed_contour_ssh: missing value")
l = maxloc(abs(sum(v_azim, dim = 1) / 4.), dim = 1)
direction = maxloc(abs(v_azim(:, l)), dim = 1)
select case (direction)
case(east)
max_speed_contour_ssh = ssh(ind_extr(1) + l, ind_extr(2))
case(north)
max_speed_contour_ssh = ssh(ind_extr(1), ind_extr(2) + l)
case(west)
max_speed_contour_ssh = ssh(ind_extr(1) - l, ind_extr(2))
case(south)
max_speed_contour_ssh = ssh(ind_extr(1), ind_extr(2) - l)
end select
if (any(ieee_is_nan(v_azim))) then
! This is strange, we are inside an outermost contour, and yet
! there is a missing value. Well, we will go on with the
! outermost contour as max-speed contour.
max_speed_contour_ssh = missing_ssh
else
l = maxloc(abs(sum(v_azim, dim = 1) / 4.), dim = 1)
direction = maxloc(abs(v_azim(:, l)), dim = 1)
select case (direction)
case(east)
max_speed_contour_ssh = ssh(ind_extr(1) + l, ind_extr(2))
case(north)
max_speed_contour_ssh = ssh(ind_extr(1), ind_extr(2) + l)
case(west)
max_speed_contour_ssh = ssh(ind_extr(1) - l, ind_extr(2))
case(south)
max_speed_contour_ssh = ssh(ind_extr(1), ind_extr(2) - l)
end select
end if
end function max_speed_contour_ssh
......
set_max_speed.f
+ 26
− 20
View file @ d52a7640
......@@ -28,12 +28,12 @@ contains
use contour_531, only: convert_to_ind, null_polyline
use geometry, only: polygon_point_dist_2d
use derived_types, only: eddy, null_ssh_contour
use derived_types, only: eddy, null_ssh_contour, missing_ssh
use good_contour_m, only: good_contour
use inside_4_m, only: inside_4
use max_speed_contour_ssh_m, only: max_speed_contour_ssh
use mean_speed_m, only: mean_speed
use spherical_polyline_area_m, only: spherical_polyline_area
use spher_polyline_area_m, only: spher_polyline_area
type(eddy), intent(inout):: e
! e%out_cont, e%cyclone, e%ssh_extr and e%coord_extr
......@@ -83,25 +83,31 @@ contains
e%speed_cont%ssh = max_speed_contour_ssh(ssh, u, v, ind_targ_extr, &
e%radius4)
e%speed_cont%polyline = good_contour(corner, step, ssh, &
e%speed_cont%ssh, e%coord_extr, outside_points)
e%max_speed = mean_speed(u, v, e%speed_cont%polyline, e%coord_extr, &
corner, step)
if (IEEE_IS_NAN(speed_outerm)) then
! This may happen when the outermost contour is near land.
! Stick to the contour coming from max_speed_contour_ssh.
e%speed_cont%area = spherical_polyline_area(e%speed_cont%polyline)
else
! Note the following test should raise an invalid exception
! if e%max_speed is NaN.
if (abs(speed_outerm) > abs(e%max_speed)) then
! Abandon the contour coming from max_speed_contour_ssh:
e%speed_cont = null_ssh_contour()
e%max_speed = speed_outerm
else
if (e%speed_cont%ssh == missing_ssh) then
e%speed_cont = null_ssh_contour()
e%max_speed = speed_outerm
else
e%speed_cont%polyline = good_contour(corner, step, ssh, &
e%speed_cont%ssh, e%coord_extr, outside_points)
e%max_speed = mean_speed(u, v, e%speed_cont%polyline, e%coord_extr, &
corner, step)
if (IEEE_IS_NAN(speed_outerm)) then
! This may happen when the outermost contour is near land.
! Stick to the contour coming from max_speed_contour_ssh.
e%speed_cont%area = spherical_polyline_area(e%speed_cont%polyline)
e%speed_cont%area = spher_polyline_area(e%speed_cont%polyline)
else
! Note the following test should raise an invalid exception
! if e%max_speed is NaN.
if (abs(speed_outerm) > abs(e%max_speed)) then
! Abandon the contour coming from max_speed_contour_ssh:
e%speed_cont = null_ssh_contour()
e%max_speed = speed_outerm
else
! Stick to the contour coming from max_speed_contour_ssh.
e%speed_cont%area = spher_polyline_area(e%speed_cont%polyline)
end if
end if
end if
end if
......
spherical_polygon_area.f → spher_polygon_area.f
+ 7
− 7
View file @ d52a7640
module spherical_polygon_area_m
module spher_polygon_area_m
implicit none
contains
pure real function spherical_polygon_area(p)
pure real function spher_polygon_area(p)
! Assuming p is a polygon in longitude, latitude, compute the area
! of a polygon in longitude, sin(latitude) with the same
......@@ -13,7 +13,7 @@ contains
! Libraries:
use gpc_f, only: polygon
use spherical_polyline_area_m, only: spherical_polyline_area
use spher_polyline_area_m, only: spher_polyline_area
type(polygon), intent(in):: p ! in rad
......@@ -24,9 +24,9 @@ contains
!------------------------------------------------------
forall(i = 1:p%nparts) parts_area(i) = spherical_polyline_area(p%part(i))
spherical_polygon_area = sum(merge(- parts_area, parts_area, p%hole))
forall(i = 1:p%nparts) parts_area(i) = spher_polyline_area(p%part(i))
spher_polygon_area = sum(merge(- parts_area, parts_area, p%hole))
end function spherical_polygon_area
end function spher_polygon_area
end module spherical_polygon_area_m
end module spher_polygon_area_m
spherical_polyline_area.f → spher_polyline_area.f
+ 5
− 5
View file @ d52a7640
module spherical_polyline_area_m
module spher_polyline_area_m
implicit none
contains
pure real function spherical_polyline_area(p)
pure real function spher_polyline_area(p)
! Assuming p is a polyline in longitude, latitude, compute the
! area (positive) of a polyline in longitude, sin(latitude) with
......@@ -27,8 +27,8 @@ contains
v(1, :) = p%points(1, :)
v(2, :) = sin(p%points(2, :))
spherical_polyline_area = r_Earth**2 * abs(polygon_area_2d(v))
spher_polyline_area = r_Earth**2 * abs(polygon_area_2d(v))
end function spherical_polyline_area
end function spher_polyline_area
end module spherical_polyline_area_m
end module spher_polyline_area_m
successive_overlap.f
+ 5
− 5
View file @ d52a7640
......@@ -15,8 +15,8 @@ contains
use gpc_f, only: gpc_polygon_clip_f, GPC_INT, polygon
use derived_types, only: snapshot
use spherical_polygon_area_m, only: spherical_polygon_area
use spherical_polyline_area_m, only: spherical_polyline_area
use spher_polygon_area_m, only: spher_polygon_area
use spher_polyline_area_m, only: spher_polyline_area
use weight_m, only: weight
integer, intent(in):: unit_edgelist ! logical unit for edgelist file
......@@ -63,9 +63,9 @@ contains
if (res_pol%nparts /= 0) then
! polyline_1 and polyline_2 overlap
if (spherical_polygon_area(res_pol) >= 0.25 &
* min(spherical_polyline_area(polyline_1), &
spherical_polyline_area(polyline_2))) then
if (spher_polygon_area(res_pol) >= 0.25 &
* min(spher_polyline_area(polyline_1), &
spher_polyline_area(polyline_2))) then
write(unit_edgelist, fmt = *) k - 1, i1, k, i2, &
weight(flow(j - 1)%list_vis(i1), &
flow(j)%list_vis(i2))
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment