wmmdatmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!
!/ ------------------------------------------------------------------- /
MODULE wmmdatmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         22-Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/    13-Jun-2005 : Origination.                       ( version 3.07 )
  !/    16-Dec-2005 : Add staging of boundary data.      ( version 3.08 )
  !/                  Add HGSTGE data.                   ( version 3.08 )
  !/    27-Jan-2006 : Adding static nests.               ( version 3.08 )
  !/    24-Mar-2006 : Add EQSTGE data.                   ( version 3.09 )
  !/    25-May-2006 : Add STIME in BPSTGE.               ( version 3.09 )
  !/    29-May-2006 : Adding overlapping grids.          ( version 3.09 )
  !/                  Fixing boundary data (buffering).
  !/    18-Jul-2006 : Adding input grids.                ( version 3.09 )
  !/    09-Aug-2006 : Adding unified point output.       ( version 3.10 )
  !/    06-Oct-2006 : Adding separate input grids.       ( version 3.10 )
  !/    12-Jan-2007 : Add FLSTI and FLLSTL.              ( version 3.10 )
  !/    22-Jan-2007 : Add NAVMAX.                        ( version 3.10 )
  !/    29-May-2009 : Preparing distribution version.    ( version 3.14 )
  !/    03-Sep-2012 : Add clock parameters (init.).      ( version 4.10 )
  !/    04-Feb-2014 : Switched to DATE_AND_TIME param.   ( version 4.18 )
  !/    10-Dec-2014 : Add checks for allocate status     ( version 5.04 )
  !/    28-Sep-2016 : Adjust MTAG? values so that MPI tags used fit
  !/                  within allowed bounds.             ( version 5.15 )
  !/    06-Jun-2018 : add subroutine INIT_GET_JSEA_ISPROC_GLOB/add PDLIB
  !/                                                     ( version 6.04 )
  !/    22-Mar-2021 : Support for air density input      ( version 7.13 )
  !/    28-Oct-2021 : Add SMC grid group indicator. JGLi ( version 7.13 )
  !/
  !/    Copyright 2009-2012 National Weather Service (NWS),
  !/       National Oceanic and Atmospheric Administration.  All rights
  !/       reserved.  WAVEWATCH III is a trademark of the NWS.
  !/       No unauthorized use without permission.
  !/
  !  1. Purpose :
  !
  !     Define data structures to set up wave model dynamic data for
  !     several models simultaneously.
  !
  !  2. Variables and types :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      NMDATA    Int.  Public   Number of models in array dim.
  !      IMDATA    Int.  Public   Selected model for output, init. at -1.
  !
  !      MDSI      Int.  Public   Unit number for input file.
  !      MDSO      Int.  Public   Unit number for output (log file).
  !      MDSS      Int.  Public   Unit number for output (screen).
  !      MDST      Int.  Public   Unit number for test output.
  !      MDSE      Int.  Public   Unit number for error output.
  !                               These outputs correspond to similar
  !                               unit numbers as defined per grid, but
  !                               are used for multi-grid routines
  !                               only.
  !      MDSP      Int.  Public   Unit number for profiling.
  !      MDSUP     Int.  Public   Unit number for unified point output.
  !      MDSUPA    Int.  Public   Unit number for unified point output.
  !                               ASCII
  !      MDSF      I.A.  Public   Unit numbers for input files.
  !
  !      NMPROC    Int.  Public   Number of processors (for total multi-
  !                               grid model).
  !      IMPROC    Int.  Public   Corresponding actual processor number.
  !      NMPLOG, NMPSCR, NMPTST, NMPERR, NMPUPT
  !                Int.  Public   Processors in NMPROC designated for
  !                               the above output units numbers.
  !
  !      STIME     I.A.  Public   Model run starting time.
  !      ETIME     I.A.  Public   Model run ending time.
  !      TSYNC     I.A.  Public   Synchronization time for grids.
  !      TMAX      I.A.  Public   Maximum next time per grid.
  !      TOUTP     I.A.  Public   Next output time for grids.
  !      TDATA     I.A.  Public   Time for which data is available.
  !
  !      NRGRD     Int.  Public   Number of grids.
  !      NRINP     Int.  Public   Number of input grids.
  !      NRGRP     Int.  Public   Number of groups.
  !      NGRPSMC   Int.  Public   SMC grid group number, one of 0:NRGRP.
  !      NMVMAX    Int.  Public   Number of moving grid data.
  !      GRANK     I.A.  Public   Rank number for grid.
  !      GRGRP     I.A.  Public   Group number for grid.
  !      INGRP     I.A.  Public   Grids in group, element 0 is number.
  !      GRDHGH, GRDEQL, GRDLOW
  !                I.A.  Public   Dependent grids with higher, same or
  !                               lower rank number, element 0 is number.
  !      ALLPRC    I.A.  Public   Map of processors in MPI_COMM_MWAVE for
  !                               all individual grids.
  !      MODMAP    I.A.  Public   Map which model is running where in
  !                               MPI_COMM_MWAVE each group.
  !      GRSTAT    I.A.  Public   Grid computation status indicator.
  !      DTRES     R.A.  Public   Residual of time step.
  !      NBI2G     I.A.  Public   Map cross-referencing how many spectra
  !                               echo grid provides to boundary cond. for
  !                               other grids.
  !      RESPEC    L.A.  Public   Map for need to convert spectra between
  !                               grids.
  !      BCDUMP    L.A.  Public   Flag for dumping internal bound. data.
  !      INPMAP    I.A.  Public   Map for expternal input grids.
  !      IDINP     C.A.  Public   Input field identifiers.
  !
  !      CLKDT1, CLKDT2, CLKDT3, CLKFIN
  !                Int.  Public   Global wall clock parameters,
  !
  !      MPI_COMM_MWAVE
  !                Int.  Public   MPI communicator.             ( !/MPI )
  !      MTAGn     Int.  Public   "Zero" tag number for MPI     ( !/MPI )
  !      MTAG_UB   Int.  Public   Upper-bound for MPI tags      ( !/MPI )
  !      NBISTA    I.A.  Public   Status for gathering input boundary
  !                               data.                         ( !/MPI )
  !      HGHSTA    I.A.  Public   Status for gathering high resolution
  !                               data.                         ( !/MPI )
  !      EQLSTA    I.A.  Public   Status for gathering data fro equally
  !                               ranked grids.                 ( !/MPI )
  !
  !      FLGBDI    Log.  Public   Flag for intitialization of boundry
  !                               distance maps.
  !      FLGHGn    Log.  Public   Flags for using mask for computations
  !                               and output for areas of grid overlap.
  !      IFLSTI    L.A.  Public   FLags for last ice per grid.
  !      IFLSTL    L.A.  Public   FLags for last level per grid.
  !      IFLSTR    L.A.  Public   FLags for last air density per grid.
  !
  !      MDATA     TYPE  Public   Data structure for grid dependent data.
  !      MDATAS    MDATA Public   Array of data structures.
  !
  !      BPST      TYPE  Public   Data structure for staging boundary
  !                               data.
  !      BPSTGE    BPST  Public   Array of data structures.
  !
  !      HGST      TYPE  Public   Data structure for staging 2-way
  !                               nesting data.
  !      HGSTGE    HGST  Public   Array of data structures.
  !
  !      EQST      TYPE  Public   Data structure for staging equal grid
  !                               reconcilliation data.
  !      EQSTGE    EQST  Public   Array of data structures.
  !     ----------------------------------------------------------------
  !
  !     All elements of MDATA are aliased to pointers with the same
  !     name. These pointers are defined as :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      NBI2S     I.A.  Public   Source information of boundary input
  !                               data (grid number and sea counter).
  !      MAPBDI    R.A.  Public   Map with distances to boundary.
  !      MAPODI    R.A.  Public   idem, open edges of grids.
  !      NRUPTS    Int.  Public   Number of unified output points.
  !      UPTMAP    I.A.  Public   Mapping of unified points to grids.
  !      MAPMSK    I.A.  Public   Mask corresponding to FLGHGn above.
  !      MINIT, MSKINI, FLDATn
  !                Log.  Public   Flags for array initializations.
  !      FLLSTI    Log.  Public   FLag for last ice per grid.
  !      FLLSTL    Log.  Public   FLag for last level per grid.
  !      FLLSTR    Log.  Public   FLag for last air density per grid.
  !
  !      NMV       Int.  Public   Number of moving grid data.
  !      TMV       I.A.  Public   Moving grid times.
  !      AMV       R.A.  Public   Moving grid velocities.
  !      DMV       R.A.  Public   Moving grid directions.
  !
  !      RCLD      I.A.  Public   Record length for data assimilation.
  !      NDT       I.A.  Public   Number of data for data assimilation.
  !      DATAn     R.A.  Public   Assimilation data.
  !
  !   MPI_COMM_GRD Int.  Public   Communicator for grid       ( !/MPI )
  !   MPI_COMM_BCT Int.  Public   Communicator for broadcast  ( !/MPI )
  !      CROOT     Int.  Public   "root" for MPI_COMM_GRD in
  !                               MPI_COMM_MWAVE              ( !/MPI )
  !      FBCAST    Log.  Public   FLag for need of broadcasting data
  !                               to processors that are not in the
  !                               communicator                ( !/MPI )
  !      NRQBPG    Int.  Public   Number of request handles    ( !/MPI )
  !      IRQBPG    I.A.  Public   Request handles.             ( !/MPI )
  !      NRQHGG    Int.  Public   Number of request handles    ( !/MPI )
  !      IRQHGG    I.A.  Public   Request handles.             ( !/MPI )
  !      NRQEQG    Int.  Public   Number of request handles    ( !/MPI )
  !      IRQEQG    I.A.  Public   Request handles.             ( !/MPI )
  !     ----------------------------------------------------------------
  !
  !     Elements of the structure BPTS are
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      NRQBPS    Int.  Public   Number of request handles    ( !/MPI )
  !      IRQBPS    I.A.  Public   Request handles.             ( !/MPI )
  !      VTIME     I.A.  Public   Valid time of data.
  !      STIME     I.A.  Public   Buffer for time for sending. ( !/MPI )
  !      SBPI      R.A.  Public   Spectral data storage.
  !      TSTORE    R.A.  Public   Spectral data buffer.        ( !/MPI )
  !      INIT      Log.  Public   Flag for array allocation.
  !     ----------------------------------------------------------------
  !
  !     Elements of the structure HGST are
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      NRQHGS    Int.  Public   Number of request handles    ( !/MPI )
  !      IRQHGS    I.A.  Public   Request handles.             ( !/MPI )
  !      NRQOUT    Int.  Public   Number of local spectra.     ( !/MPI )
  !      OUTDAT    I.A.  Public   Corresponding data.          ( !/MPI )
  !      NTOT, NREC, NRC1, NSND, NSN1, NSMX
  !                Int.  Public   Counters for total data, send and
  !                               received data with and without
  !                               masking.
  !      VTIME     I.A.  Public   Valid time of data.
  !      LJSEA     I.A.  Public   Local sea point counters.
  !      NRAVG     I.A.  Public   Number of points in averaging.
  !      IMPSRC    I.A.  Public   Source processor for data,
  !      ITAG      I.A.  Public   Communication tag.
  !      ISEND     I.A.  Public   Composite of all deta needed for send.
  !      WGHT      R.A.  Public   Weihts in averaging.
  !      SHGH      R.A.  Public   Staging area for spectra.
  !      TSTORE    R.A.  Public   Staging area for spectra to be send
  !                               out                         ( !/MPI )
  !      INIT      Log.  Public   Flag for array allocation.
  !     ----------------------------------------------------------------
  !
  !     Elements of the structure EQST are
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      NRQEQS    Int.  Public   Number of request handles    ( !/MPI )
  !      IRQEQS    I.A.  Public   Request handles.             ( !/MPI )
  !      NRQOUT    Int.  Public   Number of local spectra.     ( !/MPI )
  !      OUTDAT    I.A.  Public   Corresponding data.          ( !/MPI )
  !      NTOT, NREC, NSND, NAVMAX
  !                Int.  Public   Counters for total data, send and
  !                               received data.
  !      VTIME     I.A.  Public   Valid time of data.
  !      I/JSEA    I.A.  Public   Sea point counters.
  !      NAVG      I.A.  Public   Number of spectra in averaging.
  !      RIP       I.A.  Public   Processor (receiving).
  !      RTG       I.A.  Public   Tag number (receiving).
  !      SIS,SJS   I.A.  Public   Sea point counter (sending).
  !      SI1/2     I.A.  Public   Storage array counters (sending).
  !      SIP       I.A.  Public   Processor (sending).
  !      STG       I.A.  Public   Tag (sending).
  !      SEQL      R.A.  Public   Staging array.
  !      WGHT      R.A.  Public   Weight between grids.
  !      WAVG      R.A.  Public   Weight within grid.
  !      TSTORE    R.A.  Public   Staging area for spectra to be send
  !                               out                         ( !/MPI )
  !      INIT      Log.  Public   Flag for array allocation.
  !     ----------------------------------------------------------------
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      WMNDAT    Subr. Public   Set number of grids/models.
  !      WMDIMD    Subr. Public   Set dimensions of arrays (data).
  !      WMDIMM    Subr. Public   Set dimensions of arrays.
  !      WMSETM    Subr. Public   Point to selected grid / model.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3SETG    Subr. W3GDATMD Point to proper model grid.
  !      STRACE    Subr. W3SERVMD Subroutine tracing.
  !      EXTCDE    Subr.   Id.    Abort program with exit code.
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !     - The number of grids is taken from W3GDATMD, and needs to be
  !       set first with W3DIMG.
  !
  !  6. Switches :
  !
  !     !/S    Enable subroutine tracing.
  !     !/T    Enable test output
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  !/
  !/ Specify default accessibility
  !/
  PUBLIC
  !/
  !/ Module private variable for checking error returns
  !/
  INTEGER, PRIVATE        :: ISTAT
  !/
  !/ Conventional declarations
  !/
  INTEGER                 :: nmdata = -1
  INTEGER                 :: imdata = -1
  INTEGER                 :: mdsi = 8
  INTEGER                 :: mdso = 9
  INTEGER                 :: mdss = 6
  INTEGER                 :: mdst = 6
  INTEGER                 :: mdse = 6
  INTEGER                 :: mdsup
