program test_get_dispatch_snap ! Libraries: use ezmpi, only: ezmpi_bcast 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 use shapelib_03, only: dbf_read_attribute_03 use config_graph_m, only: config_graph, copy use derived_types, only: snapshot, shpc_slice_handler, shpc_slice_meta use dispatch_snapshot_m, only: dispatch_snapshot use get_snapshot_m, only: get_snapshot use read_grid_m, only: read_grid, uniform_lon_lat use send_snapshot_m, only: send_snapshot use shpc_close_m, only: shpc_close use shpc_open_m, only: shpc_open use save_snapshot_m, only: save_snapshot implicit none character(len = :), allocatable:: shpc_dir type(snapshot) s TYPE(shpc_slice_handler) hshp type(shpc_slice_meta) ssm integer k_begin, rank, n_proc, k_end, n_dates integer unit_isolated integer:: k = 0 namelist /main_nml/ k !------------------------------------------------------------------------- call mpi_init call MPI_Comm_rank(MPI_Comm_world, rank) call MPI_Comm_size(MPI_Comm_world, n_proc) if (n_proc > 2) then if (rank == 0) print *, "test_get_dispatch_snap: 1 or 2 processes only" call mpi_abort(MPI_Comm_world, errorcode = 1) end if call get_command_arg_dyn(1, shpc_dir, "Required argument: SHPC-directory") call read_grid(shpc_dir, rank) call config_graph(rank) if (rank == 0) then write(unit = *, nml = main_nml) print *, "Enter namelist main_nml." read(unit = *, nml = main_nml) write(unit = *, nml = main_nml) end if 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) if (rank == 0) then n_dates = size(ssm%ishape_last) call new_unit(unit_isolated) open(unit_isolated, file = "isolated_nodes.txt", status = "replace", & action = "write") end if call ezmpi_bcast(k, root = 0) call ezmpi_bcast(n_dates, root = 0) k_begin = ssm%d0 + (rank * n_dates) / n_proc if (rank < n_proc - 1) then k_end = ssm%d0 + ((rank + 1) * n_dates) / n_proc else k_end = ssm%d0 + n_dates - 1 end if call get_snapshot(s, [hshp], [ssm], k, k_end, rank, n_proc) CALL shpc_close(hshp) call dispatch_snapshot(s, unit_isolated, rank, k_begin, k) if (rank == 0) then call save_snapshot(s, copy, d = k) close(unit_isolated) end if call mpi_finalize end program test_get_dispatch_snap