From b3fb400e1b5654dad713036a5ae9d528db0e2a49 Mon Sep 17 00:00:00 2001
From: Lionel GUEZ <guez@lmd.ens.fr>
Date: Tue, 17 Jul 2018 17:11:25 +0200
Subject: [PATCH] Use function nearby_extr in get_snapshot.
---
GNUmakefile | 2 +-
depend.mk | 2 +-
get_snapshot.f | 22 ++++------------------
3 files changed, 6 insertions(+), 20 deletions(-)
diff --git a/GNUmakefile b/GNUmakefile
index 17fd7348..957f088f 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -11,7 +11,7 @@ src_test_get_1_outerm = good_contour.f test_get_1_outerm.f derived_types.f get_1
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_get_snapshot = test_get_snapshot.f get_snapshot.f dispatch_snapshot.f write_eddy.f send_snapshot.f receive_snapshot.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
+src_test_get_snapshot = test_get_snapshot.f get_snapshot.f dispatch_snapshot.f write_eddy.f send_snapshot.f receive_snapshot.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
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
diff --git a/depend.mk b/depend.mk
index e5c0f072..c938ee8f 100644
--- a/depend.mk
+++ b/depend.mk
@@ -1,6 +1,6 @@
dispatch_snapshot.o : write_eddy.o send_snapshot.o derived_types.o
get_1_outerm.o : spherical_polyline_area.o good_contour.o derived_types.o
-get_snapshot.o : set_all_outerm.o set_max_speed.o receive_snapshot.o derived_types.o
+get_snapshot.o : set_all_outerm.o set_max_speed.o receive_snapshot.o nearby_extr.o derived_types.o
nearby_extr.o : derived_types.o
read_eddy.o : derived_types.o
read_snapshot.o : read_eddy.o derived_types.o
diff --git a/get_snapshot.f b/get_snapshot.f
index 366ec9d1..dc853c83 100644
--- a/get_snapshot.f
+++ b/get_snapshot.f
@@ -16,6 +16,7 @@ contains
nf95_get_att
use derived_types, only: snapshot, null_ssh_contour, missing_speed
+ use nearby_extr_m, only: nearby_extr
use receive_snapshot_m, only: receive_snapshot
use set_max_speed_m, only: set_max_speed
use set_all_outerm_m, only: set_all_outerm
@@ -47,13 +48,7 @@ contains
real ssh(nlon, nlat) ! sea-surface height, in m
real u(nlon, nlat), v(nlon, nlat) ! wind, in m s-1
real Fill_Value
- integer i, n_select, l
-
- integer, allocatable:: selection(:)
- ! identifying numbers of a selection of eddies
-
- real, allocatable:: nearby_extr(:, :) ! (2, :) longitude and
- ! latitude, in rad, of extrema near the target extremum
+ integer i
! Window around each extremum:
integer llc(2) ! indices in global grid of lower left corner
@@ -109,21 +104,12 @@ contains
[nlon, nlat])
! (min should have no effect except because of roundup error)
- ! Define nearby_extr:
- selection = abs(pack(s%extr_map(llc(1):urc(1), llc(2):urc(2)), &
- s%extr_map(llc(1):urc(1), llc(2):urc(2)) > 0 &
- .and. s%extr_map(llc(1):urc(1), llc(2):urc(2)) /= i))
- n_select = size(selection)
- allocate(nearby_extr(2, n_select))
- forall (l = 1:n_select) &
- nearby_extr(:, l) = s%list_vis(selection(l))%coord_extr
-
call set_max_speed(s%list_vis(i), s%ind_extr(:, i) - llc + 1, &
- nearby_extr, ssh(llc(1):urc(1), llc(2):urc(2)), &
+ nearby_extr(s%extr_map(llc(1):urc(1), llc(2):urc(2)), &
+ s%list_vis, i), ssh(llc(1):urc(1), llc(2):urc(2)), &
u(llc(1):urc(1), llc(2):urc(2)), &
v(llc(1):urc(1), llc(2):urc(2)), corner + (llc - 1) * step, &
step)
- deallocate(nearby_extr)
else
s%list_vis(i)%speed_cont = null_ssh_contour()
s%list_vis(i)%max_speed = missing_speed
--
GitLab