#ifdef W3_ASCII
  INTEGER                 :: mdsupa
#endif
  INTEGER                 :: nmproc = 1
  INTEGER                 :: improc = 1
  INTEGER                 :: nmplog = 1
  INTEGER                 :: nmpscr = 1
  INTEGER                 :: nmptst = 1
  INTEGER                 :: nmperr = 1
  INTEGER                 :: nmpupt = 1
  INTEGER                 :: stime(2)
  INTEGER                 :: etime(2)
  INTEGER                 :: nrgrd
  INTEGER                 :: nrinp
  INTEGER                 :: nrgrp
  INTEGER                 :: nmvmax
  INTEGER                 :: ngrpsmc
 
  INTEGER                 :: clkdt1(8)
  INTEGER                 :: clkdt2(8)
  INTEGER                 :: clkdt3(8)
 
#ifdef W3_MPRF
  INTEGER                 :: mdsp
#endif
#ifdef W3_MPI
  INTEGER                 :: mpi_comm_mwave
  INTEGER, PARAMETER      :: mtagb = 0
  INTEGER, PARAMETER      :: mtag0 = 1000
  INTEGER, PARAMETER      :: mtag1 = 40000
  INTEGER, PARAMETER      :: mtag2 = 1000000
  INTEGER, PARAMETER      :: mtag_ub = 2**21-1
#endif
 
  INTEGER, ALLOCATABLE    :: mdsf(:,:)
  INTEGER, ALLOCATABLE    :: grank(:)
  INTEGER, ALLOCATABLE    :: grgrp(:)
  INTEGER, ALLOCATABLE    :: ingrp(:,:)
  INTEGER, ALLOCATABLE    :: grdhgh(:,:)
  INTEGER, ALLOCATABLE    :: grdeql(:,:)
 
  INTEGER, ALLOCATABLE    :: grdlow(:,:)
  INTEGER, ALLOCATABLE    :: allprc(:,:)
  INTEGER, ALLOCATABLE    :: modmap(:,:)
  INTEGER, ALLOCATABLE    :: tsync(:,:)
  INTEGER, ALLOCATABLE    :: tmax(:,:)
  INTEGER, ALLOCATABLE    :: toutp(:,:)
  INTEGER, ALLOCATABLE    :: tdata(:,:)
  INTEGER, ALLOCATABLE    :: grstat(:)
  INTEGER, ALLOCATABLE    :: nbi2g(:,:)
  INTEGER, ALLOCATABLE    :: inpmap(:,:)
 
#ifdef W3_MPI
  INTEGER, ALLOCATABLE    :: nbista(:)
  INTEGER, ALLOCATABLE    :: hghsta(:)
  INTEGER, ALLOCATABLE    :: eqlsta(:)
