test_get_dispatch_snap.f90

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