-
Lionel GUEZ authored
We will need this new shapefile in program `eddy_graph` only for a non longitude-latitude grid. We add a new dummy argument `grid_lon_lat` to procedure `shpc_create` to decide whether we create the shapefile `extr_proj`.
Lionel GUEZ authoredWe will need this new shapefile in program `eddy_graph` only for a non longitude-latitude grid. We add a new dummy argument `grid_lon_lat` to procedure `shpc_create` to decide whether we create the shapefile `extr_proj`.
save_snapshot.f90 1.47 KiB
module save_snapshot_m
implicit none
contains
subroutine save_snapshot(s, copy, d)
! Libraries:
use jumble, only: arth, rad_to_deg
use read_grid_m, only: corner, step, nlon, nlat
use derived_types, only: snapshot, shpc_slice_handler
use shpc_close_m, only: shpc_close
use shpc_create_m, only: shpc_create
use write_extr_map_m, only: write_extr_map
use write_snapshot_m, only: write_snapshot
type(snapshot), intent(in):: s
integer, intent(in):: copy, d
! Local:
TYPE(shpc_slice_handler) hshpc_cyclo, hshpc_anti
integer i
!-----------------------------------------------------------------
call shpc_create(hshpc_cyclo, shpc_dir = "SHPC", cyclone = .true., &
slice = 0, grid_lon_lat = .true.)
call shpc_create(hshpc_anti, shpc_dir = "SHPC", cyclone = .false., &
slice = 0, grid_lon_lat = .true.)
call write_snapshot(s, hshpc_cyclo, hshpc_anti, d)
CALL shpc_close(hshpc_cyclo)
CALL shpc_close(hshpc_anti)
print *, 'Created a slice in SHPC.'
print *, "Number of extrema:", s%number_extr
print *, "s%list%extr%coord_proj:"
do i = 1, s%number_extr
print *, s%list(i)%extr%coord_proj
end do
call write_extr_map(s%extr_map, longitude = arth((corner(1) - copy &
* step(1)) * rad_to_deg, step(1) * rad_to_deg, nlon + 2 * copy), &
latitude = arth(corner(2) * rad_to_deg, step(2) * rad_to_deg, nlat))
end subroutine save_snapshot
end module save_snapshot_m