#endif
 
  REAL                    :: clkfin
  REAL,    ALLOCATABLE    :: dtres(:)
  LOGICAL                 :: flgbdi=.false.   
  LOGICAL                 :: flghg1
  LOGICAL                 :: flghg2
  LOGICAL, ALLOCATABLE    :: respec(:,:)
  LOGICAL, ALLOCATABLE    :: bcdump(:)
  LOGICAL, ALLOCATABLE    :: iflsti(:)
  LOGICAL, ALLOCATABLE    :: iflstl(:)
  LOGICAL, ALLOCATABLE    :: iflstr(:)
  CHARACTER(LEN=3), ALLOCATABLE :: idinp(:,:)
  !/
  !/ Data structures
  !/
  TYPE mdata
    INTEGER               :: rcld(3)
    INTEGER               :: ndt(3)
    INTEGER               :: nmv
    INTEGER               :: nrupts
 
#ifdef W3_MPI
    INTEGER               :: mpi_comm_grd
    INTEGER               :: mpi_comm_bct
    INTEGER               :: croot
    INTEGER               :: nrqbpg
    INTEGER               :: nrqhgg
    INTEGER               :: nrqeqg
#endif
    INTEGER, POINTER      :: tmv(:,:,:)
    INTEGER, POINTER      :: nbi2s(:,:)
    INTEGER, POINTER      :: mapmsk(:,:)
    INTEGER, POINTER      :: uptmap(:)
 
#ifdef W3_MPI
    INTEGER, POINTER      :: irqbpg(:)
    INTEGER, POINTER      :: irqhgg(:)
    INTEGER, POINTER      :: irqeqg(:)
#endif
    REAL, POINTER         :: data0(:,:)
    REAL, POINTER         :: data1(:,:)
    REAL, POINTER         :: data2(:,:)
    REAL, POINTER         :: amv(:,:)
    REAL, POINTER         :: dmv(:,:)
 
    REAL, POINTER         :: mapbdi(:,:)
    REAL, POINTER         :: mapodi(:,:)
#ifdef W3_PDLIB
    INTEGER, POINTER      :: sea_ipgl(:)
    INTEGER, POINTER      :: sea_ipgl_to_proc(:)
#endif
    LOGICAL               :: minit
    LOGICAL               :: mskini
    LOGICAL               :: fllstl
    LOGICAL               :: fllstr
    LOGICAL               :: fllsti
    LOGICAL               :: fldat0
    LOGICAL               :: fldat1
    LOGICAL               :: fldat2
 
#ifdef W3_MPI
    LOGICAL                :: fbcast
#endif
  END TYPE mdata
 
  !
 
  TYPE bpst
#ifdef W3_MPI
    INTEGER                :: nrqbps
    INTEGER                :: stime(2)
#endif
    INTEGER                 :: vtime(2)
#ifdef W3_MPI
    INTEGER, POINTER        :: irqbps(:)
#endif
    REAL, POINTER           :: sbpi(:,:)
#ifdef W3_MPI
    REAL, POINTER           :: tstore(:,:)
#endif
    LOGICAL                 :: init
  END TYPE bpst
  !
  TYPE hgst
    INTEGER                 :: vtime(2)
    INTEGER                 :: ntot
    INTEGER                 :: nrec
    INTEGER                 :: nrc1
    INTEGER                 :: nsnd
    INTEGER                 :: nsn1
    INTEGER                 :: nsmx
    INTEGER                 :: xtime(2)
 
#ifdef W3_MPI
    INTEGER                 :: nrqhgs
    INTEGER                 :: nrqout
#endif
    INTEGER, POINTER        :: ljsea(:)
    INTEGER, POINTER        :: nravg(:)
    INTEGER, POINTER        :: impsrc(:,:)
    INTEGER, POINTER        :: itag(:,:)
    INTEGER, POINTER        :: isend(:,:)
