Skip to content
Snippets Groups Projects
Commit 13ff23e3 authored by Lionel GUEZ's avatar Lionel GUEZ
Browse files

Create component `unit` in `shpc_slice_handler`

Create component `unit` for `ishape_last.txt` in derived type
`shpc_slice_handler`. Open, create and close `ishape_last.txt` at the
same time we open, create and close the shapefiles. So we use
`read_opcol` instead of `read_column` when we need to read
`ishape_last.txt`.
parent 3af4fdfc
No related branches found
No related tags found
No related merge requests found
......@@ -72,6 +72,7 @@ module derived_types
TYPE(shpfileobject) extremum ! shapefile extremum
TYPE(shpfileobject) outermost ! shapefile outermost_contour
TYPE(shpfileobject) max_speed ! shapefile max_speed_contour
integer unit ! ishape_last.txt
logical cyclone
! Field identifiers in the DBF files:
......
......@@ -18,6 +18,7 @@ contains
CALL shpclose(hshp%extremum)
CALL shpclose(hshp%outermost)
CALL shpclose(hshp%max_speed)
close(hshp%unit)
deallocate(hshp%dir)
if (allocated(hshp%ishape_last)) deallocate(hshp%ishape_last)
......
......@@ -61,6 +61,9 @@ contains
call dbf_add_field_03(hshp%max_speed_eddy_index, hshp%max_speed, &
'eddy_index', ftinteger, nwidth = 5, ndecimals = 0)
call new_unit(hshp%unit)
open(hshp%unit, file = hshp%dir // "/ishape_last.txt", status = "replace", &
action = "write")
hshp%cyclone = cyclone
call new_unit(unit)
open(unit, file = shpc_dir // "/orientation.txt", status = "replace", &
......
......@@ -36,6 +36,15 @@ contains
close(unit)
hshp%cyclone = trim(adjustl(orientation)) == "cyclones"
hshp%dir = shpc_dir
call new_unit(hshp%unit)
if (pszaccess == "rb") then
open(hshp%unit, file = hshp%dir // "/ishape_last.txt", &
status = "old", action = "read", position = "rewind")
else
open(hshp%unit, file = hshp%dir // "/ishape_last.txt", &
status = "old", action = "readwrite", position = "append")
end if
end subroutine shpc_open
......
......@@ -99,9 +99,7 @@ program test_get_1_outerm
e%valid = .true.
call shpc_create(hshp, shpc_dir = "SHPC", cyclone = cyclone)
call write_eddy(e, hshp, date, i = 1)
open(unit, file = "SHPC/ishape_last.txt", status = "replace", &
action = "write")
write(unit, fmt = *) 0
write(hshp%unit, fmt = *) 0
CALL shpc_close(hshp)
print *, 'Created "SHPC".'
else
......
program test_nearby_extr
! Libraries:
use jumble, only: get_command_arg_dyn, new_unit, read_column
use jumble, only: get_command_arg_dyn, new_unit, read_opcol
use jumble, only: deg_to_rad, rad_to_deg
use shapelib_03, only: dbf_read_attribute_03
......@@ -45,8 +45,7 @@ program test_nearby_extr
call shpc_open(hshp, trim(shpc_dir), pszaccess = "rb")
call dbf_read_attribute_03(hshp%d0, hshp%extremum, hshp%extr_date, ishape = 0)
call read_column(hshp%ishape_last, file = shpc_dir // "/ishape_last.txt", &
my_lbound = hshp%d0)
call read_opcol(hshp%ishape_last, hshp%unit, my_lbound = hshp%d0)
call read_snapshot(s, [hshp], nlon, nlat, k = hshp%d0, &
corner = corner_deg * deg_to_rad, step = step_deg * deg_to_rad, &
copy = 0)
......
......@@ -39,22 +39,14 @@ contains
!--------------------------------------------------------------------
call shp_get_info_03(hshpc%extremum, n_entities)
call new_unit(unit)
write(hshpc%unit, fmt = *) n_entities - 1
if (exist) then
open(unit, file = hshpc%dir // "/ishape_last.txt", status = "old", &
action = "write", position = "append")
write(unit, fmt = *) n_entities - 1
close(unit)
else
if (.not. exist) then
call new_unit(unit)
open(unit, file = hshpc%dir // "/grid_nml.txt", status = "replace", &
action = "write")
write(unit, nml = grid_nml)
close(unit)
open(unit, file = hshpc%dir // "/ishape_last.txt", status = "replace", &
action = "write")
write(unit, fmt = *) n_entities - 1
close(unit)
end if
end subroutine write_aux
......
......@@ -4,7 +4,7 @@ program test_get_dispatch_snap
! Libraries:
use ezmpi, only: ezmpi_bcast
use jumble, only: get_command_arg_dyn, read_column, new_unit, assert, &
use jumble, only: get_command_arg_dyn, read_opcol, new_unit, assert, &
deg_to_rad
use mpi_f08, only: mpi_init, mpi_finalize, MPI_Comm_rank, MPI_Comm_world, &
MPI_Comm_size, mpi_abort
......@@ -74,8 +74,7 @@ program test_get_dispatch_snap
call shpc_open(hshp, trim(shpc_dir), pszaccess = "rb")
call dbf_read_attribute_03(hshp%d0, hshp%extremum, hshp%extr_date, ishape = 0)
call read_column(hshp%ishape_last, file = shpc_dir // "/ishape_last.txt", &
my_lbound = hshp%d0)
call read_opcol(hshp%ishape_last, hshp%unit, my_lbound = hshp%d0)
if (rank == 0) then
n_dates = size(hshp%ishape_last)
......
......@@ -3,7 +3,7 @@ program test_overlap
use, intrinsic:: ISO_FORTRAN_ENV
! Libraries:
use jumble, only: get_command_arg_dyn, read_column, new_unit, ediff1d
use jumble, only: get_command_arg_dyn, read_opcol, new_unit, ediff1d
use jumble, only: deg_to_rad, assert
use shapelib_03, only: dbf_read_attribute_03
......@@ -67,8 +67,7 @@ program test_overlap
call shpc_open(hshp, trim(shpc_dir), pszaccess = "rb")
call dbf_read_attribute_03(hshp%d0, hshp%extremum, hshp%extr_date, &
ishape = 0)
call read_column(hshp%ishape_last, file = shpc_dir // "/ishape_last.txt", &
my_lbound = hshp%d0)
call read_opcol(hshp%ishape_last, hshp%unit, my_lbound = hshp%d0)
n_dates = size(hshp%ishape_last)
call assert(hshp%d0 <= [k_test_1, k_test_2] .and. [k_test_1, k_test_2] &
< hshp%d0 + n_dates, "test_overlap k_test_1, k_test_2")
......
program test_read_eddy
! Library:
use jumble, only: get_command_arg_dyn, read_column
use jumble, only: get_command_arg_dyn, read_opcol
use shapelib_03, only: dbf_read_attribute_03
use derived_types, only: eddy, shpc_slice_handler
......@@ -27,8 +27,7 @@ program test_read_eddy
read(unit = *, nml = main_nml)
call shpc_open(hshp, shpc_dir, pszaccess = "rb")
call dbf_read_attribute_03(hshp%d0, hshp%extremum, hshp%extr_date, ishape = 0)
call read_column(hshp%ishape_last, file = shpc_dir // "/ishape_last.txt", &
my_lbound = hshp%d0)
call read_opcol(hshp%ishape_last, hshp%unit, my_lbound = hshp%d0)
call read_eddy(e, k, eddy_i, hshp, ishape)
CALL shpc_close(hshp)
......
......@@ -4,7 +4,7 @@ program test_read_snapshot
! Libraries:
use jumble, only: get_command_arg_dyn, new_unit, deg_to_rad, assert, &
read_column
read_opcol
use shapelib_03, only: dbf_read_attribute_03
use derived_types, only: snapshot, shpc_slice_handler
......@@ -51,8 +51,7 @@ program test_read_snapshot
call shpc_open(hshp(i), trim(shpc_dir), pszaccess = "rb")
call dbf_read_attribute_03(hshp(i)%d0, hshp(i)%extremum, &
hshp(i)%extr_date, ishape = 0)
call read_column(hshp(i)%ishape_last, &
file = shpc_dir // "/ishape_last.txt", my_lbound = hshp(i)%d0)
call read_opcol(hshp(i)%ishape_last, hshp(i)%unit, my_lbound = hshp(i)%d0)
end do
! Assuming grid_nml.txt is the same in all input SHPC:
......
......@@ -4,7 +4,7 @@ program test_send_recv
! Libraries:
use ezmpi, only: ezmpi_bcast
use jumble, only: get_command_arg_dyn, read_column, new_unit
use jumble, only: get_command_arg_dyn, read_opcol, new_unit
use mpi_f08, only: mpi_init, mpi_finalize, MPI_Comm_rank, MPI_Comm_world, &
MPI_Comm_size, mpi_abort, MPI_TAG_UB, MPI_Comm_get_attr, &
MPI_ADDRESS_KIND, MPI_io, MPI_ANY_SOURCE
......@@ -84,8 +84,7 @@ program test_send_recv
call shpc_open(hshp, trim(shpc_dir), pszaccess = "rb")
call dbf_read_attribute_03(hshp%d0, hshp%extremum, hshp%extr_date, ishape = 0)
call read_column(hshp%ishape_last, file = shpc_dir // "/ishape_last.txt", &
my_lbound = hshp%d0)
call read_opcol(hshp%ishape_last, hshp%unit, my_lbound = hshp%d0)
if (rank == 0) then
n_dates = size(hshp%ishape_last)
......
......@@ -5,7 +5,7 @@ program eddy_graph
! Libraries:
use ezmpi, only: ezmpi_bcast
use jumble, only: get_command_arg_dyn, new_unit, ediff1d, assert, &
deg_to_rad, read_column
deg_to_rad, read_opcol
use mpi_f08, only: mpi_init, mpi_finalize, MPI_Comm_rank, MPI_Comm_world, &
MPI_Comm_size
use shapelib_03, only: dbf_read_attribute_03
......@@ -81,8 +81,8 @@ program eddy_graph
call shpc_open(hshpc(i), trim(shpc_dir), pszaccess = "rb")
call dbf_read_attribute_03(hshpc(i)%d0, hshpc(i)%extremum, &
hshpc(i)%extr_date, ishape = 0)
call read_column(hshpc(i)%ishape_last, &
file = shpc_dir // "/ishape_last.txt", my_lbound = hshpc(i)%d0)
call read_opcol(hshpc(i)%ishape_last, hshpc(i)%unit, &
my_lbound = hshpc(i)%d0)
end do
if (rank == 0) then
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment