Extract code into new procedure `write_snapshot`

Extract code from program `inst_eddies` into new procedure `write_snapshot`.

Common/CMakeLists.txt

@@ -4,7 +4,7 @@ target_sources(test_get_1_outerm PRIVATE derived_types.f90
   ccw_orient.f90)
 target_sources(test_set_all_outerm PRIVATE derived_types.f90
   spher_polyline_area.f90 shpc_create.f90 write_eddy.f90 shpc_close.f90
-  ccw_orient.f90)
+  ccw_orient.f90 write_snapshot.f90)
 target_sources(test_max_speed_contour_ssh PRIVATE derived_types.f90)
 target_sources(test_nearby_extr PRIVATE derived_types.f90 read_snapshot.f90
   read_eddy.f90 read_field_indices.f90 shpc_open.f90 shpc_close.f90)
@@ -14,7 +14,7 @@ target_sources(test_set_max_speed PRIVATE derived_types.f90
 target_sources(test_spher_polyline_area PRIVATE spher_polyline_area.f90)
 target_sources(inst_eddies PRIVATE write_eddy.f90 spher_polyline_area.f90
   derived_types.f90 shpc_create.f90 shpc_close.f90 shpc_open.f90
-  read_field_indices.f90 ccw_orient.f90)
+  read_field_indices.f90 write_snapshot.f90 ccw_orient.f90)
 target_sources(test_write_eddy PRIVATE derived_types.f90 shpc_open.f90
   shpc_close.f90 read_field_indices.f90 shpc_create.f90)
 

Common/write_snapshot.f90

+module write_snapshot_m
+
+  implicit none
+
+contains
+
+  subroutine write_snapshot(s, hshpc_cyclo, hshpc_anti, date)
+
+    use derived_types, only: snapshot, shpc_slice_handler
+    use write_eddy_m, only: write_eddy
+
+    type(snapshot), intent(in):: s
+    TYPE(shpc_slice_handler), intent(in):: hshpc_cyclo, hshpc_anti
+    integer, intent(in):: date
+
+    ! Local:
+    integer i, n_cyclo, n_anti
+
+    !-----------------------------------------------------------------
+
+    n_cyclo = 0
+    n_anti = 0
+
+    do i = 1, s%number_extr
+       if (s%list(i)%cyclone) then
+          n_cyclo = n_cyclo + 1
+          call write_eddy(s%list(i), hshpc_cyclo, date, n_cyclo)
+       else
+          n_anti = n_anti + 1
+          call write_eddy(s%list(i), hshpc_anti, date, n_anti)
+       end if
+    end do
+
+  end subroutine write_snapshot
+
+end module write_snapshot_m

Inst_eddies/Tests/test_set_all_outerm.f90

@@ -12,13 +12,13 @@ program test_set_all_outerm
   use set_all_outerm_m, only: set_all_outerm
   use shpc_close_m, only: shpc_close
   use shpc_create_m, only: shpc_create
-  use write_eddy_m, only: write_eddy
+  use write_snapshot_m, only: write_snapshot
 
   implicit none
 
   type(snapshot) s
   integer nlon, nlat
-  integer i, n_cyclo, n_anti
+  integer i
 
   real, allocatable:: ssh(:, :)
   ! (1 - max_radius(1):nlon + max_radius(1), nlat) if the grid is periodic
@@ -52,19 +52,7 @@ program test_set_all_outerm
 
   call shpc_create(hshp_cyclo, shpc_dir = "SHPC_cyclo", cyclone = .true.)
   call shpc_create(hshp_anti, shpc_dir = "SHPC_anti", cyclone = .false.)
-  n_cyclo = 0
-  n_anti = 0
-
-  do i = 1, s%number_extr
-     if (s%list(i)%cyclone) then
-        n_cyclo = n_cyclo + 1
-        call write_eddy(s%list(i), hshp_cyclo, date = 1, i = n_cyclo)
-     else
-        n_anti = n_anti + 1
-        call write_eddy(s%list(i), hshp_anti, date = 1, i = n_anti)
-     end if
-  end do
-
+  call write_snapshot(s, hshp_cyclo, hshp_anti, date = 1)
   print *, "s%number_extr = ", s%number_extr
 
   CALL shpc_close(hshp_cyclo)

Inst_eddies/inst_eddies.f90

@@ -18,13 +18,13 @@ program inst_eddies
   use shpc_create_m, only: shpc_create
   use shpc_open_m, only: shpc_open
   use write_aux_m, only: write_aux
-  use write_eddy_m, only: write_eddy
+  use write_snapshot_m, only: write_snapshot
 
   implicit none
 
   type(snapshot) s
   TYPE(shpc_slice_handler) hshpc_cyclo, hshpc_anti
-  integer i, date, n_cyclo, n_anti
+  integer i, date
   integer unit
 
   integer nlon, nlat
@@ -142,19 +142,7 @@ program inst_eddies
      call shpc_create(hshpc_anti, shpc_dir = "SHPC_anti", cyclone = .false.)
   end if
 
-  n_cyclo = 0
-  n_anti = 0
-
-  do i = 1, s%number_extr
-     if (s%list(i)%cyclone) then
-        n_cyclo = n_cyclo + 1
-        call write_eddy(s%list(i), hshpc_cyclo, date, n_cyclo)
-     else
-        n_anti = n_anti + 1
-        call write_eddy(s%list(i), hshpc_anti, date, n_anti)
-     end if
-  end do
-
+  call write_snapshot(s, hshpc_cyclo, hshpc_anti, date)
   call write_aux(corner_deg, step_deg, nlon, nlat, hshpc_cyclo, exist)
   call write_aux(corner_deg, step_deg, nlon, nlat, hshpc_anti, exist)
   CALL shpc_close(hshpc_cyclo)