#ifdef W3_MPI
    INTEGER, POINTER        :: irqhgs(:)
    INTEGER, POINTER        :: outdat(:,:)
#endif
    REAL, POINTER           :: wgth(:,:)
    REAL, POINTER           :: shgh(:,:,:)
#ifdef W3_MPI
    REAL, POINTER            :: tstore(:,:)
#endif
    LOGICAL                  :: init
  END TYPE hgst
 
  !
 
  TYPE eqst
    INTEGER                 :: vtime(2)
    INTEGER                 :: ntot
    INTEGER                 :: nrec
    INTEGER                 :: nsnd
    INTEGER                 :: navmax
#ifdef W3_MPI
    INTEGER                 :: nrqeqs
    INTEGER                 :: nrqout
#endif
    INTEGER, POINTER        :: isea(:)
    INTEGER, POINTER        :: jsea(:)
    INTEGER, POINTER        :: navg(:)
    INTEGER, POINTER        :: rip(:,:)
    INTEGER, POINTER        :: rtg(:,:)
    INTEGER, POINTER        :: sis(:)
    INTEGER, POINTER        :: sjs(:)
    INTEGER, POINTER        :: si1(:)
    INTEGER, POINTER        :: si2(:)
    INTEGER, POINTER        :: sip(:)
    INTEGER, POINTER        :: stg(:)
 
#ifdef W3_MPI
    INTEGER, POINTER        :: irqeqs(:)
    INTEGER, POINTER        :: outdat(:,:)
#endif
    REAL, POINTER           :: seql(:,:,:)
    REAL, POINTER           :: wght(:)
    REAL, POINTER           :: wavg(:,:)
#ifdef W3_MPI
    REAL, POINTER            :: tstore(:,:)
#endif
    LOGICAL                  :: init
  END TYPE eqst
  !/
  !/ Data storage
  !/
  TYPE(mdata), TARGET, ALLOCATABLE  :: mdatas(:)
  TYPE(bpst),  TARGET, ALLOCATABLE  :: bpstge(:,:)
  TYPE(hgst),  TARGET, ALLOCATABLE  :: hgstge(:,:)
  TYPE(eqst),  TARGET, ALLOCATABLE  :: eqstge(:,:)
  !/
  !/ Data aliasses for structure MDATA(S)
  !/
  INTEGER, POINTER           :: rcld(:)
  INTEGER, POINTER           :: ndt(:)
  INTEGER, POINTER           :: nmv
  INTEGER, POINTER           :: tmv(:,:,:)
  INTEGER, POINTER           :: nbi2s(:,:)
  INTEGER, POINTER           :: mapmsk(:,:)
  INTEGER, POINTER           :: uptmap(:)
#ifdef W3_MPI
  INTEGER, POINTER           :: mpi_comm_grd
  INTEGER, POINTER           :: mpi_comm_bct
  INTEGER, POINTER           :: croot
#endif
  REAL, POINTER              :: data0(:,:)
  REAL, POINTER              :: data1(:,:)
  REAL, POINTER              :: data2(:,:)
  REAL, POINTER              :: amv(:,:)
  REAL, POINTER              :: dmv(:,:)
 
  REAL, POINTER              :: mapbdi(:,:)
  REAL, POINTER              :: mapodi(:,:)
#ifdef W3_PDLIB
  INTEGER, POINTER           :: sea_ipgl(:)
  INTEGER, POINTER           :: sea_ipgl_to_proc(:)
#endif
  LOGICAL, POINTER           :: minit
  LOGICAL, POINTER           :: fllstl
  LOGICAL, POINTER           :: fllstr
  LOGICAL, POINTER           :: fllsti
  LOGICAL, POINTER           :: fldat0
  LOGICAL, POINTER           :: fldat1
  LOGICAL, POINTER           :: fldat2
 
#ifdef W3_MPI
  LOGICAL, POINTER           :: fbcast
#endif
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmndat ( NDSE, NDST )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 !
    !/                  +-----------------------------------+
    !/
    !/    22-Feb-2005 : Origination.                        ( version 3.07 )
    !/    16-Dec-2005 : Add staging of boundary data.       ( version 3.08 )
    !/                  Add HGSTGE data.                    ( version 3.08 )
    !/    24-Mar-2006 : Add EQSTGE data.                    ( version 3.09 )
    !/    25-May-2006 : Add STIME in BPSTGE.                ( version 3.09 )
    !/    12-Jan-2007 : Add FLSTI and FLLSTL.               ( version 3.10 )
    !/    22-Jan-2007 : Add NAVMAX.                         ( version 3.10 )
    !/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
    !/    22-Mar-2021 : Support for air density input       ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Set up the number of grids to be used.
    !
    !  2. Method :
    !
    !     Use data stored in NGRIDS in W3GDATMD.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !     Any program that uses this grid structure.
    !
    !  6. Error messages :
    !
    !     - Error checks on previous setting of variable NGRIDS.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: ngrids
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NDSE, NDST
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: I, J
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMNDAT')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( ngrids .EQ. -1 ) THEN
      WRITE (ndse,1001) ngrids
      CALL extcde (1)
    END IF
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Set variable and allocate arrays
    !
    ALLOCATE ( mdatas(ngrids), bpstge(ngrids,ngrids),               &
         hgstge(ngrids,ngrids), eqstge(ngrids,ngrids),        &
         bcdump(nrgrd), iflsti(nrinp), iflstl(nrinp),         &
         iflstr(nrinp), stat=istat )
    check_alloc_status( istat )
