-
GUEZ Lionel authored
Specify whether to read shapefile `extr_proj` in procedure `shpc_open` instead of just trying to read this shapefile. Use `uniform_lon_lat` to decide whether to read the shapefile. As `shpc_open` is called in both programs `inst_eddies` and `eddy_graph`, we cannot access variable `uniform_lon_lat` of module `input_ssh_m`, which is not used in program `eddy_graph`, nor variable `uniform_lon_lat` of module `read_grid_m`, which is not used in program `inst_eddies`. So we add a dummy argument `with_proj` to procedure `shpc_open`.
GUEZ Lionel authoredSpecify whether to read shapefile `extr_proj` in procedure `shpc_open` instead of just trying to read this shapefile. Use `uniform_lon_lat` to decide whether to read the shapefile. As `shpc_open` is called in both programs `inst_eddies` and `eddy_graph`, we cannot access variable `uniform_lon_lat` of module `input_ssh_m`, which is not used in program `eddy_graph`, nor variable `uniform_lon_lat` of module `read_grid_m`, which is not used in program `inst_eddies`. So we add a dummy argument `with_proj` to procedure `shpc_open`.
test_nearby_extr.f90 1.50 KiB
program test_nearby_extr
! Libraries:
use jumble, only: get_command_arg_dyn, read_opcol
use shapelib_03, only: dbf_read_attribute_03
use derived_types, only: snapshot, shpc_slice_handler, shpc_slice_meta
use nearby_extr_m, only: nearby_extr
use read_grid_m, only: read_grid, uniform_lon_lat
use read_snapshot_m, only: read_snapshot
use shpc_close_m, only: shpc_close
use shpc_open_m, only: shpc_open
implicit none
character(len = :), allocatable:: shpc_dir
type(snapshot) s
TYPE(shpc_slice_handler) hshp
integer l
type(shpc_slice_meta) ssm
integer, allocatable:: nearby(:, :) ! (2, :)
! coordinates in projection space of extrema near the target extremum
integer:: i = 3
namelist /main_nml/ i
!-------------------------------------------------------------------------
call get_command_arg_dyn(1, shpc_dir, "Required argument: SHPC-directory")
print *, "Enter namelist main_nml."
read(unit = *, nml = main_nml)
call read_grid(rank = 0, shpc_dir = shpc_dir)
call shpc_open(hshp, trim(shpc_dir), cyclone = .true., slice = 0, &
with_proj = .not. uniform_lon_lat, pszaccess = "rb")
call dbf_read_attribute_03(ssm%d0, hshp%extremum, hshp%extr_date, ishape = 0)
call read_opcol(ssm%ishape_last, hshp%unit, my_lbound = ssm%d0)
call read_snapshot(s, [hshp], [ssm], k = ssm%d0, copy = 0)
CALL shpc_close(hshp)
nearby = nearby_extr(s%extr_map, s%list, i)
print *, "nearby:"
do l = 1, size(nearby, 2)
print *, nearby(:, l)
end do
end program test_nearby_extr