-
Lionel GUEZ authored
Move dummy arguments k and i of procedure `write_eddy` to the end of dummy argument list: keyword association more likely for these. Follow upgrade of `Shapelib_03`: move argument associated to dummy argument hshp of `shp_open_03` to the beginning of argument list.
Lionel GUEZ authoredMove dummy arguments k and i of procedure `write_eddy` to the end of dummy argument list: keyword association more likely for these. Follow upgrade of `Shapelib_03`: move argument associated to dummy argument hshp of `shp_open_03` to the beginning of argument list.
test_inside_4.f90 1.02 KiB
program test_inside_4
use inside_4_m, only: inside_4
use jumble, only: get_command_arg_dyn
use shapelib, only: shpfileobject, shpclose, shpobject
use shapelib_03, only: shp_open_03, shp_read_object_03
implicit none
character(len = :), allocatable:: filename
real:: distance(2) = [1., 1.], center(2) = [0., 0.]
TYPE(shpfileobject) hshp
TYPE(shpobject) psobject
real, allocatable:: v(:, :) ! (2, :)
namelist /main_nml/ distance, center
!-----------------------------------------------------------------------
call get_command_arg_dyn(1, filename)
print *, "Reading from ", filename, "..."
call shp_open_03(hshp, filename, "rb")
call shp_read_object_03(hshp, 0, psobject)
CALL shpclose(hshp)
write(unit = *, nml = main_nml)
print *, "Enter namelist main_nml."
read(unit = *, nml = main_nml)
write(unit = *, nml = main_nml)
allocate(v(2, psobject%nvertices))
v(1, :) = psobject%padfx
v(2, :) = psobject%padfy
print *, "inside_4: ", inside_4(distance, center, v)
end program test_inside_4