#ifdef W3_MPI
    ALLOCATE ( nbista(ngrids), hghsta(ngrids), eqlsta(ngrids), &
         stat=istat )
    check_alloc_status( istat )
#endif
    nmdata = ngrids
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Initialize parameters
    !
#ifdef W3_MPI
    nbista = 0
    hghsta = 0
    eqlsta = 0
#endif
    !
    iflsti = .false.
    iflstl = .false.
    iflstr = .false.
    !
    DO i=1, ngrids
      mdatas(i)%MINIT  = .false.
      mdatas(i)%MSKINI = .false.
      mdatas(i)%FLDAT0 = .false.
      mdatas(i)%FLDAT1 = .false.
      mdatas(i)%FLDAT2 = .false.
#ifdef W3_MPI
      mdatas(i)%MPI_COMM_GRD = -99
      mdatas(i)%MPI_COMM_BCT = -99
#endif
      DO j=1, ngrids
        bpstge(i,j)%VTIME(1) = -1
        bpstge(i,j)%VTIME(2) =  0
#ifdef W3_MPI
        bpstge(i,j)%STIME(1) = -1
        bpstge(i,j)%STIME(2) =  0
#endif
        bpstge(i,j)%INIT     = .false.
#ifdef W3_MPI
        bpstge(i,j)%NRQBPS   = 0
#endif
        hgstge(i,j)%VTIME(1) = -1
        hgstge(i,j)%VTIME(2) =  0
        hgstge(i,j)%XTIME(1) = -1
        hgstge(i,j)%XTIME(2) =  0
        hgstge(i,j)%NTOT     =  0
        hgstge(i,j)%NREC     =  0
        hgstge(i,j)%NRC1     =  0
        hgstge(i,j)%NSND     =  0
        hgstge(i,j)%NSN1     =  0
        hgstge(i,j)%NSMX     =  0
#ifdef W3_MPI
        hgstge(i,j)%NRQHGS   =  0
        hgstge(i,j)%NRQOUT   =  0
#endif
        hgstge(i,j)%INIT     = .false.
        eqstge(i,j)%VTIME(1) = -1
        eqstge(i,j)%VTIME(2) =  0
        eqstge(i,j)%NTOT     =  0
        eqstge(i,j)%NREC     =  0
        eqstge(i,j)%NSND     =  0
        eqstge(i,j)%NAVMAX   =  1
#ifdef W3_MPI
        eqstge(i,j)%NRQEQS   =  0
        eqstge(i,j)%NRQOUT   =  0
#endif
        eqstge(i,j)%INIT     = .false.
      END DO
    END DO
    !
#ifdef W3_T
    WRITE (ndst,9000) ngrids
#endif
    !
    RETURN
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR WMNDAT : NGRIDS NOT YET SET *** '/         &
         '                    NGRIDS = ',i10/                   &
         '                    RUN W3NMOD FIRST'/)
    !
#ifdef W3_T
9000 FORMAT (' TEST WMNDAT : SETTING UP FOR ',i4,' GRIDS')
#endif
    !/
    !/ End of WMNDAT ----------------------------------------------------- /
    !/
  END SUBROUTINE wmndat
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmdimd ( IMOD, NDSE, NDST, J )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         10-Dec-2014 !
    !/                  +-----------------------------------+
    !/
    !/    22-Feb-2005 : Origination.                        ( version 3.07 )
    !/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
    !/
    !  1. Purpose :
    !
    !     Initialize an individual data grid at the proper dimensions.
    !
    !  2. Method :
    !
    !     Allocate directly into the structure array. Note that
    !     this cannot be done through the pointer alias!
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number to point to.
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !       J       Int.   I   Data set [1,2,3].
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     - Check on input parameters.
    !     - Check on previous allocation.
    !
    !  7. Remarks :
    !
    !     - WMSETM needs to be called after allocation to point to
    !       proper allocated arrays.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: ngrids, igrid, w3setg
    USE w3odatmd, ONLY: naproc
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)           :: IMOD, NDSE, NDST, J
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: JGRID
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMDIMD')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( ngrids .EQ. -1 ) THEN
      WRITE (ndse,1001)
      CALL extcde (1)
    END IF
    !
    IF ( imod.LT.1 .OR. imod.GT.nmdata ) THEN
      WRITE (ndse,1002) imod, nmdata
      CALL extcde (2)
    END IF
    !
    IF ( mdatas(imod)%MINIT ) THEN
      WRITE (ndse,1003)
      CALL extcde (3)
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) imod
#endif
    !
    jgrid  = igrid
    IF ( jgrid .NE. imod ) CALL w3setg ( imod, ndse, ndst )
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Allocate arrays
    !
    IF ( j .EQ. 0 ) THEN
      ALLOCATE ( mdatas(imod)%TMV(2,-7:4,nmv) ,            &
           mdatas(imod)%AMV(nmv,-7:4)   ,            &
           mdatas(imod)%DMV(nmv,-7:4)   , stat=istat )
      check_alloc_status( istat )
    END IF
    !
    IF ( j .EQ. 1 ) THEN
      IF ( fldat0 ) DEALLOCATE ( mdatas(imod)%DATA0 )
      ALLOCATE ( mdatas(imod)%DATA0(rcld(j),ndt(j)), stat=istat )
      check_alloc_status( istat )
      fldat0 = .true.
    END IF
    !
    IF ( j .EQ. 2 ) THEN
      IF ( fldat1 ) DEALLOCATE ( mdatas(imod)%DATA1 )
      ALLOCATE ( mdatas(imod)%DATA1(rcld(j),ndt(j)), stat=istat )
      check_alloc_status( istat )
      fldat1 = .true.
    END IF
    !
    IF ( j .EQ. 3 ) THEN
      IF ( fldat2 ) DEALLOCATE ( mdatas(imod)%DATA2 )
      ALLOCATE ( mdatas(imod)%DATA2(rcld(j),ndt(j)), stat=istat )
      check_alloc_status( istat )
      fldat2 = .true.
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9001)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Point to allocated arrays
    !
    CALL wmsetm ( imod, ndse, ndst )
    !
    IF ( j .EQ. 0 ) THEN
      tmv    = 0
      amv    = 0.
      dmv    = 0.
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9002)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 5.  Restore previous grid setting if necessary
    !
    IF ( jgrid .NE. imod ) CALL w3setg ( jgrid, ndse, ndst )
    !
    RETURN
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR WMDIMD : GRIDS NOT INITIALIZED *** '/      &
         '                    RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR WMDIMD : ILLEGAL MODEL NUMBER *** '/       &
         '                    IMOD   = ',i10/                   &
         '                    NMDATA = ',i10/)
1003 FORMAT (/' *** ERROR WMDIMD : ARRAY(S) ALREADY ALLOCATED *** ')
    !
#ifdef W3_T
9000 FORMAT (' TEST WMDIMD : MODEL ',i4,' DIM. AT ',2i5,i7)
9001 FORMAT (' TEST WMDIMD : ARRAYS ALLOCATED')
9002 FORMAT (' TEST WMDIMD : POINTERS RESET')
#endif
    !/
    !/ End of WMDIMD ----------------------------------------------------- /
    !/
  END SUBROUTINE wmdimd
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmdimm  ( IMOD, NDSE, NDST )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Feb-2005 !
    !/                  +-----------------------------------+
    !/
    !/    22-Feb-2005 : Origination.                        ( version 3.07 )
    !/
    !  1. Purpose :
    !
    !     Initialize an individual data grid at the proper dimensions.
    !
    !  2. Method :
    !
    !     Allocate directly into the structure array. Note that
    !     this cannot be done through the pointer alias!
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number to point to.
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     - Check on input parameters.
    !     - Check on previous allocation.
    !
    !  7. Remarks :
    !
    !     - WMSETM needs to be called after allocation to point to
    !       proper allocated arrays.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: ngrids, igrid, w3setg
    USE w3odatmd, ONLY: naproc
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)           :: IMOD, NDSE, NDST
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: JGRID
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMDIMM')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( ngrids .EQ. -1 ) THEN
      WRITE (ndse,1001)
      CALL extcde (1)
    END IF
    !
    IF ( imod.LT.1 .OR. imod.GT.nmdata ) THEN
      WRITE (ndse,1002) imod, nmdata
      CALL extcde (2)
    END IF
    !
    IF ( mdatas(imod)%MINIT ) THEN
      WRITE (ndse,1003)
      CALL extcde (3)
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) imod
#endif
    !
    jgrid  = igrid
    IF ( jgrid .NE. imod ) CALL w3setg ( imod, ndse, ndst )
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Allocate arrays
    !
    !     ALLOCATE ( MDATAS(IMOD)%...
    !
#ifdef W3_T
    WRITE (ndst,9001)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Point to allocated arrays
    !
    CALL wmsetm ( imod, ndse, ndst )
    !
#ifdef W3_T
    WRITE (ndst,9002)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 4.  Update flag
    !
    minit  = .true.
    !
#ifdef W3_T
    WRITE (ndst,9003)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 5.  Restore previous grid setting if necessary
    !
    IF ( jgrid .NE. imod ) CALL w3setg ( jgrid, ndse, ndst )
    !
    RETURN
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR WMDIMM : GRIDS NOT INITIALIZED *** '/      &
         '                    RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR WMDIMM : ILLEGAL MODEL NUMBER *** '/       &
         '                    IMOD   = ',i10/                   &
         '                    NMDATA = ',i10/)
1003 FORMAT (/' *** ERROR WMDIMM : ARRAY(S) ALREADY ALLOCATED *** ')
    !
#ifdef W3_T
9000 FORMAT (' TEST WMDIMM : MODEL ',i4,' DIM. AT ',2i5,i7)
9001 FORMAT (' TEST WMDIMM : ARRAYS ALLOCATED')
9002 FORMAT (' TEST WMDIMM : POINTERS RESET')
9003 FORMAT (' TEST WMDIMM : FLAGS SET')
#endif
    !/
    !/ End of WMDIMM ----------------------------------------------------- /
    !/
  END SUBROUTINE wmdimm
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmsetm ( IMOD, NDSE, NDST )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 !
    !/                  +-----------------------------------+
    !/
    !/    13-Jun-2005 : Origination.                       ( version 3.07 )
    !/    22-Mar-2021 : Support for air density input      ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Select one of the WAVEWATCH III grids / models.
    !
    !  2. Method :
    !
    !     Point pointers to the proper variables in the proper element of
    !     the GRIDS array.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number to point to.
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !     Many subroutines in the WAVEWATCH system.
    !
    !  6. Error messages :
    !
    !     Checks on parameter list IMOD.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD, NDSE, NDST
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMSETM')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( nmdata .EQ. -1 ) THEN
      WRITE (ndse,1001)
      CALL extcde (1)
    END IF
    !
    IF ( imod.LT.1 .OR. imod.GT.nmdata ) THEN
      WRITE (ndse,1002) imod, nmdata
      CALL extcde (2)
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) imod
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Set model numbers
    !
    imdata = imod
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Set pointers
    !
    !
    nmv    => mdatas(imod)%NMV
    tmv    => mdatas(imod)%TMV
    amv    => mdatas(imod)%AMV
    dmv    => mdatas(imod)%DMV
#ifdef W3_MPI
    mpi_comm_grd => mdatas(imod)%MPI_COMM_GRD
    mpi_comm_bct => mdatas(imod)%MPI_COMM_BCT
    croot  => mdatas(imod)%CROOT
    fbcast => mdatas(imod)%FBCAST
#endif
    rcld   => mdatas(imod)%RCLD
    ndt    => mdatas(imod)%NDT
    data0  => mdatas(imod)%DATA0
    data1  => mdatas(imod)%DATA1
    data2  => mdatas(imod)%DATA2
    nbi2s  => mdatas(imod)%NBI2S
    mapmsk => mdatas(imod)%MAPMSK
    minit  => mdatas(imod)%MINIT
    fllstl => mdatas(imod)%FLLSTL
    fllsti => mdatas(imod)%FLLSTI
    fllstr => mdatas(imod)%FLLSTR
    mapbdi => mdatas(imod)%MAPBDI
    mapodi => mdatas(imod)%MAPODI
#ifdef W3_PDLIB
    sea_ipgl => mdatas(imod)%SEA_IPGL
    sea_ipgl_to_proc => mdatas(imod)%SEA_IPGL_TO_PROC
#endif
    uptmap => mdatas(imod)%UPTMAP
    !
    RETURN
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR WMSETM : GRIDS NOT INITIALIZED *** '/      &
         '                    RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR WMSETM : ILLEGAL MODEL NUMBER *** '/       &
         '                    IMOD   = ',i10/                   &
         '                    NMDATA = ',i10/)
    !
#ifdef W3_T
9000 FORMAT (' TEST WMSETM : MODEL ',i4,' SELECTED')
#endif
    !/
    !/ End of WMSETM ----------------------------------------------------- /
    !/
  END SUBROUTINE wmsetm
  !**********************************************************************
  !*                                                                    *
  !**********************************************************************
  !/ ------------------------------------------------------------------- /
  SUBROUTINE init_get_jsea_isproc_glob(ISEA, J, JSEA, ISPROC)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           Aron Roland             |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         14-Jun-2018 |
    !/                  +-----------------------------------+
    !/
    !/    06-Jun-2018 : Origination.                        ( version 6.04 )
    !/
    !  1. Purpose : Introduce mapping for ISPROC and JSEA when using PDLIB
    !               in the Multigrid approach
    !
    !  2. Method :
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !  7. Remarks
    !  8. Structure :
    !  9. Switches :
    !
    !     !/S  Enable subroutine tracing.
    !
    ! 10. Source code :
    !
    USE constants, ONLY: lpdlib
    USE w3odatmd, ONLY: outpts
    USE w3gdatmd, ONLY: gtype, grids, ungtype
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !/
    IMPLICIT NONE
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    integer, intent(in) :: ISEA, J
    integer, intent(out) :: JSEA, ISPROC
    integer nb
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'INIT_GET_JSEA_ISPROC_GLOB')
#endif
    IF (.NOT. lpdlib) THEN
      nb=outpts(j)%NAPROC
      jsea   = 1 + (isea-1)/nb
      isproc=1
#ifdef W3_DIST
      isproc = mdatas(j)%CROOT - 1 + isea - (jsea-1)*nb
#endif
    ELSE
#ifdef W3_PDLIB
      IF (grids(j)%GTYPE .ne. ungtype) THEN
        nb=outpts(j)%NAPROC
        jsea   = 1 + (isea-1)/nb
        isproc = mdatas(j)%CROOT - 1 + isea - (jsea-1)*nb
      ELSE
        jsea   = mdatas(j)%SEA_IPGL(isea)
        isproc = mdatas(j)%SEA_IPGL_TO_PROC(isea)
      ENDIF
#endif
    ENDIF
    !/
    !/ End of INIT_GET_JSEA_ISPROC_GLOB  ---------------------------------- /
    !/
  END SUBROUTINE init_get_jsea_isproc_glob
  !/
  !/ End of module WMMDATMD -------------------------------------------- /
  !/
END MODULE wmmdatmd