WW3/wminitmd_8F90_source.html

#include "w3macros.h"

!/ ------------------------------------------------------------------- /

MODULE wminitmd

  !/

  !/                  +-----------------------------------+

  !/                  | WAVEWATCH III           NOAA/NCEP |

  !/                  |           H. L. Tolman            |

  !/                  |                        FORTRAN 90 |

  !/                  | Last update :         22-Mar-2021 |

  !/                  +-----------------------------------+

  !/

  !/    13-Jun-2005 : Origination.                        ( version 3.07 )

  !/                  See subroutine for update log.

  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )

  !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )

  !/                  (W. E. Rogers & T. J. Campbell, NRL)

  !/    16-Aug-2010 : Adding NTRMAX to unify NTRACE.      ( version 3.14 )

  !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to

  !/                  specify index closure for a grid.   ( version 3.14 )

  !/                  (T. J. Campbell, NRL)

  !/    05-Sep-2011 : Distribute HQFAC anf HPFAC to idle processors for

  !/                  use in WMGRIDMD.                    ( version 4.05 )

  !/    07-Mar-2012 : Adding TNAMES to avoid read warn.   ( version 4.07 )

  !/                  Adjust allocation INPMAP and IDINP.

  !/    12-Mar-2012 : Fixing format 9061.                 ( version 3.14 )

  !/                  Use MPI_COMM_NULL for checks instead of fixed '-1'.

  !/    28-Jul-2012 : Initialize FLGR2 properly.          ( version 4.08 )

  !/                  Tom Durrant's fix, but moved to allocation.

  !/    28-Nov-2012 : Bug fix: Distribute to idle processors the grid data

  !/                  required for regridding.            ( version 4.08 )

  !/                  (T. J. Campbell, NRL)

  !/    02-Sep-2012 : Set up for > 999 test files.        ( version 4.10 )

  !/                  Set up output for  > 999 procs.

  !/    03-Sep-2012 : Output of initilization time.       ( version 4.10 )

  !/                  Switch test file on/off (TSTOUT)

  !/    18-Dec-2013 : Adding error checking for FLAGLL    ( version 4.16 )

  !/    28-Jan-2014 : Add memory hwm to profiling.        ( version 5.00 )

  !/    04-Feb-2014 : Switched clock to DATE_AND_TIME     ( version 4.18 )

  !/                  (A. Chawla and Mark Szyszka)

  !/    27-May-2014 : Bug fix prf file name.              ( version 5.02 )

  !/    20-Jan-2017 : Update to new W3GSRUMD APIs         ( version 6.02 )

  !/    20-Jan-2017 : Modify input forcing flags to support coupler input.

  !/                  Add ESMF override for STIME & ETIME ( version 6.02 )

  !/                  (T. J. Campbell, NRL)

  !/    15-May-2018 : Update namelist                     ( version 6.05 )

  !/    22-Mar-2021 : Add momentum and air density input  ( version 7.13 )

  !/

  !/    Copyright 2009-2014 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 :

  !

  !     Initialization of the multi-grid wave model. As a preparation

  !     for coupled modeling, all initialization, including the

  !     processing of the input file has ben included in the routine.

  !

  !  2. Variables and types :

  !

  !      Name      Type  Scope    Description

  !     ----------------------------------------------------------------

  !      NTRMAX    Int.  Local    Maximum number of subroutine trace

  !                               printouts (NTRACE in subr. ITRACE).

  !     ----------------------------------------------------------------

  !

  !  3. Subroutines and functions :

  !

  !      Name      Type  Scope    Description

  !     ----------------------------------------------------------------

  !      WMINIT    Subr. Public   Wave model initialization.

  !     ----------------------------------------------------------------

  !

  !  4. Subroutines and functions used :

  !

  !     See subroutine documentation.

  !

  !  5. Remarks :

  !

  !  6. Switches :

  !

  !     See subroutine documentation.

  !

  !  7. Source code :

  !

  !/ ------------------------------------------------------------------- /

  PUBLIC

  !/


  INTEGER, PRIVATE        :: NTRMAX = 1000


  !/

CONTAINS

  !/ ------------------------------------------------------------------- /

  SUBROUTINE wminit ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME,       &

       MPI_COMM, PREAMB )

    !/

    !/                  +-----------------------------------+

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         22-Mar-2021 |

    !/                  +-----------------------------------+

    !/

    !/    13-Jun-2005 : Origination.                        ( version 3.07 )

    !/    28-Dec-2005 : Add static nesting.                 ( version 3.08 )

    !/    25-May-2006 : Add overlapping grids.              ( version 3.09 )

    !/    26-Jun-2006 : Add output type 6.                  ( version 3.09 )

    !/    29-Jun-2006 : Adding file name preamble.          ( version 3.09 )

    !/    09-Aug-2006 : Unified point output added.         ( version 3.10 )

    !/    14-Oct-2006 : Adding separate input grids.        ( version 3.10 )

    !/    03-Nov-2006 : Adding wave field separation.       ( version 3.10 )

    !/    02-Feb-2007 : Adding FLAGST initialization.       ( version 3.10 )

    !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11 )

    !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )

    !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )

    !/                  (W. E. Rogers & T. J. Campbell, NRL)

    !/    16-Aug-2010 : Adding NTRMAX to unify NTRACE.    ( version 3.14.5 )

    !/    21-Sep-2010 : Adding coupling output              ( version 3.14-Ifremer)

    !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to

    !/                  specify index closure for a grid.   ( version 3.14 )

    !/                  (T. J. Campbell, NRL)

    !/    28-Jul-2012 : Initialize FLGR2 properly.          ( version 4.08 )

    !/                  Tom Durant's fix, but moved to allocation.

    !/    28-Nov-2012 : Bug fix: Distribute to idle processors the grid data

    !/                  required for regridding.            ( version 4.08 )

    !/                  (T. J. Campbell, NRL)

    !/    02-Sep-2012 : Set up for > 999 test files.        ( version 4.10 )

    !/                  Set up output for  > 999 procs.

    !/    03-Sep-2012 : Output of initilization time.       ( version 4.10 )

    !/                  Switch test file on/off (TSTOUT)

    !/    28-Nov-2012 : Bug fix: Distribute to idle processors the grid data

    !/                  required for regridding.            ( version 4.08 )

    !/                  (T. J. Campbell, NRL)

    !/    15-Apr-2013 : Changes the reading of output fields( version 4.10 )

    !/                  (F. Ardhuin)

    !/    28-Jan-2014 : Add memory hwm to profiling.        ( version 5.00 )

    !/    27-May-2014 : Bug fix prf file name.              ( version 5.02 )

    !/    17-Sep-2014 : Read mod_def before inp file        ( version 5.03 )

    !/    20-Jan-2017 : Update to new W3GSRUMD APIs         ( version 6.02 )

    !/    20-Jan-2017 : Modify input forcing flags to support coupler input.

    !/                  Add ESMF override for STIME & ETIME ( version 6.02 )

    !/                  (T. J. Campbell, NRL)

    !/    28-Oct-2020 : Add SMCTYPE for SMC sub-grid.  JGLi ( version 7.13 )

    !/    22-Mar-2021 : Add momentum and air density input  ( version 7.13 )

    !/

    !  1. Purpose :

    !

    !     Initialize multi-grid version of WAVEWATCH III.

    !

    !  2. Method :

    !

    !  3. Parameters :

    !

    !     Parameter list

    !     ----------------------------------------------------------------

    !       IDSI    Int.   I   Unit number for input file.

    !       IDSO    Int.   I   Unit number for output file.

    !       IDSS    Int.   I   Unit number for "screen" output. Switch off

    !                          by setting equal to IDSO.

    !       IDST    Int.   I   Unit number for test output.

    !       IDSE    Int.   I   Unit number for error output.

    !       IFNAME  Char   I   File name for input file.

    !     MPI_COMM  Int.   I   MPI communicator to be used.

    !       PREAMB  Char   I   File name preamble (optional).

    !     ----------------------------------------------------------------

    !

    !  4. Subroutines used :

    !

    !      Name      Type  Module   Description

    !     ----------------------------------------------------------------

    !      W3NMOD    Subr. W3GDATMD Data structure initialization.

    !      W3DIMX    Subr.   Id.    Set grid arrays.

    !      W3DIMS    Subr.   Id.    Set grid arrays.

    !      W3SETG    Subr.   Id.    Point to grid/model.

    !      W3NDAT    Subr. W3WDATMD Data structure initialization.

    !      W3SETW    Subr.   Id.    Point to grid/model.

    !      W3NAUX    Subr. W3ADATMD Data structure initialization.

    !      W3SETA    Subr.   Id.    Point to grid/model.

    !      W3NOUT    Subr. W3ODATMD Data structure initialization.

    !      W3SETO    Subr.   Id.    Point to grid/model.

    !      W3NINP    Subr. W3IDATMD Data structure initialization.

    !      W3SETI    Subr.   Id.    Point to grid/model.

    !      W3DIMI    Subr.   Id.    Allocate grid/model.

    !      WMNDAT    Subr. WMMDATMD Data structure initialization.

    !      WMSETM    Subr.   Id.    Point to grid/model.

    !      WMDIMD    Subr.   Id.    Allocate array space.

    !      W3FLDO    Subr. W3FLDSMD Open input data file.

    !      W3IOGR    Subr. W3IOGRMD Reading of model definition file.

    !      W3INIT    Subr. W3INITMD Model intiailization.

    !      WMGLOW    Subr. WMGRIDMD Lower rank grid dependencies.

    !      WMGEQL    Subr.   Id.    Same rank grid dependencies.

    !      WMGHGH    Subr.   Id.    Higher rank grid dependencies.

    !      RESPEC    Subr.   Id.    Spectral conversion flags.

    !      WMIOBS    Subr. WMINIOMD Stage boundary data.

    !      WMIOBG    Subr.   Id.    Gather boundary data.

    !      WMIOBF    Subr.   Id.    Finalize staging in WMIOBS.

    !      WMUINI    Subr. WMUNITMD Initialize dynamic unit assignment,

    !      WMUDMP    Subr.   Id.    Dump dynamic unit data,

    !      WMUSET    Subr.   Id.    Set unit number data.

    !      WMUGET    Subr.   Id.    Get a unit number.

    !      WMUINQ    Subr.   Id.    Update unit number info.

    !      WMIOPP    Subr. WMIOPOMD Initialize unified point output.

    !      ITRACE    Subr. W3SERVMD Initialize subroutine tracing.

    !      STRACE    Subr.   Id.    Subroutine tracing.

    !      EXTCDE    Subr.   Id.    Program abort.

    !      WWDATE    Subr.   Id.    System date.

    !      WWTIME    Subr.   Id.    System time.

    !      NEXTLN    Subr.   Id.    Find next input line in file.

    !      PRINIT    Subr.   Id.    Profiling routine ( !/MPRF )

    !      PRTIME    Subr.   Id.    Profiling routine ( !/MPRF )

    !      STME21    Subr. W3TIMEMD Convert time to string.

    !      DSEC21    Func.   Id.    Difference between times.

    !      TICK21    Subr.   Id.    Advance the clock.

    !      W3READFLGRD Subr. W3IOGOMD Reads flags or namelist for output fields

    !

    !      MPI_COMM_SIZE, CALL MPI_COMM_RANK, MPI_BARRIER, MPI_COMM_GROUP,

    !      MPI_GROUP_INCLUDE, MPI_COMM_CREATE, MPI_GROUP_FREE, MPI_BCAST

    !                Subr. mpif.h   Standard MPI routines.

    !     ----------------------------------------------------------------

    !

    !  5. Called by :

    !

    !      Name      Type  Module   Description

    !     ----------------------------------------------------------------

    !      W3MLTI    Prog.   N/A    Multi-grid model driver.

    !      ....                     Any coupled model.

    !     ----------------------------------------------------------------

    !

    !  6. Error messages :

    !

    !     See formats 1000 and following, or escape locations 2000 and

    !     following.

    !

    !  7. Remarks :

    !

    !     - When running regtests in cases where disk is non-local

    !       (i.e. NFS used), there can be a huge improvment in compute

    !       time by using /var/tmp/ for log files.

    !       See commented line at "OPEN (MDSO,FILE=..."

    !

    !     - IDFLDS dimensioning is hardwired as IDFLDS(-7:9) where lowest possible

    !       value of JFIRST is JFIRST=-7

    !

    !  8. Structure :

    !

    !     --------------------------------------------------------------

    !      1.  Multi-grid model intializations

    !        a Unit numbers

    !        b Subroutine tracing                            ( ITRACE )

    !        c Input file

    !        d Log and test files

    !        e Initial and test output

    !      2.  Set-up of data structures and I/O

    !        a Get number of grids

    !        b Set up data structures

    !                 ( W3NMOD, W3NDAT, W3NAUX, W3NOUT, W3NINP, WMNDAT )

    !        c Set up I/O for individual models

    !      3.  Get individual grid information

    !        a Read data

    !        b Assign input file numbers.

    !        c Set rank and group data

    !        d Unified point output file.                    ( W3IOGR )

    !        e Output

    !      4.  Model run time information and settings

    !      5.  Output requests

    !        a Loop over types for unified output

    !        ---------------------------------------------------

    !        b Process standard line

    !        c Type 1: fields of mean wave parameters

    !        d Type 2: point output

    !        e Type 3: track output

    !        f Type 4: restart files (no additional data)

    !        g Type 5: nesting data (no additional data)

    !        h Type 6: wave field data (dummy for now)

    !        i Set all grids to unified output

    !        ---------------------------------------------------

    !        j Endless loop for correcting output per grid

    !        ---------------------------------------------------

    !          Test grid name and output number

    !        k Process standard line

    !        l Type 1: fields of mean wave parameters

    !        m Type 2: point output

    !        n Type 3: track output

    !        o Type 6: partitioning output

    !        p Type 7: coupling output

    !        ---------------------------------------------------

    !      6.  Read moving grid data

    !      7.  Work load distribution

    !        a Initialize arrays

    !        b Set communicators and ALLPRC array

    !        c Set MODMAP and LOADMP arrays

    !        d Warnings

    !      8.  Actual initializations

    !        a Loop over models for per-model initialization

    !           1 Wave model                                 ( W3INIT )

    !           2 Data files                                 ( W3FLDO )

    !           3 Grid status indicator and model times

    !           3 Grid data for processors that are NOT used.

    !           5 Test output

    !        b Input data files.

    !        c Inter model initialization

    !           1 Set spectral conversion flags              ( WMRSPC )

    !           2 Prepare unified point output               ( WMIOPO )

    !           3 Relation to lower ranked grids

    !                                ( WMGLOW, WMIOBS, WMIOBG, WMIOBF )

    !           4 Relation to same ranked grids              ( WMGEQL )

    !           5 Relation to higher ranked grids            ( WMGHGH )

    !           6 Output

    !     --------------------------------------------------------------

    !

    !  9. Switches :

    !

    !       !/SHRD  Switch for shared / distributed memory architecture.

    !       !/DIST  Id.

    !       !/MPI   Id.

    !

    !       !/MGW   Moving grid wind correction.

    !       !/MGP   Moving grid propagation correction.

    !

    !       !/O10   Enable output identifying start and end of routine

    !

    !       !/S     Enable subroutine tracing.

    !       !/T     Enable test output.

    !       !/MPRF  Profiling.

    !

    ! 10. Source code :

    !

    !/ ------------------------------------------------------------------- /

    USE constants

    !/

    USE w3gdatmd, ONLY: w3nmod, w3dimx, w3dims, w3setg

    USE w3wdatmd, ONLY: w3ndat, w3setw

    USE w3adatmd, ONLY: w3naux, w3seta

    USE w3odatmd, ONLY: w3nout, w3seto

    USE w3idatmd, ONLY: w3ninp, w3seti, w3dimi

    USE wmmdatmd, ONLY: wmndat, wmsetm, wmdimd

    !

    USE w3fldsmd, ONLY: w3fldo

    USE w3iogomd, ONLY: w3readflgrd

    USE w3iogrmd, ONLY: w3iogr

    USE w3initmd, ONLY: w3init

    USE wmgridmd, ONLY: wmrspc, wmglow, wmgeql, wmghgh, wmsmceql

    USE wminiomd, ONLY: wmiobs, wmiobg, wmiobf

    USE wmiopomd, ONLY: wmiopp

    !/

    USE w3servmd, ONLY: itrace, extcde, wwdate, wwtime, nextln

#ifdef W3_S

    USE w3servmd, ONLY: strace

#endif

#ifdef W3_MPRF

    USE w3timemd, ONLY: prinit, prtime

#endif

    USE w3timemd, ONLY: stme21, dsec21, tick21, tdiff

    USE wmunitmd, ONLY: wmuini, wmudmp, wmuset, wmuget, wmuinq

    !/

    USE w3gdatmd, ONLY: gtype, nx, ny, filext, nsea, flagst, grids

#ifdef W3_SMC

    USE w3gdatmd, ONLY: ncel, nufc, nvfc, nrlv, nbsmc

    USE w3gdatmd, ONLY: narc, nbac, nspec, smctype

#endif

#ifdef W3_MPI

    USE w3gdatmd, ONLY: flagll, iclose, gsu, x0, y0, sx, sy,   &

         xgrd, ygrd, dxdp, dxdq, dydp, dydq,    &

         hqfac, hpfac, mapsta, mapst2,          &

         gridshift, nseal, nk, nth, xfr, fr1,   &

         th, dtmax, dtcfl

    USE w3gsrumd

#endif

    USE w3wdatmd, ONLY: time

    USE w3adatmd, ONLY: wadats

    USE w3idatmd, ONLY: inflags1, inflags2, inputs, iinit,  &

         jfirst

    USE w3odatmd, ONLY: nogrp, ngrpp, flout, tonext, flbpi,  &

         flbpo, nfbpo, nbi, nds, iaproc,     &

         napfld, nappnt, naptrk, napbpt,     &

         napprt, naproc, fnmpre, outpts, ndst, ndse, &

         nopts, iostyp, unipts, upproc, dtout,       &

         tolast, notype

    USE wmmdatmd, ONLY: mdsi, mdso, mdss, mdst, mdse, mdsf, mdsup,  &

         improc, nmproc, nmpscr, nmperr,     &

         nmplog, nmpupt, stime, etime, nmv, nmvmax,  &

         tmv, amv, dmv, nrgrd, nrinp, nrgrp, grank,  &

         grgrp, ingrp, grdhgh, grdeql, grdlow,       &

         allprc, modmap, tsync, tmax, toutp, tdata,  &

         grstat, dtres, bcdump, flghg1, flghg2,      &

         inpmap, idinp, ngrpsmc

    USE wmmdatmd, ONLY: clkdt1, clkdt2, clkfin

#ifdef W3_MPI

    USE wmmdatmd, ONLY: mpi_comm_mwave, mpi_comm_grd,          &

         mpi_comm_bct, croot, fbcast

#endif

#ifdef W3_MPRF

    USE wmmdatmd, ONLY: mdsp

#endif

#ifdef W3_ASCII

    USE wmmdatmd, ONLY: mdsupa

#endif

    USE w3initmd, ONLY: wwver

    USE w3odatmd, ONLY:  ofiles

    !

    !/

    IMPLICIT NONE

    !

#ifdef W3_MPI

    include "mpif.h"

#endif

    !/

    !/ ------------------------------------------------------------------- /

    !/ Parameter list

    !/

    INTEGER, INTENT(IN)        :: IDSI, IDSO, IDSS, IDST, IDSE,     &

         MPI_COMM

    CHARACTER*(*), INTENT(IN)  :: IFNAME

    CHARACTER*(*), INTENT(IN), OPTIONAL :: PREAMB

    !/

    !/ ------------------------------------------------------------------- /

    !/ Local parameters

    !/

    INTEGER                 :: MDSE2, IERR, I, J, NMOVE, TTIME(2),  &

         ILOOP, MDSI2, SCRATCH, RNKMIN,       &

         RNKMAX, RNKTMP, GRPMIN, GRPMAX, II,  &

         NDSREC, NDSFND, NPTS, JJ, IP1, IPN,  &

         MPI_COMM_LOC, NMPSC2, JJJ, TOUT(2),  &

         TLST(2), NCPROC, NPOUTT, NAPLOC,     &

         NAPRES, NAPADD, NAPBCT, IFI, IFJ, IW,&

         IFT

    INTEGER                 :: STMPT(2), ETMPT(2)

#ifdef W3_MPI

    INTEGER                 :: IERR_MPI, BGROUP, LGROUP, IROOT

#endif

#ifdef W3_S

    INTEGER, SAVE           :: IENT = 0

#endif

    INTEGER, ALLOCATABLE    :: MDS(:,:), NTRACE(:,:), ODAT(:,:),    &

         TMPRNK(:), TMPGRP(:), NINGRP(:),     &

         TMOVE(:,:), LOADMP(:,:), IPRT(:,:),  &

         NDPOUT(:), OUTFF(:,:)

    REAL                    :: DTTST, XX, YY


#ifdef W3_MPRF

    REAL                    :: PRFT0, PRFTN

    REAL(KIND=8)            :: get_memory

#endif

    REAL, ALLOCATABLE       :: X(:), Y(:), AMOVE(:), DMOVE(:),      &

         RP1(:), RPN(:)

    LOGICAL                 :: FLT, TFLAGI, TFLAGS(-7:14), PSHARE

    LOGICAL, ALLOCATABLE    :: FLGRD(:,:,:), FLRBPI(:), BCDTMP(:),   &

         USEINP(:), LPRT(:), FLGR2(:,:,:),     &

         FLGD(:,:), FLG2(:,:), FLG2D(:,:),     &

         FLG1D(:), CPLINP(:)

    CHARACTER(LEN=1)        :: COMSTR

    CHARACTER(LEN=3)        :: IDSTR(9), IDTST

    CHARACTER(LEN=5)        :: STOUT, OUTSTR(6)

    CHARACTER(LEN=6)        :: ACTION(11), YESXX, XXXNO

    CHARACTER(LEN=8)        :: LFILE, STTIME

#ifdef W3_SHRD

    CHARACTER(LEN=9)        :: TFILE

#endif

    CHARACTER(LEN=13)       :: STDATE, MN, TNAMES(9)

    CHARACTER(LEN=40)       :: PN

    CHARACTER(LEN=13),                                              &

         ALLOCATABLE :: INAMES(:,:), MNAMES(:)

    CHARACTER(LEN=40),                                              &

         ALLOCATABLE :: PNAMES(:)

    CHARACTER(LEN=12)       :: FORMAT

#ifdef W3_DIST

    CHARACTER(LEN=18)       :: TFILE

#endif

#ifdef W3_MPRF

    CHARACTER(LEN=18)       :: PFILE

#endif


    CHARACTER(LEN=13)       :: IDFLDS(-7:9)

    CHARACTER(LEN=23)       :: DTME21

    CHARACTER(LEN=30)       :: IDOTYP(8)

    CHARACTER(LEN=80)       :: TNAME

    CHARACTER(LEN=80)       :: LINE

    CHARACTER(LEN=80)       :: LINEIN

    CHARACTER(LEN=8)        :: WORDS(6)


    TYPE ot2tpe

      INTEGER                    :: NPTS

      REAL, POINTER              :: X(:), Y(:)

      CHARACTER(LEN=40), POINTER :: PNAMES(:)

    END TYPE ot2tpe

    !

    TYPE(ot2tpe), ALLOCATABLE    :: OT2(:)

    !/

    !/ ------------------------------------------------------------------- /

    !/


    DATA idflds / 'ice param. 1 ' , 'ice param. 2 ' ,               &

         'ice param. 3 ' , 'ice param. 4 ' ,               &

         'ice param. 5 ' ,                                 &

         'mud density  ' , 'mud thkness  ' ,               &

         'mud viscos.  ' ,                                 &

         'water levels ' , 'currents     ' ,               &

         'winds        ' , 'ice fields   ' ,               &

         'momentum     ' , 'air density  ' ,               &

         'mean param.  ' , '1D spectra   ' ,               &

         '2D spectra   ' /

    !

    DATA idotyp / 'Fields of mean wave parameters' ,                &

         'Point output                  ' ,                &

         'Track point output            ' ,                &

         'Restart files                 ' ,                &

         'Nesting data                  ' ,                &

         'Separated wave field data     ' ,                &

         'Fields for coupling           ' ,                &

         'Restart files second request  '/

    !

    DATA idstr  / 'LEV', 'CUR', 'WND', 'ICE', 'TAU', 'RHO',         &

         'DT0', 'DT1', 'DT2' /

    !

    DATA yesxx  / 'YES/--' /

    DATA xxxno  / '---/NO' /

    !

#ifdef W3_MPRF

    CALL prinit

    CALL prtime ( prft0 )

#endif

    !

    CALL date_and_time ( values=clkdt1 )

    !

    mpi_comm_loc   = mpi_comm

#ifdef W3_MPI

    mpi_comm_mwave = mpi_comm

    CALL mpi_comm_size ( mpi_comm_mwave, nmproc, ierr_mpi )

    CALL mpi_comm_rank ( mpi_comm_mwave, improc, ierr_mpi )

    improc = improc + 1

#endif

    !

    IF ( PRESENT(preamb) ) fnmpre = preamb

    !/

    !/ ------------------------------------------------------------------- /

    ! 1.  Multi-grid model intializations

    ! 1.a Unit numbers

    !     Initialize dynamic assignment, errors and test to stdout

    !

    CALL wmuini ( 6, 6 )

    !

    ! ... Identify reserved unit numbers

    !

    CALL wmuset ( 6,6,  5, .true., 'SYS', 'stdin', 'Standart input' )

    CALL wmuset ( 6,6,  6, .true., 'SYS', 'stdout','Standart output')

    !

#ifdef W3_NL2

    CALL wmuset (6,6,103, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,104, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,105, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,106, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,107, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,108, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,109, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,110, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,111, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,112, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,113, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,114, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,117, .true., 'FIX', desc='Reserved SNL2' )

#endif

    !

    ! ... Unit numbers from parameter list

    !     Dynamic scripture updated per file

    !

    mdsi   = idsi

    mdso   = idso

    mdss   = idss

    mdst   = idst

    mdse   = idse

    !

    IF ( improc .EQ. nmperr ) THEN

      mdse2  = mdse

    ELSE

      mdse2  = -1

    END IF

    !

    ! 1.b Subroutine tracing

    !

    CALL itrace ( mdst, ntrmax )

    !

#ifdef W3_O10

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,900)

#endif

    !

    ! 1.c Input file

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                      &

         WRITE (mdss,910)  ifname, mdsi

    !

    OPEN (mdsi,file=trim(fnmpre)//ifname,status='OLD',err=2000,      &

         iostat=ierr)

    rewind(mdsi)

    READ (mdsi,'(A)',END=2001,ERR=2002) comstr

    IF (comstr.EQ.' ') comstr = '$'

    CALL wmuset ( mdss, mdss, mdsi, .true., 'INP',                  &

         trim(fnmpre)//ifname, 'Model control input file')

    !

    ! 1.d Log and test files

    !

    lfile  = 'log.mww3'

    iw     = 1 + int( log10( real(nmproc) + 0.5 ) )

    iw     = max( 3 , min( 9 , iw ) )

    WRITE (FORMAT,'(A5,I1.1,A1,I1.1,A4)') '(A4,I',iw,'.',iw,',A5)'

#ifdef W3_SHRD

    tfile  = 'test.mww3'

#endif

#ifdef W3_DIST

    WRITE (tfile,format) 'test', improc, '.mww3'

#endif

#ifdef W3_MPRF

    WRITE (pfile,format) 'prf.', improc, '.mww3'

#endif

    !

    IF ( improc .EQ. nmplog ) THEN

      OPEN (mdso,file=trim(fnmpre)//lfile,err=2010,iostat=ierr)

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,911)  lfile, mdso

      CALL wmuset ( mdss, mdss, mdso, .true., 'OUT',              &

           trim(fnmpre)//lfile, 'Log file')

    ELSE

      CALL wmuset ( mdss, mdss, mdso, .true., 'XXX',              &

           'Log file on other processors')

    END IF

    !

    IF ( mdst.NE.mdso .AND. mdst.NE.mdss .AND. tstout ) THEN

      ift    = len_trim(tfile)

      OPEN (mdst,file=trim(fnmpre)//tfile(:ift),err=2011,iostat=ierr)

      CALL wmuset ( mdss, mdst, mdst, .true., 'OUT',              &

           trim(fnmpre)//tfile(:ift), 'Test output file')

    END IF

    !

#ifdef W3_MPRF

    ift    = len_trim(pfile)

    CALL wmuget ( mdss, mdst, mdsp, 'OUT' )

    CALL wmuset ( mdss, mdst, mdsp, .true., 'OUT',            &

         trim(fnmpre)//pfile(:ift), 'Profiling file')

    OPEN (mdsp,file=trim(fnmpre)//pfile(:ift),err=2011,iostat=ierr)

#endif

    !

    ! 1.e Initial and test output

    !

#ifdef W3_S

    CALL strace (ient, 'WMINIT')

#endif

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,912) comstr

    !

    IF ( improc .EQ. nmplog ) THEN

      CALL wwdate ( stdate )

      CALL wwtime ( sttime )

      WRITE (mdso,901) wwver, stdate, sttime

    END IF

    !

#ifdef W3_T

    WRITE(mdst,9000) idsi, idso, idss, idst, idse, ifname

#endif

    !

    ! 2.  Set-up of data structures and I/O  ----------------------------- /

    ! 2.a Get number of grids

    !     Note: grid for consolidated point output always generated.

    !     Processor set as in W3INIT to minimize communication in WMIOPO

    !

    CALL nextln ( comstr , mdsi , mdse2 )

    READ (mdsi,*,END=2001,ERR=2002) NRGRD, NRINP, UNIPTS,           &

         iostyp, upproc, pshare

    iostyp = max( 0 , min( 3 , iostyp ) )

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      WRITE (mdss,920) nrgrd

      IF ( nrinp .EQ. 0 ) THEN

        WRITE (mdss,921)

      ELSE

        WRITE (mdss,922) nrinp

      END IF

      IF ( unipts ) THEN

        WRITE (mdss,923) yesxx

      ELSE

        WRITE (mdss,923) xxxno

      END IF

      WRITE (mdss,1923) iostyp

      IF ( unipts ) THEN

        IF ( upproc ) THEN

          WRITE (mdss,2923) yesxx

        ELSE

          WRITE (mdss,2923) xxxno

        END IF

      END IF

      IF ( iostyp.GT.1 .AND. pshare ) THEN

        WRITE (mdss,3923) yesxx

      ELSE IF ( iostyp.GT. 1 ) THEN

        WRITE (mdss,3923) xxxno

      END IF

    END IF

    !

    IF ( nrgrd .LT. 1 ) GOTO 2020

    IF ( nrinp .LT. 0 ) GOTO 2021

    IF ( nrinp.EQ.0 .AND. .NOT.unipts ) nrinp = -1

    !

    ! 2.b Set up data structures

    !

    CALL w3nmod ( nrgrd, mdse2, mdst, nrinp )

    CALL w3ndat (        mdse2, mdst )

    CALL w3naux (        mdse2, mdst )

    CALL w3nout (        mdse2, mdst )

    CALL w3ninp (        mdse2, mdst )

    CALL wmndat (        mdse2, mdst )

    !

    ! 2.c Set up I/O for individual models (initial)

    !

    ALLOCATE ( mds(15,nrgrd), ntrace(2,nrgrd), odat(40,0:nrgrd),    &

         flgrd(nogrp,ngrpp,nrgrd), ot2(0:nrgrd), flgd(nogrp,nrgrd), &

         mdsf(-nrinp:nrgrd,jfirst:9), iprt(6,nrgrd), lprt(nrgrd),   &

         flgr2(nogrp,ngrpp,nrgrd),flg2d(nogrp,ngrpp), flg1d(nogrp), &

         flg2(nogrp,nrgrd),outff(7,0:nrgrd))

    !

    mds    = -1

    mdsf   = -1

    flgr2  = .false.

    flg2   = .false.

    lprt   = .false.

    iprt   = 0

    !

    ! ... Fixed and recycleable unit numbers.

    !

    CALL wmuget ( mdse, mdst, ndsrec, 'INP' )

    CALL wmuset ( mdse, mdst, ndsrec, .true., 'I/O', name='...',    &

         desc='Recyclable I/O (mod_def etc.)' )

    CALL wmuget ( mdse, mdst, scratch, 'SCR' )

    CALL wmuset ( mdse, mdst, scratch, .true., desc='Scratch file', &

         name=trim(fnmpre)//'ww3_multi.scratch' )

    !

    IF(mdst.EQ.ndsrec)THEN

      IF   ( improc .EQ. nmperr )                                  &

           WRITE(mdse,'(A,I8)')'RECYCLABLE UNIT NUMBERS AND '&

           //'TEST OUTPUT UNIT NUMBER ARE THE SAME : ',mdst

      CALL extcde ( 15 )

    ENDIF


    DO i=1, nrgrd

      mds( 2,i) =  6

      mds( 3,i) = mdst

      mds( 4,i) =  6

      mds( 5,i) = ndsrec

      mds( 6,i) = ndsrec

      ntrace( 1,i) = mdst

      ntrace( 2,i) = ntrmax

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9020) 'INITIAL'

    DO i=1, nrgrd

      WRITE (mdst,9021) i, mds(:,i), ntrace(:,i)

    END DO

#endif

    !

    ! 3.  Get individual grid information -------------------------------- /

    !

    !     Version 3.07: For now we simply read the input data flags,

    !                   skip the homogeneous option. Later on, we want

    !                   to have the options to use input from common

    !                   sources, and from communication rather than

    !                   files.

    !

    ALLOCATE ( inames(2*nrgrd,jfirst:9), mnames(-nrinp:2*nrgrd),   &

         tmprnk(2*nrgrd), tmpgrp(2*nrgrd), ningrp(2*nrgrd),  &

         rp1(2*nrgrd), rpn(2*nrgrd), bcdtmp(nrgrd+1:2*nrgrd) )

    ALLOCATE ( grank(nrgrd), grgrp(nrgrd), useinp(nrinp) )

    ALLOCATE ( cplinp(nrinp) )

    grank  = -1

    grgrp  = -1

    useinp = .false.

    cplinp = .false.

    !

    ! 3.a Read data

    !

#ifdef W3_T

    WRITE (mdst,9030)

#endif

    !

    ! 3.a.1 Input grids

    !

    DO i=1, nrinp

      !

      CALL nextln ( comstr , mdsi , mdse2 )

      CALL w3seti ( -i, mdse, mdst )

      inflags1 = .false.

      READ (mdsi,*,END=2001,ERR=2002) MNAMES(-I), INFLAGS1(JFIRST:9)

      !

    END DO

    !

    ! 3.a.2 Unified point output grid.

    !

    IF ( unipts ) THEN

      !

      CALL w3seti ( 0, mdse, mdst )

      CALL w3seto ( 0, mdse, mdst )

      inflags1 = .false.

      ndst   = mdst

      ndse   = mdse

      !

      CALL nextln ( comstr , mdsi , mdse2 )

      READ (mdsi,*,END=2001,ERR=2002) MNAMES(0)

      !

      IF ( iostyp .LE. 1 ) THEN

        nmpupt = max(1,nmproc-2)

      ELSE

        nmpupt = nmproc

      END IF

      !

    END IF

    !

    ! 3.a.3 Read wave grids

    !

    DO i=nrgrd+1, 2*nrgrd

      CALL nextln ( comstr , mdsi , mdse2 )

      READ (mdsi,*,END=2001,ERR=2002) MNAMES(I), TNAMES(:),         &

           tmprnk(i), tmpgrp(i), rp1(i), rpn(i), bcdtmp(i)

      inames(i,:) = tnames(:)

      rp1(i) = max( 0. , min( 1. , rp1(i) ) )

      rpn(i) = max( rp1(i) , min( 1. , rpn(i) ) )

    END DO

    !

    ! 3.a.4 Sort wave grids

    !

    rnktmp = minval( tmprnk(nrgrd+1:2*nrgrd) )

    i      = 0

    !

    DO

      DO j=nrgrd+1, 2*nrgrd

        IF ( tmprnk(j) .EQ. rnktmp ) THEN

          i      = i + 1

          CALL w3seti ( i, mdse, mdst )

          inflags1      = .false.

#ifdef W3_MGW

          inflags1(10)   = .true.

#endif

#ifdef W3_MGP

          inflags1(10)   = .true.

#endif

          inames(i,:)= inames(j,:)

          mnames(i)  = mnames(j)

          tmprnk(i)  = tmprnk(j)

          tmpgrp(i)  = tmpgrp(j)

          rp1(i)     = rp1(j)

          rpn(i)     = rpn(j)

          bcdump(i)  = bcdtmp(j)

#ifdef W3_T

          WRITE (mdst,9031) i, mnames(i), inflags1, tmprnk(i),    &

               tmpgrp(i), rp1(i), rpn(i)

#endif

        END IF

      END DO

      IF ( i .EQ. nrgrd ) EXIT

      rnktmp = rnktmp + 1

    END DO

    !

    ! 3.a.5 Set input flags

    !

    ALLOCATE ( inpmap(nrgrd,jfirst:10), idinp(-nrinp:nrgrd,jfirst:10) )

    inpmap = 0

    idinp  = '---'

    !

    DO i=1, nrgrd

      CALL w3seti ( i, mdse, mdst )

      DO j=jfirst, 9

        IF ( inames(i,j) .EQ. 'native' ) THEN

          ! *** forcing input from file & defined on the native grid ***

          inflags1(j) = .true.

        ELSE

          inflags1(j) = .false.

          IF ( inames(i,j)(1:4) .EQ. 'CPL:' ) THEN

            IF ( inames(i,j)(5:) .EQ. 'native' ) THEN

              ! *** forcing input from CPL & defined on the native grid ***

              inflags1(j) = .true.

              inpmap(i,j) = -999

            ELSE

              ! *** forcing input from CPL & defined on an input grid ***

              DO jj=1, nrinp

                IF ( mnames(-jj) .EQ. inames(i,j)(5:) ) THEN

                  inpmap(i,j) = -jj

                  EXIT

                END IF

              END DO

              IF ( inpmap(i,j) .EQ. 0 ) GOTO 2030

              IF ( .NOT. inputs(inpmap(i,j))%INFLAGS1(j) ) GOTO 2031

              useinp(-inpmap(i,j)) = .true.

              cplinp(-inpmap(i,j)) = .true.

            END IF

          ELSE IF ( inames(i,j) .NE. 'no' ) THEN

            ! *** forcing input from file & defined on an input grid ***

            DO jj=1, nrinp

              IF ( mnames(-jj) .EQ. inames(i,j) ) THEN

                inpmap(i,j) = jj

                inflags2(j) = .true.

                EXIT

              END IF

            END DO

            IF ( inpmap(i,j) .EQ. 0 ) GOTO 2030

            IF ( .NOT. inputs(-inpmap(i,j))%INFLAGS1(j) ) GOTO 2031

            useinp(inpmap(i,j)) = .true.

          END IF

        END IF

        !        INFLAGS2 is initial value of INFLAGS1. Unlike INFLAGS1,

        !           it does not change during the simulation

        IF(.NOT. inflags2(j)) inflags2(j)=inflags1(j)

      END DO !         DO J=JFIRST, 9

    END DO !      DO I=1, NRGRD

    !

    DO i=1, nrinp

      IF ( .NOT.useinp(i) .AND.                                     &

           mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        ii     = len_trim(mnames(-i))

        WRITE (mdse,1032) mnames(-i)(1:ii)

      END IF

    END DO

    !

    ! 3.b Assign input file unit numbers

    !

    DO i=-nrinp, nrgrd

      IF ( i .EQ. 0 ) cycle

      CALL w3seti ( i, mdse, mdst )

      DO j=jfirst, 9

        IF ( i .GE. 1 ) THEN

          IF ( inpmap(i,j) .LT. 0 ) cycle

        END IF

        IF ( inflags1(j) ) THEN

          CALL wmuget ( mdse, mdst, ndsfnd, 'INP' )

          CALL wmuset ( mdse, mdst, ndsfnd, .true.,               &

               desc='Input data file' )

          mdsf(i,j) = ndsfnd

        END IF

      END DO

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9022)

    DO i=-nrinp, nrgrd

      IF ( i .EQ. 0 ) cycle

      WRITE (mdst,9021) i, mdsf(i,jfirst:9)

    END DO

#endif

    !

    ! 3.c Set rank and group data

    !

#ifdef W3_T

    WRITE (mdst,9032)

#endif

    !

    rnkmax = maxval( tmprnk(1:nrgrd) ) + 1

    rnktmp = 0

    !

    DO

      rnkmin = minval( tmprnk(1:nrgrd) )

      IF ( rnkmin .EQ. rnkmax ) EXIT

      rnktmp = rnktmp + 1

      DO i=1, nrgrd

        IF ( tmprnk(i) .EQ. rnkmin ) THEN

          grank(i)  = rnktmp

          tmprnk(i) = rnkmax

        END IF

      END DO

    END DO

    !

#ifdef W3_T

    DO i=1, nrgrd

      WRITE (mdst,9033) i, mnames(i), grank(i)

    END DO

#endif

    !

    rnkmax = rnktmp

    grpmax = maxval( tmpgrp(1:nrgrd) ) + 1

    nrgrp  = 0

    ningrp = 0

    !

    DO rnktmp=1, rnkmax

      DO

        grpmin = grpmax

        DO i=1, nrgrd

          IF ( grank(i) .EQ. rnktmp )                               &

               grpmin = min( grpmin , tmpgrp(i) )

        END DO

        IF ( grpmin .EQ. grpmax ) EXIT

        nrgrp  = nrgrp + 1

        DO i=1, nrgrd

          IF ( grank(i).EQ.rnktmp .AND. grpmin.EQ.tmpgrp(i) ) THEN

            grgrp(i)  = nrgrp

            tmpgrp(i) = grpmax

            ningrp(nrgrp) = ningrp(nrgrp) + 1

          END IF

        END DO

      END DO

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9034) nrgrp

    DO i=1, nrgrd

      WRITE (mdst,9033) i, mnames(i), grgrp(i)

    END DO

    WRITE (mdst,9035) ningrp(1:nrgrp)

#endif

    !

    ALLOCATE ( ingrp(nrgrp,0:maxval(ningrp(:nrgrp))) )

    DEALLOCATE ( tmprnk, tmpgrp, ningrp, bcdtmp )

    ingrp = 0

    !

    DO i=1, nrgrd

      ingrp(grgrp(i),0) = ingrp(grgrp(i),0) + 1

      ingrp(grgrp(i),ingrp(grgrp(i),0)) = i

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9036)

    DO j=1, nrgrp

      WRITE (mdst,9037) j, ingrp(j,:ingrp(j,0))

    END DO

#endif

    !

    !

    ! 3.d Unified point output

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.b'

    prft0  = prftn

#endif

    !

    IF ( unipts ) THEN

      !

      j      = len_trim(mnames(0))

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        WRITE (mdss,986) mnames(0)(1:j)

        WRITE (mdss,987)

      END IF

      !

      CALL w3iogr ( 'GRID', ndsrec, 0, mnames(0)(1:j) )

      !

    END IF

    !

    ! 3.e Output

    !

    IF ( nrinp .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,924)

      IF ( nmplog .EQ. improc ) WRITE (mdso,924)

      DO i=1, nrinp

        IF ( .NOT. useinp(i) ) cycle

        CALL w3seti ( -i, mdse, mdst )

        action(1:6) = '---   '

        DO j=jfirst, 6

          IF ( inflags1(j) ) action(j) = ' X    '

        END DO

        action(7:9) = '-     '

        IF ( inflags1(7) ) action(7) = '1     '

        IF ( inflags1(8) ) action(8) = '2     '

        IF ( inflags1(9) ) action(9) = '3     '

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,925) i, mnames(-i), action(jfirst:9)

        IF ( nmplog .EQ. improc )                                 &

             WRITE (mdso,925) i, mnames(-i), action(jfirst:9)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,926)

      IF ( nmplog .EQ. improc ) WRITE (mdso,926)

    END IF

    !

    IF ( unipts ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,927)

      IF ( nmplog .EQ. improc ) WRITE (mdso,927)

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,928) mnames(0)

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,928) mnames(0)

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,929)

      IF ( nmplog .EQ. improc ) WRITE (mdso,929)

    END IF

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,930)

    IF ( nmplog .EQ. improc ) WRITE (mdso,930)

    DO i=1, nrgrd

      CALL w3seti ( i, mdse, mdst )

      action(1:6) = '---   '

      DO j=jfirst, 6

        IF ( inflags1(j) .AND. inpmap(i,j) .EQ. 0 ) THEN

          action(j) = 'native'

        ELSE IF ( inflags1(j) .AND. inpmap(i,j) .EQ. -999 ) THEN

          action(j) = 'native'

        ELSE IF ( inpmap(i,j) .GT. 0 ) THEN

          action(j) = mnames(-inpmap(i,j))

        ELSE IF ( inpmap(i,j) .LT. 0 ) THEN

          action(j) = mnames( inpmap(i,j))

        END IF

      END DO

      action(7:11) = '-     '

      IF ( inflags1(7) ) action(7) = '1     '

      IF ( inflags1(8) ) action(8) = '2     '

      IF ( inflags1(9) ) action(9) = '3     '

      IF ( inflags1(10) ) THEN

        action(10) = 'yes   '

      ELSE

        action(10) = 'no    '

      END IF

      IF ( bcdump(i) ) action(11) = 'y     '

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,931) i, mnames(i), action(1:10), grank(i),     &

           grgrp(i), action(11)

      IF ( nmplog .EQ. improc )                                     &

           WRITE (mdso,931) i, mnames(i), action(1:10), grank(i),     &

           grgrp(i), action(11)

    END DO

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,932)

    IF ( nmplog .EQ. improc ) WRITE (mdso,932)

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                      &

         WRITE (mdss,933) 'Group information'

    IF ( nmplog .EQ. improc )                                       &

         WRITE (mdso,933) 'Group information'

    DO j=1, nrgrp

      WRITE (line(1:6),'(1X,I3,2X)') j

      jjj    = 6

      DO jj=1, ingrp(j,0)

        IF ( jjj .GT. 60 ) THEN

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )              &

               WRITE (mdss,934) line(1:jjj)

          IF ( nmplog .EQ. improc ) WRITE (mdso,934) line(1:jjj)

          line(1:6) = '      '

          jjj       = 6

        END IF

        WRITE (line(jjj+1:jjj+3),'(I3)') ingrp(j,jj)

        !

        line(jjj+4:jjj+5) = ' ('

        WRITE (line(jjj+6:jjj+11),'(F6.4)') rp1(ingrp(j,jj))

        line(jjj+12:jjj+12) = '-'

        WRITE (line(jjj+13:jjj+18),'(F6.4)') rpn(ingrp(j,jj))

        line(jjj+19:jjj+19) = ')'

        jjj    = jjj + 19

        !

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,934) line(1:jjj)

      IF ( nmplog .EQ. improc ) WRITE (mdso,934) line(1:jjj)

    END DO

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

    IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    !

    ! 4.  Model run time information etc. -------------------------------- /

    !

    !     Version 3.07: Same for all grids, diversify later ....

    !     If invoked as ESMF Component, then STIME and ETIME are set

    !     in WMESMFMD from the external clock.

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,940)

    !

    CALL nextln ( comstr , mdsi , mdse2 )

    IF (is_esmf_component) THEN

      READ (mdsi,*,END=2001,ERR=2002) STMPT, etmpt

    ELSE

      READ (mdsi,*,END=2001,ERR=2002) STIME, etime

    END IF

    !

    CALL stme21 ( stime , dtme21 )

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,941) dtme21

    CALL stme21 ( etime , dtme21 )

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,942) dtme21

    !

    DO i=1, nrgrd

      CALL w3setw ( i, mdse, mdst )

      time   = stime

    END DO

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,943)

    !

    CALL nextln ( comstr , mdsi , mdse2 )

    READ (mdsi,*,END=2001,ERR=2002) FLGHG1, flghg2

    flghg2 = flghg1 .AND. flghg2

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      IF ( flghg1 ) THEN

        WRITE (mdss,944) yesxx

      ELSE

        WRITE (mdss,944) xxxno

      END IF

      IF ( flghg2 ) THEN

        WRITE (mdss,945) yesxx

      ELSE

        WRITE (mdss,945) xxxno

      END IF

    END IF

    !

    ! 5.  Output requests ------------------------------------------------ /

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,950)

    npts   = 0

    !

    ! 5.a Loop over types for unified output

    !

    notype = 6

    DO j=1, notype

      !

      ! 5.b Process standard line

      !

      CALL nextln ( comstr , mdsi , mdse2 )

      !

      IF(j .LE. 2) THEN

        words(1:6)=''

        READ (mdsi,'(A)') linein

        READ(linein,*,iostat=ierr) words

        !

        IF(j .LE. 1) THEN

          READ(words( 1 ), * ) odat(1,1)

          READ(words( 2 ), * ) odat(2,1)

          READ(words( 3 ), * ) odat(3,1)

          READ(words( 4 ), * ) odat(4,1)

          READ(words( 5 ), * ) odat(5,1)

        ELSE

          READ(words( 1 ), * ) odat(6,1)

          READ(words( 2 ), * ) odat(7,1)

          READ(words( 3 ), * ) odat(8,1)

          READ(words( 4 ), * ) odat(9,1)

          READ(words( 5 ), * ) odat(10,1)

        END IF


        IF (words(6) .NE. '0' .AND. words(6) .NE. '1') THEN

          outff(j,1)=0

        ELSE

          READ(words( 6 ), * ) outff(j,1)

          !            print*,' Number of data: ', 6

        END IF

        ! CHECKPOINT

      ELSE IF(j .EQ. 4) THEN

        words(1:6)=''

        READ (mdsi,'(A)') linein

        READ(linein,*,iostat=ierr) words

        !

        READ(words( 1 ), * ) odat(16,1)

        READ(words( 2 ), * ) odat(17,1)

        READ(words( 3 ), * ) odat(18,1)

        READ(words( 4 ), * ) odat(19,1)

        READ(words( 5 ), * ) odat(20,1)

        IF (words(6) .EQ. 'T') THEN

          CALL nextln ( comstr , mdsi , mdse2 )

          READ (mdsi,*,END=2001,ERR=2002)(ODAT(I,1),I=5*(8-1)+1,5*8)

        ELSE

          odat(5*(8-1)+1,1)=0

          odat(5*(8-1)+2,1)=0

          odat(5*(8-1)+3,1)=0

          odat(5*(8-1)+4,1)=0

          odat(5*8,1)=0

        END IF

      ELSE

        READ (mdsi,*,END=2001,ERR=2002)(ODAT(I,1),I=5*(J-1)+1,5*J)

        outff(j,1) = 0

      END IF

      !

      outpts(1)%OFILES(j)=outff(j,1)

      !

      !

      odat(5*(j-1)+3,1) = max( 0 , odat(5*(j-1)+3,1) )

      !

      IF ( odat(5*(j-1)+3,1) .NE. 0 ) THEN

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,951) j, idotyp(j)

        ttime(1) = odat(5*(j-1)+1,1)

        ttime(2) = odat(5*(j-1)+2,1)

        CALL stme21 ( ttime , dtme21 )

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,952) dtme21

        ttime(1) = odat(5*(j-1)+4,1)

        ttime(2) = odat(5*(j-1)+5,1)

        CALL stme21 ( ttime , dtme21 )

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,953) dtme21

        ttime(1) = 0

        ttime(2) = 0

        dttst    = real( odat(5*(j-1)+3,1) )

        CALL tick21 ( ttime , dttst  )

        CALL stme21 ( ttime , dtme21 )

        IF ( ( odat(5*(j-1)+1,1) .NE. odat(5*(j-1)+4,1) .OR.      &

             odat(5*(j-1)+2,1) .NE. odat(5*(j-1)+5,1) ) .AND.   &

             mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

          DO i=1, 18

            IF ( dtme21(i:i).NE.'0' .AND.                       &

                 dtme21(i:i).NE.'/' .AND.                       &

                 dtme21(i:i).NE.' ' .AND.                       &

                 dtme21(i:i).NE.':' ) EXIT

            dtme21(i:i) = ' '

          END DO

          WRITE (mdss,954) dtme21(1:19)


        END IF

        IF ( j .EQ. 1 ) THEN

          !

          ! 5.c Type 1: fields of mean wave parameters

          !

          flgrd(:,:,:)=.false. ! Initialize FLGRD

          CALL w3readflgrd ( mdsi, mdss, mdso, mdse2, comstr, flg1d,    &

               flg2d, improc, nmpscr, ierr )

          flgrd(:,:,1)=flg2d

          flgd(:,1)   =flg1d

          !

        ELSE IF ( j .EQ. 2 ) THEN

          !

          ! 5.d Type 2: point output

          !

          DO iloop=1, 2

            IF ( iloop .EQ. 1 ) THEN

              mdsi2  = mdsi

              IF ( improc .EQ. 1 ) OPEN                       &

                   (scratch,file=trim(fnmpre)//'ww3_multi.scratch')

            ELSE

              mdsi2  = scratch

#ifdef W3_MPI

              CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

              OPEN                                            &

                   (scratch,file=trim(fnmpre)//'ww3_multi.scratch')

              rewind(scratch)

              IF (npts.GT.0) THEN

                ALLOCATE ( x(npts), y(npts), pnames(npts) )

              ELSE

                GOTO 2054

              END IF

            END IF

            !

            npts = 0

            DO

              CALL nextln ( comstr , mdsi2 , mdse2 )

              READ (mdsi2,*,END=2001,ERR=2002) XX, YY, pn

              !

              IF ( iloop.EQ.1 .AND. improc.EQ.1 ) THEN

                backspace(mdsi)

                READ (mdsi,'(A)') line

                WRITE (scratch,'(A)') line

              END IF

              !

              IF ( pn .EQ. 'STOPSTRING' ) EXIT

              !

              npts = npts + 1

              IF ( iloop .EQ. 1 ) cycle

              !

              x(npts)      = xx

              y(npts)      = yy

              pnames(npts) = pn

              IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

                IF ( npts .EQ. 1 ) THEN

                  WRITE (mdss,957)       xx, yy, pn

                ELSE

                  WRITE (mdss,958) npts, xx, yy, pn

                END IF

              END IF

              !

            END DO

            !

            IF ( improc.EQ.1 .AND. iloop.EQ.1 ) CLOSE (scratch)

          END DO

          !

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc .AND.        &

               npts.EQ.0 ) WRITE (mdss,959)

          IF ( improc .EQ. 1 ) THEN

#ifdef W3_MPI

            CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

            CLOSE (scratch,status='DELETE')

          ELSE

            CLOSE (scratch)

#ifdef W3_MPI

            CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

          END IF

          !

        ELSE IF ( j .EQ. 3 ) THEN

          !

          ! 5.e Type 3: track output

          !

          CALL nextln ( comstr , mdsi , mdse2 )

          READ (mdsi,*,END=2001,ERR=2002) tflagi

          IF ( .NOT. tflagi ) mds(11,:) = -mds(11,:)

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

            IF ( .NOT. tflagi ) THEN

              WRITE (mdss,960) 'input', 'UNFORMATTED'

            ELSE

              WRITE (mdss,960) 'input', 'FORMATTED'

            END IF

          END IF

          !

        ELSE IF ( j .EQ. 4 ) THEN

          !

          ! 5.f Type 4: restart files (no additional data)

          !

        ELSE IF ( j .EQ. 5 ) THEN

          !

          ! 5.g Type 5: nesting data (no additional data)

          !

        ELSE IF ( j .EQ. 6 ) THEN

          !

          ! 5.h Type 6: partitioned wave field data

          !

          CALL nextln ( comstr , mdsi , mdse2 )

          READ (mdsi,*,END=2001,ERR=2002) IPRT(:,1), LPRT(1)

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

            WRITE (mdss,961) iprt(:,1)

            IF ( .NOT. lprt(1) ) THEN

              WRITE (mdss,960) 'output', 'UNFORMATTED'

            ELSE

              WRITE (mdss,960) 'output', 'FORMATTED'

            END IF

          END IF

          !

          ! ... End of output type selecttion ELSE IF

          !

        END IF

        !

        ! ... End of IF in 5.b

        !

      END IF

      !

      ! ... End of loop in 5.a

      !

    END DO

    !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

    ! Checkpoint

    j=8

    IF ( odat(5*(j-1)+3,1) .NE. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

           WRITE (mdss,951) j, idotyp(j)

      ttime(1) = odat(5*(j-1)+1,1)

      ttime(2) = odat(5*(j-1)+2,1)

      CALL stme21 ( ttime , dtme21 )

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

           WRITE (mdss,952) dtme21

      ttime(1) = odat(5*(j-1)+4,1)

      ttime(2) = odat(5*(j-1)+5,1)

      CALL stme21 ( ttime , dtme21 )

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

           WRITE (mdss,953) dtme21

      ttime(1) = 0

      ttime(2) = 0

      dttst    = real( odat(5*(j-1)+3,1) )

      CALL tick21 ( ttime , dttst  )

      CALL stme21 ( ttime , dtme21 )

      IF ( ( odat(5*(j-1)+1,1) .NE. odat(5*(j-1)+4,1) .OR.      &

           odat(5*(j-1)+2,1) .NE. odat(5*(j-1)+5,1) ) .AND.   &

           mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        DO i=1, 18

          IF ( dtme21(i:i).NE.'0' .AND.                       &

               dtme21(i:i).NE.'/' .AND.                       &

               dtme21(i:i).NE.' ' .AND.                       &

               dtme21(i:i).NE.':' ) EXIT

          dtme21(i:i) = ' '

        END DO

        WRITE (mdss,954) dtme21(1:19)

      END IF

    END IF

    !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

    !

    ! 5.i Set all grids to unified output

    !

    IF ( unipts ) THEN

      odat(6:10,0) = odat(6:10,1)

      odat( 8 , 1) = 0

      outpts(1)%OFILES(1)   = outff(1,1)

    END IF

    !

    DO i=2, nrgrd

      odat(:,i)  = odat(:,1)

      outff(:,i) = outff(:,1)

      outpts(i)%OFILES(:)=outff(:,1)

      flgd(:,i) = flgd(:,1)

      flgrd(:,:,i) = flgrd(:,:,1)

      flg2(:,i) = flg2(:,1)

      flgr2(:,:,i) = flgr2(:,:,1)

      iprt(:,i)  = iprt(:,1)

      lprt(i)    = lprt(1)

    END DO

    !

    IF ( npts.EQ.0 .OR. odat(8,0).EQ.0 ) unipts = .false.

    IF ( unipts ) THEN

      IF ( ( npts.EQ.0 .OR.  odat(8,0).EQ.0 ) .AND.               &

           improc.EQ.nmperr ) WRITE (mdse,1050)

      IF ( npts.EQ.0 .OR. odat(8,0).EQ.0 ) unipts = .false.

      ot2(0)%NPTS = npts

      ALLOCATE (ot2(0)%X(npts),ot2(0)%Y(npts),ot2(0)%PNAMES(npts))

      ot2(0)%X      = x

      ot2(0)%Y      = y

      ot2(0)%PNAMES = pnames

      DO i=1, nrgrd

        ot2(i)%NPTS = 0

        ALLOCATE (ot2(i)%X(1),ot2(i)%Y(1),ot2(i)%PNAMES(1))

      END DO

    ELSE

      DO i=1, nrgrd

        ot2(i)%NPTS = npts

        IF ( npts .EQ. 0 ) THEN

          ALLOCATE (ot2(i)%X(1),ot2(i)%Y(1),ot2(i)%PNAMES(1))

        ELSE

          ALLOCATE (ot2(i)%X(npts),ot2(i)%Y(npts),              &

               ot2(i)%PNAMES(npts))

          ot2(i)%X      = x

          ot2(i)%Y      = y

          ot2(i)%PNAMES = pnames

        END IF

      END DO

    END IF

    !

    ! 5.j Endless loop for correcting output per grid

    !

    DO

      CALL nextln ( comstr , mdsi , mdse2 )

      READ (mdsi,*,END=2001,ERR=2002) MN, j

      !

      ! 5.j.1 Bail out loop for output type 0

      !

      IF ( j .EQ. 0 ) EXIT

      !

      ! 5.j.2 Find the grid number

      !

      ii     = len_trim(mn)

      DO i=1, nrgrd

        IF ( mn(:ii) .EQ. mnames(i)(1:ii) ) EXIT

      END DO

      !

      IF ( i .GT. nrgrd ) GOTO 2051

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,962) mn(1:ii), i

      !

      ! 5.j.3 Check the output type

      !

      IF ( j.LT.0 .OR. j.GT. notype ) GOTO 2052

      IF ( j.EQ.2 .AND. unipts ) GOTO 2053

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,951) j, idotyp(j)

      !

      ! 5.k Process standard line

      !

      CALL nextln ( comstr , mdsi , mdse2 )

      IF(j .LE. 2) THEN

        outff(j,i)=0

        words(1:6) =''

        READ (mdsi,'(A)') linein

        READ(linein,*,iostat=ierr) words

        IF(j .EQ. 1) THEN

          READ(words( 1 ), * ) odat(1,i)

          READ(words( 2 ), * ) odat(2,i)

          READ(words( 3 ), * ) odat(3,i)

          READ(words( 4 ), * ) odat(4,i)

          READ(words( 5 ), * ) odat(5,i)

        ELSE

          READ(words( 1 ), * ) odat(6,i)

          READ(words( 2 ), * ) odat(7,i)

          READ(words( 3 ), * ) odat(8,i)

          READ(words( 4 ), * ) odat(9,i)

          READ(words( 5 ), * ) odat(10,i)

        END IF

        IF (words(6) .NE. '0' .AND. words(6) .NE. '1') THEN

          outff(j,i)=0

        ELSE

          READ(words( 6 ), * ) outff(j,i)

        END IF

        !

      ELSE

        READ (mdsi,*,END=2001,ERR=2002)(ODAT(II,I),II=5*(J-1)+1,5*J)

        outff(j,i) = 0

      END IF

      !

      outpts(i)%OFILES(j)=outff(j,i)

      !

      odat(5*(j-1)+3,i) = max( 0 , odat(5*(j-1)+3,i) )

      !

      IF ( odat(5*(j-1)+3,i) .NE. 0 ) THEN

        ttime(1) = odat(5*(j-1)+1,i)

        ttime(2) = odat(5*(j-1)+2,i)

        CALL stme21 ( ttime , dtme21 )

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,952) dtme21

        ttime(1) = odat(5*(j-1)+4,i)

        ttime(2) = odat(5*(j-1)+5,i)

        CALL stme21 ( ttime , dtme21 )

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,953) dtme21

        ttime(1) = 0

        ttime(2) = 0

        dttst    = real( odat(5*(j-1)+3,i) )

        CALL tick21 ( ttime , dttst  )

        CALL stme21 ( ttime , dtme21 )

        IF ( ( odat(5*(j-1)+1,i) .NE. odat(5*(j-1)+4,i) .OR.      &

             odat(5*(j-1)+2,i) .NE. odat(5*(j-1)+5,i) ) .AND.   &

             mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

          DO ii=1, 18

            IF ( dtme21(ii:ii).NE.'0' .AND.                     &

                 dtme21(ii:ii).NE.'/' .AND.                     &

                 dtme21(ii:ii).NE.' ' .AND.                     &

                 dtme21(ii:ii).NE.':' ) EXIT

            dtme21(ii:ii) = ' '

          END DO

          WRITE (mdss,954) dtme21(1:19)

        END IF

        !

        IF ( j .EQ. 1 ) THEN

          !

          ! 5.l Type 1: fields of mean wave parameters

          !

          CALL w3readflgrd ( mdsi, mdss, mdso, mdse2, comstr,    &

               flg1d, flg2d, improc, nmpscr, ierr )

          flgd(:,i)    = flg1d

          flgrd(:,:,i) = flg2d

          !

        ELSE IF ( j .EQ. 2 ) THEN

          !

          ! 5.m Type 2: point output

          !

          DO iloop=1, 2

            IF ( iloop .EQ. 1 ) THEN

              mdsi2  = mdsi

              IF ( improc .EQ. 1 ) OPEN                       &

                   (scratch,file=trim(fnmpre)//'ww3_multi.scratch')

            ELSE

              mdsi2  = scratch

#ifdef W3_MPI

              CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

              OPEN                                            &

                   (scratch,file=trim(fnmpre)//'ww3_multi.scratch')

              rewind(scratch)

              DEALLOCATE ( ot2(i)%X, ot2(i)%Y, ot2(i)%PNAMES )

              ALLOCATE ( ot2(i)%X(ot2(i)%NPTS),               &

                   ot2(i)%Y(ot2(i)%NPTS),               &

                   ot2(i)%PNAMES(ot2(i)%NPTS) )

            END IF

            !

            ot2(i)%NPTS = 0

            DO

              CALL nextln ( comstr , mdsi2 , mdse2 )

              READ (mdsi2,*,END=2001,ERR=2002) XX, YY, pn

              !

              IF ( iloop.EQ.1 .AND. improc.EQ.1 ) THEN

                backspace(mdsi)

                READ (mdsi,'(A)') line

                WRITE (scratch,'(A)') line

              END IF

              !

              IF ( pn .EQ. 'STOPSTRING' ) EXIT

              !

              ot2(i)%NPTS = ot2(i)%NPTS + 1

              IF ( iloop .EQ. 1 ) cycle

              !

              ot2(i)%X(ot2(i)%NPTS)      = xx

              ot2(i)%Y(ot2(i)%NPTS)      = yy

              ot2(i)%PNAMES(ot2(i)%NPTS) = pn

              IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

                IF ( ot2(i)%NPTS .EQ. 1 ) THEN

                  WRITE (mdss,957)              xx, yy, pn

                ELSE

                  WRITE (mdss,958) ot2(i)%NPTS, xx, yy, pn

                END IF

              END IF

              !

            END DO

            !

            IF ( improc.EQ.1 .AND. iloop.EQ.1 ) CLOSE (scratch)

          END DO

          !

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc .AND.        &

               ot2(i)%NPTS.EQ.0 ) WRITE (mdss,959)

          IF ( improc .EQ. 1 ) THEN

#ifdef W3_MPI

            CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

            CLOSE (scratch,status='DELETE')

          ELSE

            CLOSE (scratch)

#ifdef W3_MPI

            CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

          END IF

          !

        ELSE IF ( j .EQ. 3 ) THEN

          !

          ! 5.n Type 3: track output

          !

          CALL nextln ( comstr , mdsi , mdse2 )

          READ (mdsi,*,END=2001,ERR=2002) tflagi

          IF ( tflagi ) THEN

            mds(11,i) =  abs(mds(11,i))

          ELSE

            mds(11,i) = -abs(mds(11,i))

          END IF

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

            IF ( .NOT. tflagi ) THEN

              WRITE (mdss,960) 'input', 'UNFORMATTED'

            ELSE

              WRITE (mdss,960) 'input', 'FORMATTED'

            END IF

          END IF

          !

        ELSE IF ( j .EQ. 6 ) THEN

          !

          ! 5.o Type 6: partitioned wave field data

          !

          CALL nextln ( comstr , mdsi , mdse2 )

          READ (mdsi,*,END=2001,ERR=2002) IPRT(:,I), LPRT(I)

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

            WRITE (mdss,961) iprt(:,i)

            IF ( .NOT. lprt(i) ) THEN

              WRITE (mdss,960) 'output', 'UNFORMATTED'

            ELSE

              WRITE (mdss,960) 'output', 'FORMATTED'

            END IF

          END IF

          !

        END IF

      ELSE IF ( j .EQ. 7 ) THEN

        !

        ! 5.p Type 7: coupling fields

        !

        CALL w3readflgrd ( mdsi, mdss, mdso, mdse2, comstr,    &

             flg1d, flg2d, improc, nmpscr, ierr )

        flg2(:,i)    = flg1d

        flgr2(:,:,i) = flg2d

        !

      ELSE

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,963)

      END IF

      !

      ! ... End of loop in 5.j

      !

    END DO

    !

#ifdef W3_T

    DO i=1, nrgrd

      WRITE (mdst,9050) i

      WRITE (mdst,9051) odat(:,i)

      WRITE (mdst,9051) outff(:,i)

      WRITE (mdst,9052) flgrd(:,:,i)

    END DO

#endif

    !

    ! 6.  Read moving grid data ------------------------------------------ /

    !

    !     Only a single set of data are provided to be applied to all

    !     the grids, because this is only intended for test cases.

    !     For true implementations, the jumping grid will be used.

    !

    IF ( inflags1(10) ) THEN

      !

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        WRITE (mdss,965)

        WRITE (mdss,966) 'Continuous grid movement data'

      END IF

      !

#ifdef W3_MPI

      CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

      DO iloop=1, 2

        IF ( iloop .EQ. 1 ) THEN

          mdsi2  = mdsi

          IF ( improc .EQ. 1 )                                  &

               OPEN (scratch,file=trim(fnmpre)//'ww3_shel.scratch')

        ELSE

          mdsi2  = scratch

#ifdef W3_MPI

          CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

          OPEN (scratch,file=trim(fnmpre)//'ww3_shel.scratch')

          rewind(scratch)

          ALLOCATE ( tmove(2,nmove), amove(nmove), dmove(nmove) )

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )            &

               WRITE (mdss,967) nmove, 'MOV'

        END IF

        !

        nmove  = 0

        DO

          CALL nextln ( comstr , mdsi2 , mdse2 )

          READ (mdsi2,*,END=2001,ERR=2002) idtst

          !

          IF ( iloop.EQ.1 .AND. improc.EQ.1 ) THEN

            backspace(mdsi)

            READ (mdsi,'(A)') line

            WRITE (scratch,'(A)') line

          END IF

          !

          IF ( idtst .EQ. 'STP' ) EXIT

          IF ( idtst .NE. 'MOV' ) cycle

          !

          nmove  = nmove + 1

          IF ( iloop .EQ. 1 ) cycle

          !

          backspace(mdsi2)

          READ (mdsi2,*,END=2001,ERR=2002) IDTST, TTIME, XX, yy

          tmove(:,nmove) = ttime

          amove(nmove)   = xx

          dmove(nmove)   = yy

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )              &

               WRITE (mdss,968) nmove, tmove(:,nmove),             &

               amove(nmove), dmove(nmove)

          !

        END DO

        !

        IF ( improc.EQ.1 .AND. iloop.EQ.1 ) CLOSE (scratch)

      END DO

      !

      IF ( improc .EQ. 1 ) THEN

#ifdef W3_MPI

        CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

        CLOSE (scratch,status='DELETE')

      ELSE

        CLOSE (scratch)

#ifdef W3_MPI

        CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

      END IF

      !

#ifdef W3_T

      WRITE (mdst,9060)

      DO i=1, nmove

        WRITE (mdst,9061) i, tmove(:,i), amove(i), dmove(i)

      END DO

#endif

      !

      IF ( nmove .EQ. 0 ) GOTO 2060

      !

      nmvmax = nmove

      DO i=1, nrgrd

        CALL w3setg ( i, mdse, mdst )

        CALL wmsetm ( i, mdse, mdst )

        nmv    = nmove

        CALL wmdimd ( i, mdse, mdst, 0 )

        DO ii=1, nmv

          tmv(:,4,ii) = tmove(:,ii)

          amv(ii,4)   = amove(ii)

          dmv(ii,4)   = dmove(ii)

        END DO

      END DO

      !

    END IF

    !

    ! 7.  Work load distribution ----------------------------------------- /

    ! 7.a Initialize arrays

    !

    !     *******************************************************

    !     *** NOTE : OUTPUT PROCESSOR ASSIGNMENT NEEDS TO BE  ***

    !     ***        CONSISTENT WITH ASSIGNMENT IN W3INIT.    ***

    !     *******************************************************

    !

    ALLOCATE ( allprc(nmproc,nrgrd) , modmap(nmproc,nrgrp) ,        &

         loadmp(nmproc,nrgrp) )

    !

    allprc = 0

    modmap = 0

    loadmp = 0

    !

    ! 7.b Determine number of output processors

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,970)

    !

    ncproc = nmproc

    upproc = upproc .AND. unipts .AND. iostyp.GT.1

    !

    ! 7.b.1 Unified point output

    !

    IF ( unipts ) THEN

      IF ( nmproc.GE.10 .AND. upproc ) THEN

        ncproc = nmproc - 1

      ELSE

        IF ( upproc .AND. mdss.NE.mdso .AND. nmpscr.EQ.improc ) &

             WRITE (mdss,971) 'Separate process for point' //    &

             ' output disabled.'

        upproc = .false.

      END IF

      IF ( nmpupt .EQ. improc ) THEN

        ii     = len_trim(mnames(0))

        CALL wmuget ( mdss, mdst, mdsup, 'OUT' )

        CALL wmuset ( mdss, mdst, mdsup, .true., 'OUT',         &

             trim(fnmpre)//'out_pnt.'//mnames(0)(1:ii),  &

             'Unified point output')

#ifdef W3_ASCII

        CALL wmuget ( mdss, mdst, mdsupa, 'OUA' )

        CALL wmuset ( mdss, mdst, mdsupa, .true., 'OUA',         &

             trim(fnmpre)//'out_pnt.'//mnames(0)(1:ii)//'.txt',  &

             'Unified point output ascii')

#endif

      END IF

    END IF

    !

    IF ( upproc .AND. mdss.NE.mdso .AND. nmpscr.EQ.improc )         &

         WRITE (mdss,972) nmpupt

    !

    ! 7.b.2 Other output

    !

    ALLOCATE ( ndpout(nrgrd) )

    ndpout = 0

    !

    IF ( iostyp .GT. 1 ) THEN

      DO i=1, nrgrd

        IF ( odat( 3,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        IF ( odat(13,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        IF ( odat(28,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        IF ( odat( 8,i) .GT. 0 .OR.  odat(18,i) .GT. 0 .OR.       &

             odat(23,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        IF ( iostyp .EQ. 2 ) ndpout(i) = min( 1 , ndpout(i) )

      END DO

    END IF

    !

    ! ..... Reduce IOSTYP if not enough resources to run IOSTYP = 3

    !

    IF ( iostyp.EQ.3 .AND.                                          &

         ( ( .NOT.pshare .AND. 4*sum(ndpout).GT.ncproc )          &

         .OR.( pshare .AND. 4*maxval(ndpout).GT.ncproc ) ) ) THEN

      DO i=1, nrgrd

        ndpout(i) = min( 1 , ndpout(i) )

      END DO

      iostyp = 2

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,971) 'Separate processes for output' //     &

           ' types disabled.'

    END IF

    !

    ! ..... Force sharing of output processes if not enough resources

    !

    IF ( iostyp.GT.1 .AND. .NOT.pshare .AND.                        &

         4*sum(ndpout).GT.ncproc ) THEN

      pshare = .true.

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,971) 'Grids sharing output processes.'

    END IF

    !

    ! ..... Disable output processes if not enough resources

    !

    IF ( iostyp.GT.1 .AND. 4*maxval(ndpout).GT.ncproc ) THEN

      ndpout = 0

      iostyp = 1

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,971) 'Separate processes for output' //     &

           ' disabled.'

    END IF

    !

    ! ..... Number of output processes (except for unified point output)

    !

    npoutt = 0

    IF ( iostyp .GT. 1 ) THEN

      IF ( pshare ) THEN

        npoutt = maxval(ndpout)

      ELSE

        npoutt = sum(ndpout)

      END IF

    END IF

    ncproc = ncproc - npoutt

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      IF ( npoutt .EQ. 0 ) THEN

        WRITE (mdss,971) 'No (other) dedicated output processes.'

      ELSE

        WRITE (mdss,973) ncproc+1, ncproc+npoutt, npoutt

      END IF

    END IF

    !

    ! 7.c Set communicators and ALLPRC array

    !

#ifdef W3_T

    WRITE (mdst,9070)

#endif

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,974)

    IF ( nmplog.EQ.improc ) WRITE (mdso,1974)

    !

#ifdef W3_MPI

    CALL mpi_comm_group ( mpi_comm_mwave, bgroup, ierr_mpi )

#endif

    ALLOCATE ( tmprnk(nmproc) )

    napres = ncproc

    !

    DO i=1, nrgrd

      !

      ip1    = max( 1 , min( ncproc , 1+nint(real(ncproc)*rp1(i)) ) )

      ipn    = max( ip1 , min( ncproc , nint(real(ncproc)*rpn(i)) ) )

      outstr = '-----'

      !

      CALL wmsetm ( i, mdse, mdst )

      naploc = 1 + ipn - ip1

      napadd = naploc

#ifdef W3_MPI

      croot  = ip1

      fbcast = naploc .NE. ncproc

      fbcast = naploc .NE. ncproc .OR.                         &

           ( iostyp.GT.1 .AND. .NOT.pshare )

#endif

      DO j=ip1, ipn

        tmprnk(1+j-ip1) = j - 1

      END DO

      !

      IF ( iostyp .GT. 1 ) THEN

        IF ( pshare ) napres = ncproc

        DO j=1, ndpout(i)

          napadd = napadd + 1

          tmprnk(napadd) = napres

          napres = napres + 1

        END DO

      END IF

      !

      IF ( upproc ) THEN

        napadd = napadd + 1

        tmprnk(napadd) = nmproc - 1

      END IF

      !

#ifdef W3_MPI

      CALL mpi_group_incl ( bgroup, napadd, tmprnk, lgroup,    &

           ierr_mpi )

      CALL mpi_comm_create ( mpi_comm_mwave, lgroup,           &

           mpi_comm_grd, ierr_mpi )

      CALL mpi_group_free ( lgroup, ierr_mpi )

#endif

      !

      DO ii=ip1, ipn

        allprc(ii,i) = 1 + ii - ip1

      END DO

      ii     = ii - ip1

      !

      IF ( pshare .OR. i.EQ.1 ) THEN

        napadd = ncproc

      ELSE

        napadd = ncproc + sum(ndpout(1:i-1))

      END IF

      IF ( iostyp .GT. 1 ) THEN

        DO j=1, ndpout(i)

          napadd = napadd + 1

          ii     = ii + 1

          allprc(napadd,i) = ii

        END DO

      END IF

      !

      IF ( upproc ) THEN

        ii     = ii + 1

        allprc(nmproc,i) = ii

      END IF

      !

#ifdef W3_T

      WRITE (mdst,9071) i, allprc(:,i)

#endif

      !

      ! ... output

      !

      !

      IF ( iostyp .LE. 1 ) THEN

        !

        IF ( odat( 3,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-1))+1

          outstr(1) = stout

        END IF

        IF ( odat( 8,i) .GT. 0 .OR. unipts ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-2))+1

          outstr(2) = stout

        END IF

        IF ( odat(13,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-5))+1

          outstr(3) = stout

        END IF

        IF ( odat(18,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(naploc)+1

          outstr(4) = stout

        END IF

        IF ( odat(23,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-3))+1

          outstr(5) = stout

        END IF

        IF ( odat(28,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-4))+1

          outstr(6) = stout

        END IF

        !

      ELSE

        !

        IF ( unipts ) THEN

          WRITE (stout,'(I5.5)') tmprnk(ii) + 1

          outstr(2) = stout

          IF ( upproc ) ii = ii - 1

        END IF

        !

        IF ( iostyp .EQ. 2 ) THEN

          !

          WRITE (stout,'(I5.5)') tmprnk(ii) + 1

          IF ( odat( 3,i) .GT. 0 ) outstr(1) = stout

          IF ( odat( 8,i) .GT. 0 .OR.                           &

               ( unipts .AND. .NOT.upproc ) )    &

               outstr(2) = stout

          IF ( odat(13,i) .GT. 0 ) outstr(3) = stout

          IF ( odat(18,i) .GT. 0 ) outstr(4) = stout

          IF ( odat(23,i) .GT. 0 ) outstr(5) = stout

          IF ( odat(28,i) .GT. 0 ) outstr(6) = stout

          !

        ELSE IF ( iostyp .EQ. 3 ) THEN

          !

          IF ( odat( 3,i).GT.0 ) THEN

            WRITE (stout,'(I5.5)') tmprnk(ii) + 1

            outstr(1) = stout

            ii        = ii - 1

          END IF

          IF ( odat(13,i).GT.0 ) THEN

            WRITE (stout,'(I5.5)') tmprnk(ii) + 1

            outstr(3) = stout

            ii        = ii - 1

          END IF

          IF ( odat(28,i).GT.0 ) THEN

            WRITE (stout,'(I5.5)') tmprnk(ii) + 1

            outstr(6) = stout

            ii        = ii - 1

          END IF

          WRITE (stout,'(I5.5)') tmprnk(ii) + 1

          IF ( odat( 8,i) .GT. 0 ) outstr(2) = stout

          IF ( odat(18,i) .GT. 0 ) outstr(4) = stout

          IF ( odat(23,i) .GT. 0 ) outstr(5) = stout

          !

        END IF

        !

      END IF

      !

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,975) mnames(i), ip1, ipn, outstr

      IF ( nmplog .EQ. improc )                                     &

           WRITE (mdso,1975)mnames(i), ip1, ipn, outstr

      !

#ifdef W3_MPI

      IF ( fbcast ) THEN

        tmprnk(1) = ip1 - 1

        napbct    = 1

        DO j=1, nmproc

          IF ( allprc(j,i) .EQ. 0 ) THEN

            napbct = napbct + 1

            tmprnk(napbct) = j - 1

          END IF

        END DO

        CALL mpi_group_incl ( bgroup, napbct, tmprnk,       &

             lgroup, ierr_mpi )

        CALL mpi_comm_create ( mpi_comm_mwave, lgroup,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_group_free ( lgroup, ierr_mpi )

      END IF

#endif

      !

    END DO

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      WRITE (mdss,976)

      IF ( unipts ) WRITE (mdss,977) nmpupt

      WRITE (mdss,*)

    END IF

    !

    IF ( nmplog .EQ. improc ) THEN

      WRITE (mdso,1976)

      IF ( unipts ) WRITE (mdso,1977) nmpupt

      WRITE (mdso,*)

    END IF

    !

    DEALLOCATE ( tmprnk, ndpout )

    !

    ! 7.d Set MODMAP and LOADMP arrays

    !

    DO jj=1, nrgrp

      DO ii=1, ingrp(jj,0)

        i      = ingrp(jj,ii)

        DO j=1, nmproc

          IF ( allprc(j,i) .NE. 0 ) THEN

            loadmp(j,jj) = loadmp(j,jj) + 1

            IF ( loadmp(j,jj) .EQ. 1 ) THEN

              modmap(j,jj) = i

            ELSE

              modmap(j,jj) = -1

            END IF

          END IF

        END DO

      END DO

    END DO

    !

#ifdef W3_T

    WRITE (mdst,8042)

    DO j=1, nrgrp

      WRITE (mdst,8044) j, modmap(:,j)

    END DO

    WRITE (mdst,8043)

    DO j=1, nrgrp

      WRITE (mdst,8044) j, loadmp(:,j)

    END DO

#endif

    !

    ! 7.e Warnings

    !

    IF ( nmproc .GT. 1 ) THEN

      DO i=1, nrgrp

        ip1    = minval( loadmp(:ncproc,i) )

        ipn    = maxval( loadmp(:ncproc,i) )

        IF ( ip1.NE.ipn .AND. improc.EQ.nmperr )                  &

             WRITE (mdse,1040) i, ip1, ipn

      END DO

    END IF

    !

    DEALLOCATE ( rp1, rpn, loadmp )

    !

    ! 7.f Reset NMPSCR to first processor of first rank 1 grid

    !

#ifdef W3_MPI

    CALL wmsetm ( ingrp(1,1), mdse, mdst )

    nmpscr = croot

#endif

    !

#ifdef W3_MPI

    CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

    !

    ! 8.  Actual initializations ----------------------------------------- /

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8'

    prft0  = prftn

#endif

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,980)

    ALLOCATE ( tsync(2,0:nrgrd), tmax(2,nrgrd), toutp(2,0:nrgrd),   &

         tdata(2,nrgrd), grstat(nrgrd), dtres(nrgrd) )

    !

    tsync(1,:) = -1

    tsync(2,:) =  0

    tmax(1,:) = -1

    tmax(2,:) =  0

    toutp(1,:) = -1

    toutp(2,:) =  0

    tdata(1,:) = -1

    tdata(2,:) =  0

    grstat     = 99

    !

    ! 8.a Loop over models for per-model initialization

    !

#ifdef W3_T

    WRITE (mdst,9080)

#endif

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.a'

    prft0  = prftn

#endif

    !

    DO i=1, nrgrd

      j      = len_trim(mnames(i))

      DO nmpsc2=1, nmproc

        IF ( allprc(nmpsc2,i) .EQ. 1 ) EXIT

      END DO

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )                    &

           WRITE (mdss,981) i, mnames(i)(1:j)

      !

#ifdef W3_MPI

      CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

      !

      ! 8.a.1 Wave model initialization (NOTE: sets all grid pointers)

      ! ..... Initial output file hook up

      !

      CALL wmsetm ( i, mdse, mdst )

#ifdef W3_MPI

      mpi_comm_loc = mpi_comm_grd

      IF ( mpi_comm_loc .EQ. mpi_comm_null ) cycle

#endif

      !

      CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

      CALL wmuset ( mdse, mdst, ndsfnd, .true., desc='Log file' )

      mds( 1,i) = ndsfnd

      !

      ! ... this one overwrites the combined setting MDS( 3,I) = MDST above

      !

      !       CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' )

      !       CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., DESC='Test output' )

      !       MDS( 3,I) = NDSFND

      !

      DO j=1, 6

        IF ( j.EQ.4 .OR. j.EQ.5 ) cycle

        IF ( odat(5*(j-1)+3,i) .GT. 0 ) THEN

          CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

          CALL wmuset ( mdse, mdst, ndsfnd, .true.,              &

               desc='Raw output file' )

          SELECT CASE (j)

          CASE (1)

            mds(7,i) = ndsfnd

#ifdef W3_ASCII

            CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

            CALL wmuset ( mdse, mdst, ndsfnd, .true.,            &

                 desc='ASCII output file' )

            mds(14,i) = ndsfnd  ! ASCII

#endif

          CASE (2)

            mds(8,i) = ndsfnd

#ifdef W3_ASCII

            CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

            CALL wmuset ( mdse, mdst, ndsfnd, .true.,            &

                 desc='ASCII output file' )

            mds(15,i) = ndsfnd  ! ASCII

#endif

          CASE (3)

            mds(12,i) = ndsfnd

            CALL wmuget ( mdse, mdst, ndsfnd, 'INP' )

            CALL wmuset ( mdse, mdst, ndsfnd, .true.,           &

                 desc='Input data file' )

            mds(11,i) = ndsfnd

          CASE (6)

            mds(13,i) = ndsfnd

          END SELECT

        END IF

      END DO

      !

      CALL wmuget ( mdse, mdst, ndsfnd, 'INP' )

      CALL wmuset ( mdse, mdst, ndsfnd, .true.,                     &

           desc='Input data file' )

      mds(9,i) = ndsfnd

      !

      IF ( odat(5*(5-1)+3,i) .GT. 0 ) THEN

        CALL wmuget ( mdse, mdst, ndsfnd, 'OUT', 9 )

        mds(10,i) = ndsfnd

        DO ii=0, 8

          CALL wmuset ( mdse, mdst, ndsfnd+ii, .true.,            &

               desc='Raw output file' )

        END DO

      END IF

      !

      ! ..... Model initialization

      !

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,982)


      CALL w3init ( i, .true., mnames(i), mds(:,i), ntrace(:,i),    &

           odat(:,i),                          &

           flgrd(:,:,i),flgr2(:,:,i),flgd(:,i),flg2(:,i),  &

           ot2(i)%NPTS, ot2(i)%X, ot2(i)%Y, ot2(i)%PNAMES, &

           iprt(:,i), lprt(i), mpi_comm_loc)

      !

      ! ..... Finalize I/O file hook up

      !

      ii     = len_trim(filext)

      jj     = len_trim(fnmpre)

      CALL wmuinq ( mdse, mdst, mds(1,i) )

      IF ( mds(3,i) .NE. mdst ) CALL wmuinq ( mdse, mdst, mds(3,i) )

      !

      IF ( mds(7,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. napfld ) THEN

          tname  = trim(fnmpre)//'out_grd.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(7,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(7,i), .false. )

          mds(7,i) = -1

        END IF

      END IF

      !

      IF ( mds(8,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. nappnt ) THEN

          tname  = trim(fnmpre)//'out_pnt.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(8,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(8,i), .false. )

          mds(8,i) = -1

        END IF

      END IF

      !

      IF ( mds(9,i) .NE. -1 ) THEN

        IF ( flbpi ) THEN

          tname  = trim(fnmpre)//'nest.' // filext(:ii)

          CALL wmuset ( mdse, mdst, mds(9,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse, mdst, mds(9,i), .false. )

          mds(9,i) = -1

        END IF

      END IF

      !

      IF ( mds(10,i) .NE. -1 ) THEN

        IF ( flbpo .AND. iaproc.EQ.napbpt ) THEN

          tname  = trim(fnmpre)//'nestN.' // filext(:ii)

          DO j=0, nfbpo-1

            WRITE (tname(jj+5:jj+5),'(I1)') j + 1

            CALL wmuset ( mdse, mdst, mds(10,i)+j, .true.,      &

                 name=tname )

          END DO

          DO j=nfbpo, 8

            CALL wmuset ( mdse,mdst, mds(10,i)+j, .false. )

          END DO

        ELSE

          DO j=0, 8

            CALL wmuset ( mdse,mdst, mds(10,i)+j, .false. )

          END DO

          mds(10,i) = -1

        END IF

      END IF

      !

      IF ( mds(11,i) .NE. -1 ) THEN

        tname  = trim(fnmpre)//'track_i.' // filext(:ii)

        CALL wmuset ( mdse,mdst, mds(11,i), .true., name=tname )

      END IF

      !

      IF ( mds(12,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. naptrk ) THEN

          tname  = trim(fnmpre)//'track_o.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(12,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(12,i), .false. )

          mds(12,i) = -1

        END IF

      END IF

      !

      IF ( mds(13,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. napprt ) THEN

          tname  = trim(fnmpre)//'partition.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(13,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(13,i), .false. )

          mds(13,i) = -1

        END IF

      END IF

      !

#ifdef W3_ASCII

      IF ( mds(14,i) .NE. -1 ) THEN ! Grid output (ASCII)

        IF ( iaproc .EQ. napfld ) THEN

          tname  = trim(fnmpre)//'out_grd.' // filext(:ii) // '.txt'

          CALL wmuset ( mdse,mdst, mds(14,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(14,i), .false. )

          mds(14,i) = -1

        END IF

      END IF

      !

      IF ( mds(15,i) .NE. -1 ) THEN ! Point output (ASCII)

        IF ( iaproc .EQ. nappnt ) THEN

          tname  = trim(fnmpre)//'out_pnt.' // filext(:ii) // '.txt'

          CALL wmuset ( mdse,mdst, mds(15,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(15,i), .false. )

          mds(15,i) = -1

        END IF

      END IF

#endif

!

#ifdef W3_T

      WRITE (mdst,9081) i, time

#endif

      !

      ! 8.a.2 Data file initialization (forcing)

      !

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,983)

      CALL w3seti ( i, mdse, mdst )

      !

      !!Li  Stop modifying GTYPE from input forcing file.  JGLi08Apr2021.

      jjj = gtype

      !

      ! ..... regular input files

      !

      DO j=jfirst, 6

        IF ( inflags1(j) ) THEN

          idinp(i,j) = idstr(j)

          IF ( inpmap(i,j) .LT. 0 ) cycle

          CALL w3fldo ('READ', idinp(i,j), mdsf(i,j), mdst, mdse2,&

               !!Li     NX, NY, GTYPE, IERR, MNAMES(I),           &

               nx, ny,   jjj, ierr, mnames(i),           &

               trim(fnmpre) )

          IF ( ierr .NE. 0 ) GOTO 2080

          !

          !!Li   Print a warning message when GTYPE not matching forcing field one.

          IF ( (jjj .NE. gtype) .AND. (improc .EQ. nmpsc2) )       &

               WRITE (mdse, *) ' *** Warning: grid', i, ' GTYPE=',  &

               gtype, ' not matching field', j, ' grid type', jjj

          !

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,985) idflds(j)

        ELSE

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,984) idflds(j)

        END IF

      END DO

      !

      ! ..... assimilation data files

      !

      !       version 3.07: Data assimilation part ignored for now ....

      !

      ! ..... finalize file info data base

      !

      DO j=jfirst, 9

        IF ( mdsf(i,j) .NE. -1 ) CALL wmuinq ( mdse, mdst, mdsf(i,j) )

      END DO

      !

      ! ..... Adjust input flags for other than native or CPL input,

      !       and initialize input arrays one set at a time as needed.

      !

      IF ( SIZE(inflags1) .NE. SIZE(tflags) ) THEN

        WRITE (mdse,'(/2A)') ' *** ERROR WMINIT: ', &

             .NE.'SIZE(INFLAGS1)SIZE(TFLAGS) ***'

        CALL extcde ( 999 )

      END IF

      IF ( SIZE(inflags2) .NE. SIZE(tflags) ) THEN

        WRITE (mdse,'(/2A)') ' *** ERROR WMINIT: ', &

             .NE.'SIZE(INFLAGS2)SIZE(TFLAGS) ***'

        CALL extcde ( 999 )

      END IF


      tflags = inflags1

      !

      DO j=jfirst, 9

        IF ( inpmap(i,j) .NE. 0 ) THEN

          !

          tflags(j) = .true.

          inflags1     = .false.

          inflags1(j)  = .true.

          iinit     = .false.

          CALL w3dimi ( i, mdse, mdst )

          !

          IF ( j.EQ.2 ) ALLOCATE ( wadats(i)%CA0(nsea) ,          &

               wadats(i)%CAI(nsea) ,          &

               wadats(i)%CD0(nsea) ,          &

               wadats(i)%CDI(nsea) )

          !

          IF ( j.EQ.3 ) ALLOCATE ( wadats(i)%UA0(nsea) ,          &

               wadats(i)%UAI(nsea) ,          &

               wadats(i)%UD0(nsea) ,          &

               wadats(i)%UDI(nsea) ,          &

               wadats(i)%AS0(nsea) ,          &

               wadats(i)%ASI(nsea) )

          !

          IF ( j.EQ.5 ) ALLOCATE ( wadats(i)%MA0(nsea) ,          &

               wadats(i)%MAI(nsea) ,          &

               wadats(i)%MD0(nsea) ,          &

               wadats(i)%MDI(nsea) )

          !

          IF ( j.EQ.6 ) ALLOCATE ( wadats(i)%RA0(nsea) ,          &

               wadats(i)%RAI(nsea) )

          !

        END IF !  IF ( INPMAP(I,J) .NE. 0 ) THEN

      END DO !  DO J=JFIRST, 9

      !

      inflags1  = tflags

      CALL w3seti ( i, mdse, mdst )

      CALL w3seta ( i, mdse, mdst )

      !

      ! 8.a.3 Status indicator and model times

      !

      DO j=1, notype

        IF ( flout(j) ) THEN

          IF ( toutp(1,i) .EQ. -1 ) THEN

            toutp(:,i) = tonext(:,j)

          ELSE

            dttst  = dsec21( toutp(:,i), tonext(:,j) )

            IF ( dttst .LT. 0. ) toutp(:,i) = tonext(:,j)

          ENDIF

        END IF

      END DO

      !

      ! CHECKPOINT

      j=8

      IF ( flout(j) ) THEN

        IF ( toutp(1,i) .EQ. -1 ) THEN

          toutp(:,i) = tonext(:,j)

        ELSE

          dttst  = dsec21( toutp(:,i), tonext(:,j) )

          IF ( dttst .LT. 0. ) toutp(:,i) = tonext(:,j)

        ENDIF

      END IF

      !

      !

      grstat(i) =  0

      tsync(:,i) = time(:)

      !

#ifdef W3_SMC

      ! Check GTYPE values after initialization

      IF ( improc .EQ. nmperr ) WRITE(mdse,*) "GRID IMPROC GTYPE", &

           i, improc, grids(i)%GTYPE

#endif

      !

#ifdef W3_T

      WRITE (mdst,9082) grstat(i), toutp(:,i), tsync(:,i)

#endif

      !

    END DO   !! 8.a I-NRGRD loop

    !

#ifdef W3_MPI

    CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

    DO i=1, nrgrd

      CALL wmsetm ( i, mdse, mdst )

      CALL w3setg ( i, mdse, mdst )

      CALL w3seto ( i, mdse, mdst )

      IF ( fbcast .AND. mpi_comm_bct.NE.mpi_comm_null ) THEN

        CALL mpi_bcast ( toutp(1,i), 2, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( tsync(1,i), 2, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( grstat(i), 1, mpi_integer, 0,       &

             mpi_comm_bct, ierr_mpi )

#endif

        !

        ! 8.a.4 Grid sizes etc. for processors that are not used.

        !

#ifdef W3_MPI

        CALL mpi_bcast ( flagll,1, mpi_logical, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( gtype, 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( iclose,1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nx   , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( ny   , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( x0   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( sx   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( y0   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( sy   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nsea , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nseal, 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dtmax, 1, mpi_real, 0,              &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dtcfl, 1, mpi_real, 0,              &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( filext, 10, mpi_character, 0,       &

             mpi_comm_bct, ierr_mpi )

        IF ( mpi_comm_grd .EQ. mpi_comm_null )               &

             CALL w3dimx  ( i, nx, ny, nsea, mdse, mdst      &

#endif

#ifdef W3_SMC

                                !!  SMC grid related variables are not needed beyond MPI_COMM_GRD

                                !!  so all dimensions are minimised to 1.  JGLi29Mar2021

#endif

#ifdef W3_MPI

#ifdef W3_SMC

                                !!Li        , NCel, NUFc, NVFc, NRLv, NBSMC  &

                                !!Li        , NARC, NBAC, NSPEC              &

             , 1, 1, 1, 1, 1, 1, 1, 1         &

#endif

             )

        CALL mpi_bcast ( hqfac, nx*ny, mpi_real, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( hpfac, nx*ny, mpi_real, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( xgrd, nx*ny, mpi_double_precision, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( ygrd, nx*ny, mpi_double_precision, 0,           &

             mpi_comm_bct, ierr_mpi )

        IF ( mpi_comm_grd .EQ. mpi_comm_null )               &

             gsu = w3gsuc( .false., flagll, iclose,          &

             xgrd, ygrd )

        CALL mpi_bcast ( dxdp, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dxdq, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dydp, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dydq, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( mapsta, nx*ny, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( mapst2, nx*ny, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( gridshift, 1, mpi_double_precision, 0, &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

        CALL mpi_bcast ( nk   , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nth  , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( xfr  , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( fr1  , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        IF ( mpi_comm_grd .EQ. mpi_comm_null )               &

             CALL w3dims ( i, nk, nth, mdse, mdst )

        CALL mpi_bcast ( th , nth, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

        CALL mpi_bcast ( naproc,1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nappnt,1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nbi  , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

        CALL mpi_bcast ( flout,  8, mpi_logical, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dtout , 8, mpi_real, 0,             &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( tonext,16, mpi_integer, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( tolast,16, mpi_integer, 0,          &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

      END IF

    END DO

    CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

    !

    DO i=1, nrgrd

      IF ( allprc(improc,i) .EQ. 0 ) THEN

        CALL w3seto ( i, mdse, mdst )

        iaproc = -1

      END IF

    END DO

    !

    ! 8.a.5 Test output

    !

#ifdef W3_T

    WRITE (mdst,9020) 'AFTER SETUP'

    DO i=1, nrgrd

      WRITE (mdst,9021) i, mds(:,i), ntrace(:,i)

    END DO

#endif

    !

    ! 8.a.6 Check for coordinate system

    !

    DO i=1, nrgrd-1

      IF ( grids(i)%FLAGLL .NEQV. grids(i+1)%FLAGLL ) GOTO 2070

    END DO

    !

    ! 8.b Input files

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.c'

    prft0  = prftn

#endif

    !

    DO i=1, nrinp

      !

      IF ( .NOT. useinp(i) ) cycle

      !

      j      = len_trim(mnames(-i))

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) THEN

        WRITE (mdss,988) i, mnames(-i)(1:j)

        WRITE (mdss,987)

      END IF

      !

      CALL w3iogr ( 'GRID', ndsrec, -i, mnames(-i)(1:j) )

      CALL w3dimi ( -i, mdse, mdst )

      !

      IF ( cplinp(i) ) cycle

      !

      DO j=jfirst, 6

        IF ( inflags1(j) ) THEN

          idinp(-i,j) = idstr(j)

          CALL w3fldo ('READ', idinp(-i,j), mdsf(-i,j), mdst,     &

               mdse2, nx, ny, gtype, ierr,               &

               mnames(-i), trim(fnmpre) )

          IF ( ierr .NE. 0 ) GOTO 2080

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,985) idflds(j)

        ELSE

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,984) idflds(j)

        END IF

      END DO

      !

      ! Skipping assimilation input files for now.

      !

      DO j=jfirst, 9

        IF ( mdsf(-i,j) .NE. -1 ) CALL wmuinq                     &

             ( mdse, mdst, mdsf(-i,j) )

      END DO

      !

    END DO

    !

    DO i=1, nrgrd

      DO j=jfirst, 9

        IF  ( inpmap(i,j).LT.0 .AND. inpmap(i,j).NE.-999) idinp(i,j) = idinp( inpmap(i,j),j)

        !IF ( INPMAP(I,J) .LT. 0 ) IDINP(I,J) = IDINP( INPMAP(I,J),J)

        IF ( inpmap(i,j) .GT. 0 ) idinp(i,j) = idinp(-inpmap(i,j),j)

      END DO

    END DO

    !

    DEALLOCATE ( useinp )

    DEALLOCATE ( cplinp )

    !

    ! 8.c Inter model initialization

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.d'

    prft0  = prftn

#endif


    ! 8.c.1 Spectral conversion flags and source term flags

    !

    CALL wmrspc

    !

    DO i=1, nrgrd

      CALL w3setg ( i, mdse, mdst )

      flagst = .true.

    END DO

    !

    ! 8.c.2 Relation to lower ranked grids

    !       Includes update of unit numbers, and bound. data initialization.

    !

    ALLOCATE ( flrbpi(nrgrd) )

    CALL wmglow ( flrbpi )

    !

    ! ..... At this point the grid-search-utility (GSU) object for grids

    !       that do not belong to this processor is no longer needed.

    !

#ifdef W3_MPI

    DO i=1, nrgrd

      CALL wmsetm ( i, mdse, mdst )

      CALL w3setg ( i, mdse, mdst )

#endif

      ! the next line (with the W3GSUD call) removed Jan 8 2013.

      ! ...ref: personal communication,

      ! ...email from Rogers to Alves, Campbell, Tolman, Chawla Dec 13 2012.

      ! REMOVED  !/MPI        IF ( MPI_COMM_GRD .EQ. MPI_COMM_NULL ) CALL W3GSUD( GSU )

#ifdef W3_MPI

    END DO

#endif

    !

    ! ..... Unit numbers

    !


    DO i=1, nrgrd

      !

      CALL w3setg ( i, mdse, mdst )

      CALL w3seto ( i, mdse, mdst )

      !

      IF ( bcdump(i) .AND. flrbpi(i) ) THEN

        IF ( improc .EQ. nmperr ) WRITE (mdse,1080) i

        IF ( improc .EQ. nmplog ) WRITE (mdso,1082) i

        bcdump(i) = .false.

      END IF

      !

      IF ( bcdump(i) .AND. nbi.EQ.0 ) THEN

        IF ( improc .EQ. nmperr ) WRITE (mdse,1081) i

        IF ( improc .EQ. nmplog ) WRITE (mdso,1082) i

        bcdump(i) = .false.

      END IF

      !

#ifdef W3_SHRD

      IF ( .NOT. flrbpi(i) .AND. flbpi ) THEN

#endif

#ifdef W3_MPI

        IF ( .NOT. flrbpi(i) .AND. flbpi .AND.                   &

             mpi_comm_grd .NE. mpi_comm_null) THEN

#endif

          CALL wmuset ( mdse, mdst, nds(9), .false. )

          IF ( bcdump(i) .AND. iaproc.EQ.napbpt ) THEN

            j            = len_trim(filext)

            tname(1:5)   = 'nest.'

            tname(6:5+j) = filext(1:j)

            j      = j + 5

            CALL wmuget ( mdse, mdst, nds(9), 'OUT' )

            CALL wmuset ( mdse, mdst, nds(9), .true.,             &

                 name=trim(fnmpre)//tname(1:j),           &

                 desc='Output data file (nest dump)' )

            mds(9,i) = ndsfnd

          ELSE

            nds(9) = -1

          END IF

#ifdef W3_MPI

        END IF

#endif

#ifdef W3_SHRD

      END IF

#endif

      !

    END DO

    !

    ! ..... Data initialization

    !

    DO i=1, nrgrd

#ifdef W3_MPI

      CALL wmsetm ( i, mdse, mdst )

      IF ( mpi_comm_grd .NE. mpi_comm_null ) CALL wmiobs ( i )

#endif

#ifdef W3_SHRD

      CALL wmiobs ( i )

#endif

    END DO

    !

    DO i=1, nrgrd

#ifdef W3_MPI

      CALL wmsetm ( i, mdse, mdst )

      IF ( mpi_comm_grd .NE. mpi_comm_null ) CALL wmiobg ( i )

#endif

#ifdef W3_SHRD

      CALL wmiobg ( i )

#endif

    END DO

    !

#ifdef W3_MPI

    DO i=1, nrgrd

      CALL wmsetm ( i, mdse, mdst )

      IF ( mpi_comm_grd .NE. mpi_comm_null ) CALL wmiobf ( i )

    END DO

#endif

    !

    ! 8.c.3 Relation to same ranked grids

    !

#ifdef W3_SMC

    !!  Check whether there is a SMC grid group.   JGLi12Apr2021

    ngrpsmc = 0

    DO jj=1, nrgrp

      j = 0

      DO ii=1, ingrp(jj,0)

        i = ingrp(jj,ii)

        IF( grids(i)%GTYPE .EQ. smctype ) j = j + 1

      ENDDO

      IF( j .GT. 1 )  ngrpsmc = jj

    ENDDO

    IF( improc.EQ.nmperr )  WRITE (mdse,*) " NGRPSMC =", ngrpsmc


    !!  Equal ranked SMC grid group uses its own sub.   JGLi12Apr2021

    IF( ngrpsmc .GT. 0 ) THEN

      CALL wmsmceql

    ELSE

#endif

      !

      CALL wmgeql

      !

#ifdef W3_SMC

    ENDIF

#endif

    !

    ! 8.c.4 Relation to higher ranked grids

    !

    IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,938) &

         'Computing relation to higher ranked grids'

    CALL wmghgh

    IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,938) &

         'Finished computing relation to higher ranked grids'

    !

    ! 8.c.5 Unified point output

    !

    IF ( unipts ) THEN

      !

      outpts(0)%TONEXT(1,2) =        odat( 6,0)

      outpts(0)%TONEXT(2,2) =        odat( 7,0)

      outpts(0)%DTOUT (  2) = real( odat( 8,0) )

      outpts(0)%TOLAST(1,2) =        odat( 9,0)

      outpts(0)%TOLAST(2,2) =        odat(10,0)

      outpts(0)%OFILES(1)   =        outff(1,1)

      outpts(0)%OFILES(2)   =        outff(2,1)

      !

      tout   = outpts(0)%TONEXT(:,2)

      tlst   = outpts(0)%TOLAST(:,2)

      !

      DO

        dttst   = dsec21( stime , tout )

        IF ( dttst .LT. 0 ) THEN

          CALL tick21 ( tout, outpts(0)%DTOUT(2) )

        ELSE

          EXIT

        END IF

      END DO

      !

      outpts(0)%TONEXT(:,2) = tout

      !

      dttst  = dsec21( tout , tlst )

      IF ( dttst .LT. 0. ) THEN

        unipts = .false.

      ELSE

        CALL wmiopp ( ot2(0)%NPTS, ot2(0)%X, ot2(0)%Y,          &

             ot2(0)%PNAMES )

      END IF

      !

#ifdef W3_MPI

      DO i=1, nrgrd

        CALL wmsetm ( i, mdse, mdst )

        CALL w3setg ( i, mdse, mdst )

        CALL w3seto ( i, mdse, mdst )

        IF ( fbcast .AND. mpi_comm_bct.NE.mpi_comm_null ) THEN

          CALL mpi_bcast ( nopts, 1, mpi_integer, 0,       &

               mpi_comm_bct, ierr_mpi )

        END IF

      END DO

#endif

      !

    END IF

    !

    ! 8.c.6 Output

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                      &

         WRITE (mdss,938) 'Additional group information'

    !

    IF ( maxval(grdlow(:,0)) .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,933) 'Lower rank grid dependence'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,933) 'Lower rank grid dependence'

      DO i=1, nrgrd

        WRITE (line(1:6),'(1X,I3,2X)') i

        jjj    = 6

        IF ( grdlow(i,0) .NE. 0 ) THEN

          DO j=1, grdlow(i,0)

            WRITE (line(jjj+1:jjj+3),'(I3)') grdlow(i,j)

            jjj    = jjj + 3

          END DO

        ELSE IF ( flrbpi(i) ) THEN

          jjj    = 21

          line(7:jjj) = ' Data from file'

        ELSE

          jjj    = 22

          line(7:jjj) = ' No dependencies'

        END IF

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE(mdss,934) line(1:jjj)

        IF ( nmplog .EQ. improc ) WRITE(mdso,934) line(1:jjj)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

      IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    ELSE

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,937) 'No lower rank grid dependencies'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,937) 'No lower rank grid dependencies'

    END IF

    DEALLOCATE ( flrbpi )

    !

    IF ( maxval(grdeql(:,0)) .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,933) 'Same rank grid dependence'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,933) 'Same rank grid dependence'

      DO i=1, nrgrd

        WRITE (line(1:6),'(1X,I3,2X)') i

        jjj    = 6

        IF ( grdeql(i,0) .NE. 0 ) THEN

          DO j=1, grdeql(i,0)

            WRITE (line(jjj+1:jjj+3),'(I3)') grdeql(i,j)

            jjj    = jjj + 3

          END DO

        ELSE

          jjj    = 22

          line(7:jjj) = ' No dependencies'

        END IF

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE(mdss,934) line(1:jjj)

        IF ( nmplog .EQ. improc ) WRITE(mdso,934) line(1:jjj)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

      IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    ELSE

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,937) 'No same rank grid dependencies'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,937) 'No same rank grid dependencies'

    END IF

    !

    IF ( maxval(grdhgh(:,0)) .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,933) 'Higher rank grid dependence'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,933) 'Higher rank grid dependence'

      DO i=1, nrgrd

        WRITE (line(1:6),'(1X,I3,2X)') i

        jjj    = 6

        IF ( grdhgh(i,0) .NE. 0 ) THEN

          DO j=1, grdhgh(i,0)

            WRITE (line(jjj+1:jjj+3),'(I3)') grdhgh(i,j)

            jjj    = jjj + 3

          END DO

        ELSE

          jjj    = 22

          line(7:jjj) = ' No dependencies'

        END IF

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE(mdss,934) line(1:jjj)

        IF ( nmplog .EQ. improc ) WRITE(mdso,934) line(1:jjj)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

      IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    ELSE

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,937) 'No higher rank grid dependencies'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,937) 'No higher rank grid dependencies'

    END IF

    !

#ifdef W3_T

    WRITE (mdst,9083)

    DO i=-nrinp, nrgrd

      WRITE (mdst,9084) i, idinp(i,:)

    END DO

#endif

    !

    !    Test output of connected units (always)

    !

    CALL wmuset ( mdse, mdst, scratch, .false. )

    IF ( tstout ) CALL wmudmp ( mdst, 0 )

    !

    DEALLOCATE ( mds, ntrace, odat, flgrd, flgr2, flgd, flg2, inames,&

         mnames                                              &

         ,outff )

    !

#ifdef W3_MPI

    CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

    !

    CALL date_and_time ( values=clkdt2 )

    clkfin = tdiff( clkdt1,clkdt2 )

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'END'

#endif

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,998)

#ifdef W3_O10

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,999)

#endif

    !

    RETURN

    !

    ! Escape locations read errors :

    !

2000 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1000) ifname, ierr

    CALL extcde ( 2000 )

    RETURN

    !

2001 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1001)

    CALL extcde ( 2001 )

    RETURN

    !

2002 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1002) ierr

    CALL extcde ( 2002 )

    RETURN

    !

2010 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1010) ierr

    CALL extcde ( 2010 )

    RETURN

    !

2011 CONTINUE

    ! === no process number filtering for test file !!! ===

    WRITE (mdse,1011) ierr

    CALL extcde ( 2011 )

    RETURN

    !

2020 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1020)

    CALL extcde ( 2020 )

    RETURN

    !

2021 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1021)

    CALL extcde ( 2021 )

    RETURN

    !

2030 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1030) mnames(i), inames(i,j)

    CALL extcde ( 2030 )

    RETURN

    !

2031 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1031) inames(i,j), j

    CALL extcde ( 2031 )

    RETURN

    !

    !2050 CONTINUE

    !     IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1040)

    !     CALL EXTCDE ( 2050 )

    !     RETURN

    !

2051 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1051) mn(:ii)

    CALL extcde ( 2051 )

    RETURN

    !

2052 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1052) j

    CALL extcde ( 2052 )

    RETURN

    !

2053 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1053)

    CALL extcde ( 2053 )

    RETURN

    !

2054 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1054)

    CALL extcde ( 2054 )

    RETURN

    !

2060 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1060)

    CALL extcde ( 2060 )

    RETURN

    !

2070 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1070)

    CALL extcde ( 2070 )

    RETURN

    !

2080 CONTINUE

    CALL extcde ( 2080 )

    RETURN

    !

    ! Formats

    !

900 FORMAT ( ' ========== STARTING MWW3 INITIALIZATION (WMINIT) =', &

         '============================'/)

901 FORMAT ( ' WAVEWATCH III log file            ',                 &

         '                     version ',a/                     &

         ' ==================================',                 &

         '==================================='/                 &

         ' multi-grid model driver                          ',  &

         'date : ',a10/50x,'time :  ',a8)

    !

910 FORMAT ( '  Opening input file ',a,' (unit number',i3,')')

911 FORMAT ( '  Opening output file ',a,' (unit number',i3,')')

912 FORMAT (/'  Comment character : ''',a,'''')

    !

920 FORMAT (/'  Number of grids          :',i3)

921 FORMAT ( '  No input data grids.')

922 FORMAT ( '  Input data grids         :',i3)

923 FORMAT ( '  Single point output file : ',a)

1923 FORMAT (/'  Output server type       :',i3)

2923 FORMAT ( '  Single point output proc : ',a)

3923 FORMAT ( '  Grids share output procs : ',a)

    !

924 FORMAT (/'  Input grid information : '/                         &

         '  nr extension  lev.   cur.   wind   ice    tau',     &

         '    rho    data'/    &

         ' ----------------------------------------------',     &

         '--------------')

925 FORMAT (1x,i3,1x,a10,6(1x,a6),3(1x,a1))

926 FORMAT ( ' ----------------------------------------------',     &

         '--------------')

    !

927 FORMAT (/'  Grid for point output : '/                          &

         '  nr extension  '/ ' ---------------')

928 FORMAT (5x,a10)

929 FORMAT ( ' ---------------')

    !

930 FORMAT (/'  Wave grid information : '/                          &

         '  nr extension  lev.   cur.   wind   ice    tau',     &

         '    rho    data   move1 rnk grp dmp'/                 &

         ' ----------------------------------------------',     &

         '-----------------------------------')

931 FORMAT (1x,i3,1x,a10,6(1x,a6),3(1x,a1),2x,a4,2i4,3x,a1)

932 FORMAT ( ' -----------------------------------------------',    &

         '-----------------------------------'/)

933 FORMAT ( '  ',a,' : '/                                          &

         '  nr   grids (part of comm.)'/                        &

         ' -----------------------------------------------',    &

         '---------------------')

934 FORMAT (a)

935 FORMAT ( ' -----------------------------------------------',    &

         '---------------------'/)

936 FORMAT (/'  ',a,' : '/                                          &

         '  nr   Depends on '/                                  &

         ' -----------------------------------------------',    &

         '---------------------')

937 FORMAT ( '  ',a/)

938 FORMAT (/'  ',a/)

    !

940 FORMAT (/'  Time interval : '/                                  &

         ' --------------------------------------------------')

941 FORMAT ( '       Starting time : ',a)

942 FORMAT ( '       Ending time   : ',a/)

943 FORMAT (/'  Model settings : '/                                 &

         ' --------------------------------------------------')

944 FORMAT ( '       Masking computation in nesting : ',a)

945 FORMAT ( '       Masking output in nesting      : ',a/)

    !

950 FORMAT (/'  Output requests : (ALL GRIDS) '/                    &

         ' ==================================================')

951 FORMAT (/'       Type',i2,' : ',a/                              &

         '      -----------------------------------------')

952 FORMAT ( '            From     : ',a)

953 FORMAT ( '            To       : ',a)

954 FORMAT ( '            Interval : ',a/)

955 FORMAT ( '            Fields   : ',a)

956 FORMAT ( '                       ',a)

957 FORMAT ( '            Point  1 : ',2e14.6,2x,a)

958 FORMAT ( '              ',i6,' : ',2e14.6,2x,a)

959 FORMAT ( '            No points defined')

960 FORMAT ( '            The file with ',a,' data is ',a,'.')

961 FORMAT ( '            IX fls   : ',3i6/                         &

         '            IY fls   : ',3i6)

962 FORMAT (/'  Output request for model ',a,' (nr',i3,') '/        &

         ' ==================================================')

963 FORMAT ( '            Output disabled')

    !

965 FORMAT (/'  Grid movement data (!/MGP, !/MGW): '/               &

         ' --------------------------------------------------')

966 FORMAT ( '       ',a)

967 FORMAT ( '       ',i6,2x,a)

968 FORMAT ( '          ',i6,i11.8,i7.6,2f8.2)

    !

970 FORMAT(//'  Assigning resources : '/                            &

         ' --------------------------------------------------')

971 FORMAT ( '       ',a)

972 FORMAT ( '       Process ',i5.5,' reserved for all point output.')

973 FORMAT ( '       Processes ',i5.5,' through ',i5.5,' [',i3,']', &

         ' reserved for output.')

974 FORMAT (/                                                       &

         5x,'  grid           comp.      grd    pnt    trk    rst    bpt    prt'/     &

         5x,' ------------------------------------------------------', &

         '-------------')

975 FORMAT (5x,'  ',a10,2x,i5.5,'-',i5.5,6(2x,a5))

976 FORMAT(5x,' -------------------------------------------------', &

         '------------------')

977 FORMAT (5x,'    Unified point output at ',i5.5)

1974 FORMAT ('  Resource assignement (processes) : '/                &

         '  grid           comp.      grd    pnt    trk    rst    bpt    prt'/     &

         ' ------------------------------------------------------', &

         '-------------')

1975 FORMAT ('  ',a10,2x,i5.5,'-',i5.5,6(2x,a5))

1976 FORMAT (' ---------------------------------------------------', &

         '----------------')

1977 FORMAT ('    Unified point output at ',i5.5)

    !

980 FORMAT(//'  Initializations :'/                                 &

         ' --------------------------------------------------')

981 FORMAT ( '       Model number',i3,' [',a,']')

982 FORMAT ( '          Initializing wave model ...')

983 FORMAT ( '          Initializing model input ...')

984 FORMAT ( '            ',a,': file not needed')

985 FORMAT ( '            ',a,': file OK')

986 FORMAT ( '       Unified point output [',a,']')

987 FORMAT ( '          Initializing grids ...')

988 FORMAT ( '       Input data grid',i3,' [',a,']')

    !

#ifdef W3_MPRF

990 FORMAT (1x,3f12.3,' WMINIT',1x,a)

#endif

    !

998 FORMAT ( '  Running the model :'/                               &

         ' --------------------------------------------------'/)

999 FORMAT ( ' ========== END OF MWW3 INITIALIZATION (WMINIT) ===', &

         '============================'/)

    !

1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     ERROR IN OPENING INPUT FILE ',a/                 &

         '     IOSTAT =',i5/)

    !

1001 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     PREMATURE END OF INPUT FILE'/)

    !

1002 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     ERROR IN READING FROM INPUT FILE'/               &

         '     IOSTAT =',i5/)

1010 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     ERROR IN OPENING LOG FILE'/                      &

         '     IOSTAT =',i5/)

1011 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     ERROR IN OPENING TEST FILE'/                     &

         '     IOSTAT =',i5/)

1020 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     ILLEGAL NUMBER OF GRIDS ( < 1 ) '/)

1021 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     ILLEGAL NUMBER OF INPUT GRIDS ( < 0 ) '/)

1030 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     INPUT GRID NAME NOT FOUND '/                     &

         '     WAVE GRID  : ',a/                                &

         '     INPUT NAME : ',a/)

1031 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/           &

         '     REQUESTED INPUT TYPE NOT FOUND IN INPUT GRID '/  &

         '     INPUT GRID : ',a/                                &

         '     INPUT TYPE : ',i8/)

1032 FORMAT (/' *** WAVEWATCH III WARNING IN WMINIT : *** '/         &

         '     INPUT GRID ',a,' NOT USED '/)

1040 FORMAT ( ' *** WAVEWATCH III WARNING IN W3MLTI : ***'/          &

         '     POSSIBLE LOAD IMBALANCE GROUP',i3,' :',2i6/)

    !1040 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/            &

    !              '     ILLEGAL TIME INTERVAL'/)

1050 FORMAT (/' *** WAVEWATCH III WARNING IN W3MLTI : ***'/          &

         '     UNIFIED POINT OUTPUT BUT NO OUTPUT'/             &

         '     UNIFIED POINT OUTPUT DISABLED'/)

1051 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/            &

         '     ILLEGAL MODEL ID [',a,']'/)

1052 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/            &

         '     ILLEGAL OUTPUT TYPE',i10/)

1053 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/            &

         '     OUTPUT POINTS FOR INDIVIDUAL GRIDS CANNOT BE DEFINED'/ &

         '     WHEN UNIFIED POINT OUTPUT IS REQUESTED'/)

1054 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/            &

         '     POINT OUTPUT ACTIVATED, BUT NO POINTS DEFINED'/)

1060 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/            &

         '     NO MOVING GRID DATA PRESENT'/)

1070 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : ***'/            &

         '     ALL GRIDS ARE NOT USING THE SAME COORDINATE SYSTEM'/)

1080 FORMAT (/' *** BOUNDARY DATA READ, WILL NOT DUMP, GRID :',i4,   &

         ' ***')

1081 FORMAT (/' *** NO BOUNDARY DATA TO DUMP, GRID :',i4,' ***')

1082 FORMAT ( '  No boundary data dump for grid',i3/)

    !

#ifdef W3_T

9000 FORMAT ( ' TEST WMINIT : UNIT NUMBERS    : ',5i6/            &

         '               INPUT FILE NAME : ',a)

#endif

    !

#ifdef W3_T

9020 FORMAT ( ' TEST WMINIT : UNIT NUMBERS FOR GRIDS (',a,')'/    &

         15x,'GRID MDS(1-15)',43x,'NTRACE')

9021 FORMAT (14x,16i4)

9022 FORMAT ( ' TEST WMINIT : UNIT NUMBERS FOR INTPUT FILES'/     &

         15x,'GRID MDSF(JFIRST-9)')

9030 FORMAT ( ' TEST WMINIT : FILE EXTENSIONS, INPUT FLAGS,',     &

         ' RANK AND GROUP, PROC RANGE')

9031 FORMAT ( '            ',i3,1x,a,20l2,2i4,2f6.2)

9032 FORMAT ( ' TEST WMINIT : PROCESSED RANK NUMBERS')

9033 FORMAT ( '             ',i3,1x,a,1x,i4)

9034 FORMAT ( ' TEST WMINIT : NUMBER OF GROUPS :',i4)

9035 FORMAT ( ' TEST WMINIT : SIZE OF GROUPS :',20i3)

9036 FORMAT ( ' TEST WMINIT : GROUP SIZE AND COMPONENTS :')

9037 FORMAT ( '             ',2i3,':',20i3)

#endif

    !

#ifdef W3_T

9050 FORMAT ( ' TEST WMINIT : GRID NUMBER',i3,' =================')

9051 FORMAT ( ' TEST WMINIT : ODAT   : ',i9.8,i7.6,i7,i9.8,i7.6,  &

         5(/24x,i9.8,i7.6,i7,i9.8,i7.6) )

9052 FORMAT ( ' TEST WMINIT : FLGRD  : ',5(5l2,1x)/24x,5(5l2,1x))

#endif

    !

#ifdef W3_T

9060 FORMAT ( ' TEST WMINIT : GRID MOVEMENT DATA')

9061 FORMAT ( '             ',i8.8,i7,1x,2f8.2)

#endif

    !

#ifdef W3_T

9070 FORMAT ( ' TEST WMINIT : ALLPRC ')

9071 FORMAT ( ' ',i3,'  : ',250i3)

8042 FORMAT ( ' TEST WMINIT : MODMAP ')

8043 FORMAT ( ' TEST WMINIT : LOADMP ')

8044 FORMAT ( '        ',i3,'  : ',250i2)

#endif

    !

#ifdef W3_T

9080 FORMAT ( ' TEST WMINIT : MODEL INITIALIZATION')

9081 FORMAT ( '               MODEL AND TIME   :',i4,i10.8,i8.6)

9082 FORMAT ( '               STATUS AND TIMES :',i4,3(i10.8,i8.6))

9083 FORMAT ( ' TEST WMINIT : IDINP AFTER INITIALIZATION :')

9084 FORMAT ( '               ',i4,17(2x,a3))

#endif

    !/

    !/ End of WMINIT ----------------------------------------------------- /

    !/

  END SUBROUTINE wminit


  !/ ------------------------------------------------------------------- /

  SUBROUTINE wminitnml ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME,       &

       MPI_COMM, PREAMB )

    !/

    !/                  +-----------------------------------+

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         22-Mar-2021 |

    !/                  +-----------------------------------+

    !/

    !/    13-Jun-2005 : Origination.                        ( version 3.07 )

    !/    28-Dec-2005 : Add static nesting.                 ( version 3.08 )

    !/    25-May-2006 : Add overlapping grids.              ( version 3.09 )

    !/    26-Jun-2006 : Add output type 6.                  ( version 3.09 )

    !/    29-Jun-2006 : Adding file name preamble.          ( version 3.09 )

    !/    09-Aug-2006 : Unified point output added.         ( version 3.10 )

    !/    14-Oct-2006 : Adding separate input grids.        ( version 3.10 )

    !/    03-Nov-2006 : Adding wave field separation.       ( version 3.10 )

    !/    02-Feb-2007 : Adding FLAGST initialization.       ( version 3.10 )

    !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11 )

    !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )

    !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )

    !/                  (W. E. Rogers & T. J. Campbell, NRL)

    !/    16-Aug-2010 : Adding NTRMAX to unify NTRACE.    ( version 3.14.5 )

    !/    21-Sep-2010 : Adding coupling output              ( version 3.14-Ifremer)

    !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to

    !/                  specify index closure for a grid.   ( version 3.14 )

    !/                  (T. J. Campbell, NRL)

    !/    28-Jul-2012 : Initialize FLGR2 properly.          ( version 4.08 )

    !/                  Tom Durant's fix, but moved to allocation.

    !/    28-Nov-2012 : Bug fix: Distribute to idle processors the grid data

    !/                  required for regridding.            ( version 4.08 )

    !/                  (T. J. Campbell, NRL)

    !/    02-Sep-2012 : Set up for > 999 test files.        ( version 4.10 )

    !/                  Set up output for  > 999 procs.

    !/    03-Sep-2012 : Output of initilization time.       ( version 4.10 )

    !/                  Switch test file on/off (TSTOUT)

    !/    28-Nov-2012 : Bug fix: Distribute to idle processors the grid data

    !/                  required for regridding.            ( version 4.08 )

    !/                  (T. J. Campbell, NRL)

    !/    15-Apr-2013 : Changes the reading of output fields( version 4.10 )

    !/                  (F. Ardhuin)

    !/    28-Jan-2014 : Add memory hwm to profiling.        ( version 5.00 )

    !/    27-May-2014 : Bug fix prf file name.              ( version 5.02 )

    !/    17-Sep-2014 : Read mod_def before inp file        ( version 5.03 )

    !/    17-Feb-2016 : New version from namelist use       ( version 5.11 )

    !/    20-Jan-2017 : Update to new W3GSRUMD APIs         ( version 6.02 )

    !/    20-Jan-2017 : Modify input forcing flags to support coupler input.

    !/                  Add ESMF override for STIME & ETIME ( version 6.02 )

    !/                  (T. J. Campbell, NRL)

    !/    15-May-2018 : Update namelist                     ( version 6.05 )

    !/    28-Oct-2020 : Add SMCTYPE for SMC sub-grid.  JGLi ( version 7.13 )

    !/    22-Mar-2021 : Add momentum and air density input  ( version 7.13 )

    !/

    !  1. Purpose :

    !

    !     Initialize multi-grid version of WAVEWATCH III.

    !

    !  2. Method :

    !

    !  3. Parameters :

    !

    !     Parameter list

    !     ----------------------------------------------------------------

    !       IDSI    Int.   I   Unit number for input file.

    !       IDSO    Int.   I   Unit number for output file.

    !       IDSS    Int.   I   Unit number for "screen" output. Switch off

    !                          by setting equal to IDSO.

    !       IDST    Int.   I   Unit number for test output.

    !       IDSE    Int.   I   Unit number for error output.

    !       IFNAME  Char   I   File name for input file.

    !     MPI_COMM  Int.   I   MPI communicator to be used.

    !       PREAMB  Char   I   File name preamble (optional).

    !     ----------------------------------------------------------------

    !

    !  4. Subroutines used :

    !

    !      Name      Type  Module   Description

    !     ----------------------------------------------------------------

    !      W3NMOD    Subr. W3GDATMD Data structure initialization.

    !      W3DIMX    Subr.   Id.    Set grid arrays.

    !      W3DIMS    Subr.   Id.    Set grid arrays.

    !      W3SETG    Subr.   Id.    Point to grid/model.

    !      W3NDAT    Subr. W3WDATMD Data structure initialization.

    !      W3SETW    Subr.   Id.    Point to grid/model.

    !      W3NAUX    Subr. W3ADATMD Data structure initialization.

    !      W3SETA    Subr.   Id.    Point to grid/model.

    !      W3NOUT    Subr. W3ODATMD Data structure initialization.

    !      W3SETO    Subr.   Id.    Point to grid/model.

    !      W3NINP    Subr. W3IDATMD Data structure initialization.

    !      W3SETI    Subr.   Id.    Point to grid/model.

    !      W3DIMI    Subr.   Id.    Allocate grid/model.

    !      WMNDAT    Subr. WMMDATMD Data structure initialization.

    !      WMSETM    Subr.   Id.    Point to grid/model.

    !      WMDIMD    Subr.   Id.    Allocate array space.

    !      W3FLDO    Subr. W3FLDSMD Open input data file.

    !      W3IOGR    Subr. W3IOGRMD Reading of model definition file.

    !      W3INIT    Subr. W3INITMD Model intiailization.

    !      WMGLOW    Subr. WMGRIDMD Lower rank grid dependencies.

    !      WMGEQL    Subr.   Id.    Same rank grid dependencies.

    !      WMGHGH    Subr.   Id.    Higher rank grid dependencies.

    !      RESPEC    Subr.   Id.    Spectral conversion flags.

    !      WMIOBS    Subr. WMINIOMD Stage boundary data.

    !      WMIOBG    Subr.   Id.    Gather boundary data.

    !      WMIOBF    Subr.   Id.    Finalize staging in WMIOBS.

    !      WMUINI    Subr. WMUNITMD Initialize dynamic unit assignment,

    !      WMUDMP    Subr.   Id.    Dump dynamic unit data,

    !      WMUSET    Subr.   Id.    Set unit number data.

    !      WMUGET    Subr.   Id.    Get a unit number.

    !      WMUINQ    Subr.   Id.    Update unit number info.

    !      WMIOPP    Subr. WMIOPOMD Initialize unified point output.

    !      ITRACE    Subr. W3SERVMD Initialize subroutine tracing.

    !      STRACE    Subr.   Id.    Subroutine tracing.

    !      EXTCDE    Subr.   Id.    Program abort.

    !      WWDATE    Subr.   Id.    System date.

    !      WWTIME    Subr.   Id.    System time.

    !      PRINIT    Subr.   Id.    Profiling routine ( !/MPRF )

    !      PRTIME    Subr.   Id.    Profiling routine ( !/MPRF )

    !      STME21    Subr. W3TIMEMD Convert time to string.

    !      DSEC21    Func.   Id.    Difference between times.

    !      TICK21    Subr.   Id.    Advance the clock.

    !      W3READFLGRD Subr. W3IOGOMD Reads flags or namelist for output fields

    !

    !      MPI_COMM_SIZE, CALL MPI_COMM_RANK, MPI_BARRIER, MPI_COMM_GROUP,

    !      MPI_GROUP_INCLUDE, MPI_COMM_CREATE, MPI_GROUP_FREE, MPI_BCAST

    !                Subr. mpif.h   Standard MPI routines.

    !     ----------------------------------------------------------------

    !

    !  5. Called by :

    !

    !      Name      Type  Module   Description

    !     ----------------------------------------------------------------

    !      W3MLTI    Prog.   N/A    Multi-grid model driver.

    !      ....                     Any coupled model.

    !     ----------------------------------------------------------------

    !

    !  6. Error messages :

    !

    !     See formats 1000 and following, or escape locations 2000 and

    !     following.

    !

    !  7. Remarks :

    !

    !     - When running regtests in cases where disk is non-local

    !       (i.e. NFS used), there can be a huge improvment in compute

    !       time by using /var/tmp/ for log files.

    !       See commented line at "OPEN (MDSO,FILE=..."

    !

    !     - IDFLDS dimensioning is hardwired as IDFLDS(-7:9) where lowest possible

    !       value of JFIRST is JFIRST=-7

    !

    !  8. Structure :

    !

    !     --------------------------------------------------------------

    !      1.  Multi-grid model intializations

    !        a Unit numbers

    !        b Subroutine tracing                            ( ITRACE )

    !        c Input file

    !        d Log and test files

    !        e Initial and test output

    !      2.  Set-up of data structures and I/O

    !        a Get number of grids

    !        b Set up data structures

    !                 ( W3NMOD, W3NDAT, W3NAUX, W3NOUT, W3NINP, WMNDAT )

    !        c Set up I/O for individual models

    !      3.  Get individual grid information

    !        a Read data

    !        b Assign input file numbers.

    !        c Set rank and group data

    !        d Unified point output file.                    ( W3IOGR )

    !        e Output

    !      4.  Model run time information and settings

    !      5.  Output requests

    !        a Loop over types for unified output

    !        ---------------------------------------------------

    !        b Process standard line

    !        c Type 1: fields of mean wave parameters

    !        d Type 2: point output

    !        e Type 3: track output

    !        f Type 4: restart files (no additional data)

    !        g Type 5: nesting data (no additional data)

    !        h Type 6: wave field data (dummy for now)

    !        i Set all grids to unified output

    !        ---------------------------------------------------

    !        j Endless loop for correcting output per grid

    !        ---------------------------------------------------

    !          Test grid name and output number

    !        k Process standard line

    !        l Type 1: fields of mean wave parameters

    !        m Type 2: point output

    !        n Type 3: track output

    !        o Type 6: partitioning output

    !        p Type 7: coupling output

    !        ---------------------------------------------------

    !      6.  Read moving grid data

    !      7.  Work load distribution

    !        a Initialize arrays

    !        b Set communicators and ALLPRC array

    !        c Set MODMAP and LOADMP arrays

    !        d Warnings

    !      8.  Actual initializations

    !        a Loop over models for per-model initialization

    !           1 Wave model                                 ( W3INIT )

    !           2 Data files                                 ( W3FLDO )

    !           3 Grid status indicator and model times

    !           3 Grid data for processors that are NOT used.

    !           5 Test output

    !        b Input data files.

    !        c Inter model initialization

    !           1 Set spectral conversion flags              ( WMRSPC )

    !           2 Prepare unified point output               ( WMIOPO )

    !           3 Relation to lower ranked grids

    !                                ( WMGLOW, WMIOBS, WMIOBG, WMIOBF )

    !           4 Relation to same ranked grids              ( WMGEQL )

    !           5 Relation to higher ranked grids            ( WMGHGH )

    !           6 Output

    !     --------------------------------------------------------------

    !

    !  9. Switches :

    !

    !       !/SHRD  Switch for shared / distributed memory architecture.

    !       !/DIST  Id.

    !       !/MPI   Id.

    !

    !       !/MGW   Moving grid wind correction.

    !       !/MGP   Moving grid propagation correction.

    !

    !       !/O10   Enable output identifying start and end of routine

    !

    !       !/S     Enable subroutine tracing.

    !       !/T     Enable test output.

    !       !/MPRF  Profiling.

    !

    ! 10. Source code :

    !

    !/ ------------------------------------------------------------------- /

    USE constants

    !/

    USE w3gdatmd, ONLY: w3nmod, w3dimx, w3dims, w3setg

    USE w3wdatmd, ONLY: w3ndat, w3setw

    USE w3adatmd, ONLY: w3naux, w3seta

    USE w3odatmd, ONLY: w3nout, w3seto

    USE w3odatmd, ONLY:  ofiles

    USE w3idatmd, ONLY: w3ninp, w3seti, w3dimi

    USE wmmdatmd, ONLY: wmndat, wmsetm, wmdimd

    !

    USE w3fldsmd, ONLY: w3fldo

    USE w3iogomd, ONLY: w3readflgrd, w3flgrdflag

    USE w3iogrmd, ONLY: w3iogr

    USE w3initmd, ONLY: w3init

    USE wmgridmd, ONLY: wmrspc, wmglow, wmgeql, wmghgh, wmsmceql

    USE wminiomd, ONLY: wmiobs, wmiobg, wmiobf

    USE wmiopomd, ONLY: wmiopp

    !/

    USE w3servmd, ONLY: itrace, extcde, nextln, wwdate, wwtime

#ifdef W3_S

    USE w3servmd, ONLY: strace

#endif

#ifdef W3_MPRF

    USE w3timemd, ONLY: prinit, prtime

#endif

    USE w3timemd, ONLY: stme21, dsec21, tick21, tdiff

    USE wmunitmd, ONLY: wmuini, wmudmp, wmuset, wmuget, wmuinq

    !/

    USE w3gdatmd, ONLY: gtype, nx, ny, filext, nsea, flagst, grids

#ifdef W3_SMC

    USE w3gdatmd, ONLY: ncel, nufc, nvfc, nrlv, nbsmc

    USE w3gdatmd, ONLY: narc, nbac, nspec, smctype

#endif

#ifdef W3_MPI

    USE w3gdatmd, ONLY: flagll, iclose, gsu, x0, y0, sx, sy,   &

         xgrd, ygrd, dxdp, dxdq, dydp, dydq,    &

         hqfac, hpfac, mapsta, mapst2,          &

         gridshift, nseal, nk, nth, xfr, fr1,   &

         th, dtmax, dtcfl

    USE w3gsrumd

#endif

    USE w3wdatmd, ONLY: time

    USE w3adatmd, ONLY: wadats

    USE w3idatmd, ONLY: inflags1, inflags2, inputs, iinit,  &

         jfirst

    USE w3odatmd, ONLY: nogrp, ngrpp, flout, tonext, flbpi,  &

         flbpo, nfbpo, nbi, nds, iaproc,     &

         napfld, nappnt, naptrk, napbpt,     &

         napprt, naproc, fnmpre, outpts, ndst, ndse, &

         nopts, iostyp, unipts, upproc, dtout,       &

         tolast, notype

    USE wmmdatmd, ONLY: mdsi, mdso, mdss, mdst, mdse, mdsf, mdsup,  &

         improc, nmproc, nmpscr, nmperr,     &

         nmplog, nmpupt, stime, etime, nmv, nmvmax,  &

         tmv, amv, dmv, nrgrd, nrinp, nrgrp, grank,  &

         grgrp, ingrp, grdhgh, grdeql, grdlow,       &

         allprc, modmap, tsync, tmax, toutp, tdata,  &

         grstat, dtres, bcdump, flghg1, flghg2,      &

         inpmap, idinp, ngrpsmc

    USE wmmdatmd, ONLY: clkdt1, clkdt2, clkfin

#ifdef W3_MPI

    USE wmmdatmd, ONLY: mpi_comm_mwave, mpi_comm_grd,          &

         mpi_comm_bct, croot, fbcast

#endif

#ifdef W3_MPRF

    USE wmmdatmd, ONLY: mdsp

#endif

#ifdef W3_ASCII

    USE wmmdatmd, ONLY: mdsupa

#endif

    USE w3initmd, ONLY: wwver

    USE w3nmlmultimd

    !/

    IMPLICIT NONE

    !

#ifdef W3_MPI

    include "mpif.h"

#endif

    !/

    !/ ------------------------------------------------------------------- /

    !/ Parameter list

    !/

    INTEGER, INTENT(IN)        :: IDSI, IDSO, IDSS, IDST, IDSE,     &

         MPI_COMM

    CHARACTER*(*), INTENT(IN)  :: IFNAME

    CHARACTER*(*), INTENT(IN), OPTIONAL :: PREAMB

    !/

    !/ ------------------------------------------------------------------- /

    !/ Local parameters

    !/

    TYPE(nml_domain_t)                      :: NML_DOMAIN

    TYPE(nml_input_grid_t), ALLOCATABLE     :: NML_INPUT_GRID(:)

    TYPE(nml_model_grid_t), ALLOCATABLE     :: NML_MODEL_GRID(:)

    TYPE(nml_output_type_t), ALLOCATABLE    :: NML_OUTPUT_TYPE(:)

    TYPE(nml_output_date_t), ALLOCATABLE    :: NML_OUTPUT_DATE(:)

    TYPE(nml_homog_count_t)                 :: NML_HOMOG_COUNT

    TYPE(nml_homog_input_t), ALLOCATABLE    :: NML_HOMOG_INPUT(:)

    !

    TYPE ot2tpe

      INTEGER                    :: NPTS

      REAL, POINTER              :: X(:), Y(:)

      CHARACTER(LEN=40), POINTER :: PNAMES(:)

    END TYPE ot2tpe

    !

    TYPE(ot2tpe), ALLOCATABLE    :: OT2(:)

    !

    INTEGER                 :: MDSE2, IERR, I,J,K, N_MOV, N_TOT,     &

         SCRATCH, RNKMIN, RNKMAX, RNKTMP,      &

         GRPMIN, GRPMAX, II, NDSREC, NDSFND,   &

         NPTS, JJ, IP1, IPN, MPI_COMM_LOC,     &

         NMPSC2, JJJ, NCPROC, NPOUTT, NAPLOC,  &

         NAPRES, NAPADD, NAPBCT, IFI, IFJ, IW, &

         IFT, ILOOP

    !

    INTEGER                 :: TTIME(2), TOUT(2), STMPT(2), ETMPT(2),&

         TLST(2)

#ifdef W3_MPI

    INTEGER                 :: IERR_MPI, BGROUP, LGROUP, IROOT

#endif

#ifdef W3_S

    INTEGER, SAVE           :: IENT = 0

#endif

    !

    INTEGER, ALLOCATABLE    :: MDS(:,:), NTRACE(:,:), ODAT(:,:),     &

         TMPRNK(:), TMPGRP(:), NINGRP(:),      &

         TMOVE(:,:), LOADMP(:,:), IPRT(:,:),   &

         NDPOUT(:)                             &

         ,OUTFF(:,:)

    !

    REAL                    :: DTTST, XX, YY

#ifdef W3_MPRF

    REAL                    :: PRFT0, PRFTN

    REAL(KIND=8)            :: get_memory

#endif

    !

    REAL, ALLOCATABLE       :: X(:), Y(:), AMOVE(:), DMOVE(:),       &

         RP1(:), RPN(:)

    !

    LOGICAL                 :: FLT, TFLAGI, TFLAGS(-7:14), PSHARE

    LOGICAL, ALLOCATABLE    :: FLGRD(:,:,:), FLRBPI(:), BCDTMP(:),   &

         USEINP(:), LPRT(:), FLGR2(:,:,:),     &

         FLGD(:,:), FLG2(:,:), FLG2D(:,:),     &

         FLG1D(:), CPLINP(:)

    !

    CHARACTER(LEN=1)        :: COMSTR

    CHARACTER(LEN=256)      :: TMPLINE, TEST

    CHARACTER(LEN=3)        :: IDSTR(-7:9), IDTST

    CHARACTER(LEN=5)        :: STOUT, OUTSTR(6)

    CHARACTER(LEN=6)        :: YESXX, XXXNO

    CHARACTER(LEN=6),                                                &

         ALLOCATABLE :: ACTION(:)

    CHARACTER(LEN=8)        :: LFILE, STTIME

#ifdef W3_SHRD

    CHARACTER(LEN=9)        :: TFILE

#endif

    CHARACTER(LEN=13)       :: STDATE, MN, TNAMES(9)

    CHARACTER(LEN=40)       :: PN

    CHARACTER(LEN=13),                                               &

         ALLOCATABLE :: INAMES(:,:), MNAMES(:)

    CHARACTER(LEN=40),                                               &

         ALLOCATABLE :: PNAMES(:)

    CHARACTER(LEN=12)       :: FORMAT

#ifdef W3_DIST

    CHARACTER(LEN=18)       :: TFILE

#endif

#ifdef W3_MPRF

    CHARACTER(LEN=18)       :: PFILE

#endif

    CHARACTER(LEN=13)       :: IDFLDS(-7:9)

    CHARACTER(LEN=23)       :: DTME21

    CHARACTER(LEN=30)       :: IDOTYP(8)

    CHARACTER(LEN=80)       :: TNAME, LINE

    CHARACTER(LEN=1024)     :: FLDOUT

    !


    !/

    !/ ------------------------------------------------------------------- /

    !/


    DATA idflds / 'ice param. 1 ' , 'ice param. 2 ' ,               &

         'ice param. 3 ' , 'ice param. 4 ' ,               &

         'ice param. 5 ' ,                                 &

         'mud density  ' , 'mud thkness  ' ,               &

         'mud viscos.  ' ,                                 &

         'water levels ' , 'currents     ' ,               &

         'winds        ' , 'ice fields   ' ,               &

         'momentum     ' , 'air density  ' ,               &

         'mean param.  ' , '1D spectra   ' ,               &

         '2D spectra   ' /

    !

    DATA idotyp / 'Fields of mean wave parameters' ,                &

         'Point output                  ' ,                &

         'Track point output            ' ,                &

         'Restart files                 ' ,                &

         'Nesting data                  ' ,                &

         'Separated wave field data     ' ,                &

         'Fields for coupling           ' ,                &

         'Restart files second request  '/

    !

    DATA idstr  / 'IC1', 'IC2', 'IC3', 'IC4', 'IC5',                &

         'MDN', 'MTH', 'MVS', 'LEV', 'CUR',                &

         'WND', 'ICE', 'TAU', 'RHO', 'DT0',                &

         'DT1', 'DT2' /

    !

    DATA yesxx  / 'YES/--' /

    DATA xxxno  / '---/NO' /

    !

#ifdef W3_MPRF

    CALL prinit

    CALL prtime ( prft0 )

#endif

    !

    CALL date_and_time ( values=clkdt1 )

    !

    mpi_comm_loc   = mpi_comm

#ifdef W3_MPI

    mpi_comm_mwave = mpi_comm

    CALL mpi_comm_size ( mpi_comm_mwave, nmproc, ierr_mpi )

    CALL mpi_comm_rank ( mpi_comm_mwave, improc, ierr_mpi )

    improc = improc + 1

#endif

    !

    IF ( PRESENT(preamb) ) fnmpre = preamb

    !/

    !/ ------------------------------------------------------------------- /

    ! 1.  Multi-grid model intializations

    ! 1.a Unit numbers

    !     Initialize dynamic assignment, errors and test to stdout

    !

    CALL wmuini ( 6, 6 )

    !

    ! ... Identify reserved unit numbers

    !

    CALL wmuset ( 6,6,  5, .true., 'SYS', 'stdin', 'Standart input' )

    CALL wmuset ( 6,6,  6, .true., 'SYS', 'stdout','Standart output')

    !

#ifdef W3_NL2

    CALL wmuset (6,6,103, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,104, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,105, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,106, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,107, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,108, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,109, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,110, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,111, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,112, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,113, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,114, .true., 'FIX', desc='Reserved SNL2' )

    CALL wmuset (6,6,117, .true., 'FIX', desc='Reserved SNL2' )

#endif

    !

    ! ... Unit numbers from parameter list

    !     Dynamic scripture updated per file

    !

    mdsi   = idsi

    mdso   = idso

    mdss   = idss

    mdst   = idst

    mdse   = idse

    !

    comstr = '$'

    !

    IF ( improc .EQ. nmperr ) THEN

      mdse2  = mdse

    ELSE

      mdse2  = -1

    END IF

    !

    ! 1.b Subroutine tracing

    !

    CALL itrace ( mdst, ntrmax )

    !

#ifdef W3_O10

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,900)

#endif

    !

    ! 1.c Input file

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                      &

         WRITE (mdss,910)  ifname, mdsi

    !

    ! process ww3_multi namelist input

    CALL w3nmlmultidef (mpi_comm, mdsi, trim(fnmpre)//ifname, nml_domain, ierr)

    ALLOCATE(nml_input_grid(nml_domain%NRINP))

    ALLOCATE(nml_model_grid(nml_domain%NRGRD))

    ALLOCATE(nml_output_type(nml_domain%NRGRD))

    ALLOCATE(nml_output_date(nml_domain%NRGRD))

    !

    CALL w3nmlmulticonf (mpi_comm, mdsi, trim(fnmpre)//ifname, &

         nml_domain, nml_input_grid, nml_model_grid, nml_output_type, &

         nml_output_date, nml_homog_count, nml_homog_input, ierr)

    IF (ierr.NE.0) THEN

      WRITE (*,'(2A)') 'ERROR: error occured while processing ', ifname

      CALL exit (ierr)

    END IF


    CALL wmuset ( mdss, mdss, mdsi, .true., 'INP',                  &

         trim(fnmpre)//ifname, 'Model control input file')

    !

    ! 1.d Log and test files

    !

    lfile  = 'log.mww3'

    iw     = 1 + int( log10( real(nmproc) + 0.5 ) )

    iw     = max( 3 , min( 9 , iw ) )

    WRITE (FORMAT,'(A5,I1.1,A1,I1.1,A4)') '(A4,I',iw,'.',iw,',A5)'

#ifdef W3_SHRD

    tfile  = 'test.mww3'

#endif

#ifdef W3_DIST

    WRITE (tfile,format) 'test', improc, '.mww3'

#endif

#ifdef W3_MPRF

    WRITE (pfile,format) 'prf.', improc, '.mww3'

#endif

    !

    IF ( improc .EQ. nmplog ) THEN

      OPEN (mdso,file=trim(fnmpre)//lfile,err=2010,iostat=ierr)

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,911)  lfile, mdso

      CALL wmuset ( mdss, mdss, mdso, .true., 'OUT',              &

           trim(fnmpre)//lfile, 'Log file')

    ELSE

      CALL wmuset ( mdss, mdss, mdso, .true., 'XXX',              &

           'Log file on other processors')

    END IF

    !

    IF ( mdst.NE.mdso .AND. mdst.NE.mdss .AND. tstout ) THEN

      ift    = len_trim(tfile)

      OPEN (mdst,file=trim(fnmpre)//tfile(:ift),err=2011,iostat=ierr)

      CALL wmuset ( mdss, mdst, mdst, .true., 'OUT',              &

           trim(fnmpre)//tfile(:ift), 'Test output file')

    END IF

    !

#ifdef W3_MPRF

    ift    = len_trim(pfile)

    CALL wmuget ( mdss, mdst, mdsp, 'OUT' )

    CALL wmuset ( mdss, mdst, mdsp, .true., 'OUT',            &

         trim(fnmpre)//pfile(:ift), 'Profiling file')

    OPEN (mdsp,file=trim(fnmpre)//pfile(:ift),err=2011,iostat=ierr)

#endif

    !

    ! 1.e Initial and test output

    !

#ifdef W3_S

    CALL strace (ient, 'WMINITNML')

#endif

    !

    IF ( improc .EQ. nmplog ) THEN

      CALL wwdate ( stdate )

      CALL wwtime ( sttime )

      WRITE (mdso,901) wwver, stdate, sttime

    END IF

    !

#ifdef W3_T

    WRITE(mdst,9000) idsi, idso, idss, idst, idse, ifname

#endif

    !

    ! 2.  Set-up of data structures and I/O  ----------------------------- /

    ! 2.a Get number of grids

    !     Note: grid for consolidated point output always generated.

    !     Processor set as in W3INIT to minimize communication in WMIOPO

    !

    nrinp = nml_domain%NRINP

    nrgrd = nml_domain%NRGRD

    unipts = nml_domain%UNIPTS

    iostyp = nml_domain%IOSTYP

    upproc = nml_domain%UPPROC

    pshare = nml_domain%PSHARE


    iostyp = max( 0 , min( 3 , iostyp ) )

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      WRITE (mdss,920) nrgrd

      IF ( nrinp .EQ. 0 ) THEN

        WRITE (mdss,921)

      ELSE

        WRITE (mdss,922) nrinp

      END IF

      IF ( unipts ) THEN

        WRITE (mdss,923) yesxx

      ELSE

        WRITE (mdss,923) xxxno

      END IF

      WRITE (mdss,1923) iostyp

      IF ( unipts ) THEN

        IF ( upproc ) THEN

          WRITE (mdss,2923) yesxx

        ELSE

          WRITE (mdss,2923) xxxno

        END IF

      END IF

      IF ( iostyp.GT.1 .AND. pshare ) THEN

        WRITE (mdss,3923) yesxx

      ELSE IF ( iostyp.GT. 1 ) THEN

        WRITE (mdss,3923) xxxno

      END IF

    END IF

    !

    IF ( nrgrd .LT. 1 ) GOTO 2020

    IF ( nrinp .LT. 0 ) GOTO 2021

    IF ( nrinp.EQ.0 .AND. .NOT.unipts ) nrinp = -1

    !

    ! 2.b Set up data structures

    !

    CALL w3nmod ( nrgrd, mdse2, mdst, nrinp )

    CALL w3ndat (        mdse2, mdst )

    CALL w3naux (        mdse2, mdst )

    CALL w3nout (        mdse2, mdst )

    CALL w3ninp (        mdse2, mdst )

    CALL wmndat (        mdse2, mdst )

    !

    ! 2.c Set up I/O for individual models (initial)

    !

    ALLOCATE ( mds(15,nrgrd), ntrace(2,nrgrd), odat(40,0:nrgrd),    &

         flgrd(nogrp,ngrpp,nrgrd), ot2(0:nrgrd), flgd(nogrp,nrgrd), &

         mdsf(-nrinp:nrgrd,jfirst:9), iprt(6,nrgrd), lprt(nrgrd),   &

         flgr2(nogrp,ngrpp,nrgrd),flg2d(nogrp,ngrpp), flg1d(nogrp), &

         flg2(nogrp,nrgrd),outff(7,0:nrgrd))

    !

    mds    = -1

    mdsf   = -1

    flgr2  = .false.

    flg2   = .false.

    lprt   = .false.

    iprt   = 0

    !

    ! ... Fixed and recycleable unit numbers.

    !

    CALL wmuget ( mdse, mdst, ndsrec, 'INP' )

    CALL wmuset ( mdse, mdst, ndsrec, .true., 'I/O', name='...',    &

         desc='Recyclable I/O (mod_def etc.)' )

    CALL wmuget ( mdse, mdst, scratch, 'SCR' )

    CALL wmuset ( mdse, mdst, scratch, .true., desc='Scratch file', &

         name=trim(fnmpre)//'ww3_multi.scratch' )

    !

    IF(mdst.EQ.ndsrec)THEN

      IF   ( improc .EQ. nmperr )                                  &

           WRITE(mdse,'(A,I8)')'RECYCLABLE UNIT NUMBERS AND '&

           //'TEST OUTPUT UNIT NUMBER ARE THE SAME : ',mdst

      CALL extcde ( 15 )

    ENDIF


    DO i=1, nrgrd

      mds( 2,i) =  6

      mds( 3,i) = mdst

      mds( 4,i) =  6

      mds( 5,i) = ndsrec

      mds( 6,i) = ndsrec

      ntrace( 1,i) = mdst

      ntrace( 2,i) = ntrmax

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9020) 'INITIAL'

    DO i=1, nrgrd

      WRITE (mdst,9021) i, mds(:,i), ntrace(:,i)

    END DO

#endif

    !

    ! 3.  Get individual grid information -------------------------------- /

    !

    !     Version 3.07: For now we simply read the input data flags,

    !                   skip the homogeneous option. Later on, we want

    !                   to have the options to use input from common

    !                   sources, and from communication rather than

    !                   files.

    !

    ALLOCATE ( inames(2*nrgrd,-7:9), mnames(-nrinp:2*nrgrd),   &

         tmprnk(2*nrgrd), tmpgrp(2*nrgrd), ningrp(2*nrgrd),  &

         rp1(2*nrgrd), rpn(2*nrgrd), bcdtmp(nrgrd+1:2*nrgrd) )

    ALLOCATE ( grank(nrgrd), grgrp(nrgrd), useinp(nrinp) )

    ALLOCATE ( cplinp(nrinp) )

    grank  = -1

    grgrp  = -1

    useinp = .false.

    cplinp = .false.

    !

    ! 3.a Read data

    !

#ifdef W3_T

    WRITE (mdst,9030)

#endif

    !

    ! 3.a.1 Input grids

    !

    DO i=1, nrinp

      !

      CALL w3seti ( -i, mdse, mdst )

      inflags1 = .false.

      mnames(-i) = nml_input_grid(i)%NAME

      inflags1(-7) = nml_input_grid(i)%FORCING%ICE_PARAM1

      inflags1(-6) = nml_input_grid(i)%FORCING%ICE_PARAM2

      inflags1(-5) = nml_input_grid(i)%FORCING%ICE_PARAM3

      inflags1(-4) = nml_input_grid(i)%FORCING%ICE_PARAM4

      inflags1(-3) = nml_input_grid(i)%FORCING%ICE_PARAM5

      inflags1(-2) = nml_input_grid(i)%FORCING%MUD_DENSITY

      inflags1(-1) = nml_input_grid(i)%FORCING%MUD_THICKNESS

      inflags1(0) = nml_input_grid(i)%FORCING%MUD_VISCOSITY

      inflags1(1) = nml_input_grid(i)%FORCING%WATER_LEVELS

      inflags1(2) = nml_input_grid(i)%FORCING%CURRENTS

      inflags1(3) = nml_input_grid(i)%FORCING%WINDS

      inflags1(4) = nml_input_grid(i)%FORCING%ICE_CONC

      inflags1(5) = nml_input_grid(i)%FORCING%ATM_MOMENTUM

      inflags1(6) = nml_input_grid(i)%FORCING%AIR_DENSITY

      inflags1(7) = nml_input_grid(i)%ASSIM%MEAN

      inflags1(8) = nml_input_grid(i)%ASSIM%SPEC1D

      inflags1(9) = nml_input_grid(i)%ASSIM%SPEC2D

    END DO

    !

    ! 3.a.2 Unified point output grid.

    !

    IF ( unipts ) THEN

      !

      CALL w3seti ( 0, mdse, mdst )

      CALL w3seto ( 0, mdse, mdst )

      inflags1 = .false.

      ndst   = mdst

      ndse   = mdse

      !

      mnames(0) = nml_output_type(1)%POINT%NAME

      !

      IF ( iostyp .LE. 1 ) THEN

        nmpupt = max(1,nmproc-2)

      ELSE

        nmpupt = nmproc

      END IF

      !

    END IF

    !

    ! 3.a.3 Read wave grids

    !

    DO i=1,nrgrd

      mnames(nrgrd+i) = nml_model_grid(i)%NAME

      inames(nrgrd+i,-7) = nml_model_grid(i)%FORCING%ICE_PARAM1

      inames(nrgrd+i,-6) = nml_model_grid(i)%FORCING%ICE_PARAM2

      inames(nrgrd+i,-5) = nml_model_grid(i)%FORCING%ICE_PARAM3

      inames(nrgrd+i,-4) = nml_model_grid(i)%FORCING%ICE_PARAM4

      inames(nrgrd+i,-3) = nml_model_grid(i)%FORCING%ICE_PARAM5

      inames(nrgrd+i,-2) = nml_model_grid(i)%FORCING%MUD_DENSITY

      inames(nrgrd+i,-1) = nml_model_grid(i)%FORCING%MUD_THICKNESS

      inames(nrgrd+i,0) = nml_model_grid(i)%FORCING%MUD_VISCOSITY

      inames(nrgrd+i,1) = nml_model_grid(i)%FORCING%WATER_LEVELS

      inames(nrgrd+i,2) = nml_model_grid(i)%FORCING%CURRENTS

      inames(nrgrd+i,3) = nml_model_grid(i)%FORCING%WINDS

      inames(nrgrd+i,4) = nml_model_grid(i)%FORCING%ICE_CONC

      inames(nrgrd+i,5) = nml_model_grid(i)%FORCING%ATM_MOMENTUM

      inames(nrgrd+i,6) = nml_model_grid(i)%FORCING%AIR_DENSITY

      inames(nrgrd+i,7) = nml_model_grid(i)%ASSIM%MEAN

      inames(nrgrd+i,8) = nml_model_grid(i)%ASSIM%SPEC1D

      inames(nrgrd+i,9) = nml_model_grid(i)%ASSIM%SPEC2D

      tmprnk(nrgrd+i) = nml_model_grid(i)%RESOURCE%RANK_ID

      tmpgrp(nrgrd+i) = nml_model_grid(i)%RESOURCE%GROUP_ID

      rp1(nrgrd+i) = nml_model_grid(i)%RESOURCE%COMM_FRAC(1)

      rpn(nrgrd+i) = nml_model_grid(i)%RESOURCE%COMM_FRAC(2)

      bcdtmp(nrgrd+i) = nml_model_grid(i)%RESOURCE%BOUND_FLAG

      !

      rp1(nrgrd+i) = max( 0. , min( 1. , rp1(nrgrd+i) ) )

      rpn(nrgrd+i) = max( rp1(nrgrd+i) , min( 1. , rpn(nrgrd+i) ) )

    END DO

    !

    ! 3.a.4 Sort wave grids

    !

    rnktmp = minval( tmprnk(nrgrd+1:2*nrgrd) )

    i      = 0

    !

    DO

      DO j=nrgrd+1, 2*nrgrd

        IF ( tmprnk(j) .EQ. rnktmp ) THEN

          i      = i + 1

          CALL w3seti ( i, mdse, mdst )

          inflags1      = .false.

#ifdef W3_MGW

          inflags1(10)   = .true.

#endif

#ifdef W3_MGP

          inflags1(10)   = .true.

#endif

          inames(i,:)= inames(j,:)

          mnames(i)  = mnames(j)

          tmprnk(i)  = tmprnk(j)

          tmpgrp(i)  = tmpgrp(j)

          rp1(i)     = rp1(j)

          rpn(i)     = rpn(j)

          bcdump(i)  = bcdtmp(j)

#ifdef W3_T

          WRITE (mdst,9031) i, mnames(i), inflags1, tmprnk(i),    &

               tmpgrp(i), rp1(i), rpn(i)

#endif

        END IF

      END DO

      IF ( i .EQ. nrgrd ) EXIT

      rnktmp = rnktmp + 1

    END DO

    !

    ! 3.a.5 Set input flags

    !

    ALLOCATE ( inpmap(nrgrd,jfirst:10), idinp(-nrinp:nrgrd,jfirst:10) )

    inpmap = 0

    idinp  = '---'

    !

    DO i=1, nrgrd

      CALL w3seti ( i, mdse, mdst )

      DO j=jfirst, 9

        IF ( inames(i,j) .EQ. 'native' ) THEN

          ! *** forcing input from file & defined on the native grid ***

          inflags1(j) = .true.

        ELSE

          inflags1(j) = .false.

          IF ( inames(i,j)(1:4) .EQ. 'CPL:' ) THEN

            IF ( inames(i,j)(5:) .EQ. 'native' ) THEN

              ! *** forcing input from CPL & defined on the native grid ***

              inflags1(j) = .true.

              inpmap(i,j) = -999

            ELSE

              ! *** forcing input from CPL & defined on an input grid ***

              DO jj=1, nrinp

                IF ( mnames(-jj) .EQ. inames(i,j)(5:) ) THEN

                  inpmap(i,j) = -jj

                  EXIT

                END IF

              END DO

              IF ( inpmap(i,j) .EQ. 0 ) GOTO 2030

              IF ( .NOT. inputs(inpmap(i,j))%INFLAGS1(j) ) GOTO 2031

              useinp(-inpmap(i,j)) = .true.

              cplinp(-inpmap(i,j)) = .true.

            END IF

          ELSE IF ( inames(i,j) .NE. 'no' ) THEN

            ! *** forcing input from file & defined on an input grid ***

            DO jj=1, nrinp

              IF ( mnames(-jj) .EQ. inames(i,j) ) THEN

                inpmap(i,j) = jj

                inflags2(j) = .true.

                EXIT

              END IF

            END DO

            IF ( inpmap(i,j) .EQ. 0 ) GOTO 2030

            IF ( .NOT. inputs(-inpmap(i,j))%INFLAGS1(j) ) GOTO 2031

            useinp(inpmap(i,j)) = .true.

          END IF

        END IF

        !        INFLAGS2 is initial value of INFLAGS1. Unlike INFLAGS1,

        !           it does not change during the simulation

        IF(.NOT. inflags2(j)) inflags2(j)=inflags1(j)

      END DO !         DO J=JFIRST, 9

    END DO !      DO I=1, NRGRD

    !

    DO i=1, nrinp

      IF ( .NOT.useinp(i) .AND.                                     &

           mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        ii     = len_trim(mnames(-i))

        WRITE (mdse,1032) mnames(-i)(1:ii)

      END IF

    END DO

    !

    ! 3.b Assign input file unit numbers

    !

    DO i=-nrinp, nrgrd

      IF ( i .EQ. 0 ) cycle

      CALL w3seti ( i, mdse, mdst )

      DO j=jfirst, 9

        IF ( i .GE. 1 ) THEN

          IF ( inpmap(i,j) .LT. 0 ) cycle

        END IF

        IF ( inflags1(j) ) THEN

          CALL wmuget ( mdse, mdst, ndsfnd, 'INP' )

          CALL wmuset ( mdse, mdst, ndsfnd, .true.,               &

               desc='Input data file' )

          mdsf(i,j) = ndsfnd

        END IF

      END DO

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9022)

    DO i=-nrinp, nrgrd

      IF ( i .EQ. 0 ) cycle

      WRITE (mdst,9021) i, mdsf(i,jfirst:9)

    END DO

#endif

    !

    ! 3.c Set rank and group data

    !

#ifdef W3_T

    WRITE (mdst,9032)

#endif

    !

    rnkmax = maxval( tmprnk(1:nrgrd) ) + 1

    rnktmp = 0

    !

    DO

      rnkmin = minval( tmprnk(1:nrgrd) )

      IF ( rnkmin .EQ. rnkmax ) EXIT

      rnktmp = rnktmp + 1

      DO i=1, nrgrd

        IF ( tmprnk(i) .EQ. rnkmin ) THEN

          grank(i)  = rnktmp

          tmprnk(i) = rnkmax

        END IF

      END DO

    END DO

    !

#ifdef W3_T

    DO i=1, nrgrd

      WRITE (mdst,9033) i, mnames(i), grank(i)

    END DO

#endif

    !

    rnkmax = rnktmp

    grpmax = maxval( tmpgrp(1:nrgrd) ) + 1

    nrgrp  = 0

    ningrp = 0

    !

    DO rnktmp=1, rnkmax

      DO

        grpmin = grpmax

        DO i=1, nrgrd

          IF ( grank(i) .EQ. rnktmp )                               &

               grpmin = min( grpmin , tmpgrp(i) )

        END DO

        IF ( grpmin .EQ. grpmax ) EXIT

        nrgrp  = nrgrp + 1

        DO i=1, nrgrd

          IF ( grank(i).EQ.rnktmp .AND. grpmin.EQ.tmpgrp(i) ) THEN

            grgrp(i)  = nrgrp

            tmpgrp(i) = grpmax

            ningrp(nrgrp) = ningrp(nrgrp) + 1

          END IF

        END DO

      END DO

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9034) nrgrp

    DO i=1, nrgrd

      WRITE (mdst,9033) i, mnames(i), grgrp(i)

    END DO

    WRITE (mdst,9035) ningrp(1:nrgrp)

#endif

    !

    ALLOCATE ( action(jfirst:11) )

    ALLOCATE ( ingrp(nrgrp,0:maxval(ningrp(:nrgrp))) )

    DEALLOCATE ( tmprnk, tmpgrp, ningrp, bcdtmp )

    ingrp = 0

    !

    DO i=1, nrgrd

      ingrp(grgrp(i),0) = ingrp(grgrp(i),0) + 1

      ingrp(grgrp(i),ingrp(grgrp(i),0)) = i

    END DO

    !

#ifdef W3_T

    WRITE (mdst,9036)

    DO j=1, nrgrp

      WRITE (mdst,9037) j, ingrp(j,:ingrp(j,0))

    END DO

#endif

    !

    !

    ! 3.d Unified point output

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.b'

    prft0  = prftn

#endif

    !

    IF ( unipts ) THEN

      !

      j      = len_trim(mnames(0))

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        WRITE (mdss,986) mnames(0)(1:j)

        WRITE (mdss,987)

      END IF

      !

      CALL w3iogr ( 'GRID', ndsrec, 0, mnames(0)(1:j) )

      !

    END IF

    !

    ! 3.e Output

    !

    IF ( nrinp .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,924)

      IF ( nmplog .EQ. improc ) WRITE (mdso,924)

      DO i=1, nrinp

        IF ( .NOT. useinp(i) ) cycle

        CALL w3seti ( -i, mdse, mdst )

        action(1:6) = '---   '

        DO j=jfirst, 6

          IF ( inflags1(j) ) action(j) = ' X    '

        END DO

        action(7:9) = '-     '

        IF ( inflags1(7) ) action(7) = '1     '

        IF ( inflags1(8) ) action(8) = '2     '

        IF ( inflags1(9) ) action(9) = '3     '

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE (mdss,925) i, mnames(-i), action(jfirst:9)

        IF ( nmplog .EQ. improc )                                 &

             WRITE (mdso,925) i, mnames(-i), action(jfirst:9)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,926)

      IF ( nmplog .EQ. improc ) WRITE (mdso,926)

    END IF

    !

    IF ( unipts ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,927)

      IF ( nmplog .EQ. improc ) WRITE (mdso,927)

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,928) mnames(0)

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,928) mnames(0)

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,929)

      IF ( nmplog .EQ. improc ) WRITE (mdso,929)

    END IF

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,930)

    IF ( nmplog .EQ. improc ) WRITE (mdso,930)

    DO i=1, nrgrd

      CALL w3seti ( i, mdse, mdst )

      action(1:6) = '---   '

      DO j=jfirst, 6

        IF ( inflags1(j) .AND. inpmap(i,j) .EQ. 0 ) THEN

          action(j) = 'native'

        ELSE IF ( inflags1(j) .AND. inpmap(i,j) .EQ. -999 ) THEN

          action(j) = 'native'

        ELSE IF ( inpmap(i,j) .GT. 0 ) THEN

          action(j) = mnames(-inpmap(i,j))

        ELSE IF ( inpmap(i,j) .LT. 0 ) THEN

          action(j) = mnames( inpmap(i,j))

        END IF

      END DO

      action(7:11) = '-     '

      IF ( inflags1(7) ) action(7) = '1     '

      IF ( inflags1(8) ) action(8) = '2     '

      IF ( inflags1(9) ) action(9) = '3     '

      IF ( inflags1(10) ) THEN

        action(10) = 'yes   '

      ELSE

        action(10) = 'no    '

      END IF

      IF ( bcdump(i) ) action(11) = 'y     '

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,931) i, mnames(i), action(1:10), grank(i),     &

           grgrp(i), action(11)

      IF ( nmplog .EQ. improc )                                     &

           WRITE (mdso,931) i, mnames(i), action(1:10), grank(i),     &

           grgrp(i), action(11)

    END DO

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,932)

    IF ( nmplog .EQ. improc ) WRITE (mdso,932)

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                      &

         WRITE (mdss,933) 'Group information'

    IF ( nmplog .EQ. improc )                                       &

         WRITE (mdso,933) 'Group information'

    DO j=1, nrgrp

      WRITE (line(1:6),'(1X,I3,2X)') j

      jjj    = 6

      DO jj=1, ingrp(j,0)

        IF ( jjj .GT. 60 ) THEN

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )              &

               WRITE (mdss,934) line(1:jjj)

          IF ( nmplog .EQ. improc ) WRITE (mdso,934) line(1:jjj)

          line(1:6) = '      '

          jjj       = 6

        END IF

        WRITE (line(jjj+1:jjj+3),'(I3)') ingrp(j,jj)

        !

        line(jjj+4:jjj+5) = ' ('

        WRITE (line(jjj+6:jjj+11),'(F6.4)') rp1(ingrp(j,jj))

        line(jjj+12:jjj+12) = '-'

        WRITE (line(jjj+13:jjj+18),'(F6.4)') rpn(ingrp(j,jj))

        line(jjj+19:jjj+19) = ')'

        jjj    = jjj + 19

        !

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,934) line(1:jjj)

      IF ( nmplog .EQ. improc ) WRITE (mdso,934) line(1:jjj)

    END DO

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

    IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    !

    ! 4.  Model run time information etc. -------------------------------- /

    !

    !     Version 3.07: Same for all grids, diversify later ....

    !     If invoked as ESMF Component, then STIME and ETIME are set

    !     in WMESMFMD from the external clock.

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,940)

    !

    IF (is_esmf_component) THEN

      READ(nml_domain%START, *) stmpt

      READ(nml_domain%STOP, *) etmpt

    ELSE

      READ(nml_domain%START, *) stime

      READ(nml_domain%STOP, *) etime

    END IF

    CALL stme21 ( stime , dtme21 )

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,941) dtme21

    CALL stme21 ( etime , dtme21 )

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,942) dtme21

    !

    DO i=1, nrgrd

      CALL w3setw ( i, mdse, mdst )

      time   = stime

    END DO

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,943)

    !

    flghg1 = nml_domain%FLGHG1

    flghg2 = nml_domain%FLGHG2

    flghg2 = flghg1 .AND. flghg2

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      IF ( flghg1 ) THEN

        WRITE (mdss,944) yesxx

      ELSE

        WRITE (mdss,944) xxxno

      END IF

      IF ( flghg2 ) THEN

        WRITE (mdss,945) yesxx

      ELSE

        WRITE (mdss,945) xxxno

      END IF

    END IF

    !

    ! 5.  Output requests ------------------------------------------------ /

    !

    ot2(:)%NPTS = 0

    iloop = 0

    !

    ! 5.a Loop over types

    !

    DO i=1, nrgrd

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,950) trim(mnames(nrgrd+i))

      notype = 8

      ! OTYPE 1

      READ(nml_output_date(i)%FIELD%START, *)   odat(1,i), odat(2,i)

      READ(nml_output_date(i)%FIELD%STRIDE, *)  odat(3,i)

      READ(nml_output_date(i)%FIELD%STOP, *)    odat(4,i), odat(5,i)

      READ(nml_output_date(i)%FIELD%OUTFFILE, *)  outff(1,i)

      ! OTYPE 2

      READ(nml_output_date(i)%POINT%START, *)   odat(6,i), odat(7,i)

      READ(nml_output_date(i)%POINT%STRIDE, *)  odat(8,i)

      READ(nml_output_date(i)%POINT%STOP, *)    odat(9,i), odat(10,i)

      READ(nml_output_date(i)%POINT%OUTFFILE, *)  outff(2,i)

      ! OTYPE 3

      READ(nml_output_date(i)%TRACK%START, *)   odat(11,i), odat(12,i)

      READ(nml_output_date(i)%TRACK%STRIDE, *)  odat(13,i)

      READ(nml_output_date(i)%TRACK%STOP, *)    odat(14,i), odat(15,i)

      ! OTYPE 4

      READ(nml_output_date(i)%RESTART%START, *)   odat(16,i), odat(17,i)

      READ(nml_output_date(i)%RESTART%STRIDE, *)  odat(18,i)

      READ(nml_output_date(i)%RESTART%STOP, *)    odat(19,i), odat(20,i)

      !OTYPE 5

      READ(nml_output_date(i)%BOUNDARY%START, *)   odat(21,i), odat(22,i)

      READ(nml_output_date(i)%BOUNDARY%STRIDE, *)  odat(23,i)

      READ(nml_output_date(i)%BOUNDARY%STOP, *)    odat(24,i), odat(25,i)

      !OTYPE 6

      READ(nml_output_date(i)%PARTITION%START, *)   odat(26,i), odat(27,i)

      READ(nml_output_date(i)%PARTITION%STRIDE, *)  odat(28,i)

      READ(nml_output_date(i)%PARTITION%STOP, *)    odat(29,i), odat(30,i)

      !OTYPE 7

      ! for coupling but not implemented yet

      !OTYPE 8

      READ(nml_output_date(i)%RESTART2%START, *)   odat(36,i), odat(37,i)

      READ(nml_output_date(i)%RESTART2%STRIDE, *)  odat(38,i)

      READ(nml_output_date(i)%RESTART2%STOP, *)    odat(39,i), odat(40,i)


      ! set the time stride at 0 or more

      odat(3,i) = max( 0 , odat(3,i) )

      odat(8,i) = max( 0 , odat(8,i) )

      odat(13,i) = max( 0 , odat(13,i) )

      odat(18,i) = max( 0 , odat(18,i) )

      odat(23,i) = max( 0 , odat(23,i) )

      odat(28,i) = max( 0 , odat(28,i) )

      odat(38,i) = max( 0 , odat(38,i) )


      ! define the time of the output point grid (index 0) as the   &

      ! time of the first grid which should be the larger one by convention

      odat(6:10,0) = odat(6:10,1)


      ! allocate pointers to minimum value if no output point

      IF ( odat(8,i) .EQ. 0 ) THEN

        ALLOCATE ( ot2(i)%X(1), ot2(i)%Y(1), ot2(i)%PNAMES(1) )

      END IF


      DO j=1, notype

        !

        ! 5.b Process standard line

        !

        outpts(i)%OFILES(j)=outff(j,i)

        IF ( odat(5*(j-1)+3,i) .NE. 0 ) THEN

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

               WRITE (mdss,951) j, idotyp(j)

          ttime(1) = odat(5*(j-1)+1,i)

          ttime(2) = odat(5*(j-1)+2,i)

          CALL stme21 ( ttime , dtme21 )

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

               WRITE (mdss,952) dtme21

          ttime(1) = odat(5*(j-1)+4,i)

          ttime(2) = odat(5*(j-1)+5,i)

          CALL stme21 ( ttime , dtme21 )

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

               WRITE (mdss,953) dtme21

          ttime(1) = 0

          ttime(2) = 0

          dttst    = real( odat(5*(j-1)+3,i) )

          CALL tick21 ( ttime , dttst  )

          CALL stme21 ( ttime , dtme21 )

          IF ( ( odat(5*(j-1)+1,i) .NE. odat(5*(j-1)+4,i) .OR.      &

               odat(5*(j-1)+2,i) .NE. odat(5*(j-1)+5,i) ) .AND.   &

               mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

            DO ii=1, 18

              IF ( dtme21(ii:ii).NE.'0' .AND.                     &

                   dtme21(ii:ii).NE.'/' .AND.                     &

                   dtme21(ii:ii).NE.' ' .AND.                     &

                   dtme21(ii:ii).NE.':' ) EXIT

              dtme21(ii:ii) = ' '

            END DO

            WRITE (mdss,954) dtme21(1:19)

          END IF

          !

          IF ( j .EQ. 1 ) THEN

            !

            ! 5.c Type 1: fields of mean wave parameters

            !

            flgrd(:,:,i)=.false. ! Initialize FLGRD

            fldout = nml_output_type(i)%FIELD%LIST

            CALL w3flgrdflag ( mdss, mdso, mdse2, fldout, flg1d,       &

                 flg2d, improc, nmpscr, ierr )

            flgrd(:,:,i)=flg2d

            flgd(:,i)   =flg1d

            !

          ELSE IF ( j .EQ. 2 ) THEN

            !

            ! 5.d Type 2: point output

            !

            ! if the output is 0, the output is disabled

            IF (unipts) THEN

              IF ( odat(8,0).EQ.0 .AND. improc.EQ.nmperr ) WRITE (mdse,1050)

              IF ( odat(8,0).EQ.0 ) unipts = .false.

            END IF


            ! if the point file is not set

            IF ( trim(nml_output_type(i)%POINT%FILE).EQ.'unset' ) THEN

              ! and if output also disabled, cycle to the next output type J

              IF ( odat(8,i).EQ.0 ) THEN

                ALLOCATE ( ot2(i)%X(1), ot2(i)%Y(1), ot2(i)%PNAMES(1) )

                cycle

                ! and if output still enabled, stop

              ELSE

                GOTO 2055

              END IF

            END IF


            ! if the unified point is already defined, cycle to the next output type J

            IF ( unipts .AND. iloop.NE.0 ) cycle

            !

            IF ( unipts .AND. i.GE.2 ) THEN

              DO k=1,i-1

                IF ( nml_output_type(k)%POINT%FILE.NE.nml_output_type(i)%POINT%FILE ) GOTO 2053

              END DO

            END IF

            OPEN (mdsi, file=trim(fnmpre)//trim(nml_output_type(i)%POINT%FILE), &

                 form='FORMATTED', status='OLD', err=2104, iostat=ierr)


            ! first loop to count the number of points

            ! second loop to allocate the array and store the points

            ot2(i)%NPTS = 0

            DO iloop=1,2

              rewind(mdsi)

              !

              IF ( iloop.EQ.2) THEN

                IF ( ot2(i)%NPTS.GT.0 ) THEN

                  ALLOCATE ( ot2(i)%X(ot2(i)%NPTS),               &

                       ot2(i)%Y(ot2(i)%NPTS),               &

                       ot2(i)%PNAMES(ot2(i)%NPTS) )

                  ot2(i)%NPTS = 0  ! reset it to use it as a counter for loop 2

                ELSE

                  ALLOCATE ( ot2(i)%X(1), ot2(i)%Y(1), ot2(i)%PNAMES(1) )

                  GOTO 2054

                END IF

              END IF

              !

              DO

                READ (mdsi,*,err=2004,iostat=ierr) tmpline

                ! if end of file or stopstring, then exit

                IF ( ierr.NE.0 .OR. index(tmpline,"STOPSTRING").NE.0 ) EXIT

                ! leading blanks removed and placed on the right

                test = adjustl( tmpline )

                IF ( test(1:1).EQ.comstr .OR. len_trim(test).EQ.0 ) THEN

                  ! if comment or blank line, then skip

                  cycle

                ELSE

                  ! otherwise, backup to beginning of line

                  backspace( mdsi, err=2004, iostat=ierr)

                  READ (mdsi,*,err=2004,iostat=ierr) xx, yy, pn

                ENDIF

                ot2(i)%NPTS = ot2(i)%NPTS + 1

                IF ( iloop .EQ. 1 ) cycle

                IF ( iloop .EQ. 2 ) THEN

                  ot2(i)%X(ot2(i)%NPTS)      = xx

                  ot2(i)%Y(ot2(i)%NPTS)      = yy

                  ot2(i)%PNAMES(ot2(i)%NPTS) = pn

                  IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

                    IF ( ot2(i)%NPTS .EQ. 1 ) THEN

                      WRITE (mdss,957)              xx, yy, pn

                    ELSE

                      WRITE (mdss,958) ot2(i)%NPTS, xx, yy, pn

                    END IF

                  END IF

                END IF ! ILOOP.EQ.2

              END DO ! end of file

            END DO ! ILOOP

            CLOSE(mdsi)

            !

            IF ( unipts .AND. ot2(0)%NPTS.EQ.0 .AND. ot2(i)%NPTS.GT.0 ) THEN

              ! copy points to point grid number 0

              ot2(0)%NPTS = ot2(i)%NPTS

              ALLOCATE (ot2(0)%X(ot2(0)%NPTS), ot2(0)%Y(ot2(0)%NPTS), ot2(0)%PNAMES(ot2(0)%NPTS))

              ot2(0)%X(:)      = ot2(i)%X(:)

              ot2(0)%Y(:)      = ot2(i)%Y(:)

              ot2(0)%PNAMES(:) = ot2(i)%PNAMES(:)

              ! define all the other grids to empty output point

              DO k=1, nrgrd

                ot2(k)%NPTS = 0

                ALLOCATE (ot2(k)%X(1),ot2(k)%Y(1),ot2(k)%PNAMES(1))

              END DO

            END IF

            !

          ELSE IF ( j .EQ. 3 ) THEN

            !

            ! 5.e Type 3: track output

            !

            tflagi = nml_output_type(i)%TRACK%FORMAT

            IF ( tflagi ) THEN

              mds(11,i) =  abs(mds(11,i))

            ELSE

              mds(11,i) = -abs(mds(11,i))

            END IF

            IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

              IF ( .NOT. tflagi ) THEN

                WRITE (mdss,960) 'input', 'UNFORMATTED'

              ELSE

                WRITE (mdss,960) 'input', 'FORMATTED'

              END IF

            END IF

            !

          ELSE IF ( j .EQ. 4 ) THEN

            !

            ! 5.f Type 4: restart files (no additional data)

            !

          ELSE IF ( j .EQ. 5 ) THEN

            !

            ! 5.g Type 5: nesting data (no additional data)

            !

          ELSE IF ( j .EQ. 6 ) THEN

            !

            ! 5.h Type 6: partitioned wave field data

            !

            iprt(1,i) = nml_output_type(i)%PARTITION%X0

            iprt(2,i) = nml_output_type(i)%PARTITION%XN

            iprt(3,i) = nml_output_type(i)%PARTITION%NX

            iprt(4,i) = nml_output_type(i)%PARTITION%Y0

            iprt(5,i) = nml_output_type(i)%PARTITION%YN

            iprt(6,i) = nml_output_type(i)%PARTITION%NY

            lprt(i) = nml_output_type(i)%PARTITION%FORMAT

            IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

              WRITE (mdss,961) iprt(:,i)

              IF ( .NOT. lprt(i) ) THEN

                WRITE (mdss,960) 'output', 'UNFORMATTED'

              ELSE

                WRITE (mdss,960) 'output', 'FORMATTED'

              END IF

            END IF

            !

            ! ... End of output type selecttion ELSE IF

            !

          ELSE IF ( j .EQ. 8 ) THEN

            !

            ! 5.i Type 8: checkpoint files (no additional data)

            !

          END IF

          !

          ! ... End of IF in 5.b

          !

        END IF

        !

        ! ... End of loop J on NOTYPE in 5.a

        !

      END DO

      !

      ! ... End of loop I on NRGRD in 5.a

      !

    END DO

    !

#ifdef W3_T

    DO i=1, nrgrd

      WRITE (mdst,9050) i

      WRITE (mdst,9053) odat(:,i)

      WRITE (mdst,9052) flgrd(:,:,i)

    END DO

#endif

    !

    ! 6.  Read moving grid data ------------------------------------------ /

    !

    !     Only a single set of data are provided to be applied to all

    !     the grids, because this is only intended for test cases.

    !     For true implementations, the jumping grid will be used.

    !

    IF ( inflags1(10) ) THEN

      !

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

        WRITE (mdss,965)

        WRITE (mdss,966) 'Continuous grid movement data'

      END IF

      !

      n_mov  = nml_homog_count%N_MOV

      n_tot = nml_homog_count%N_TOT


      IF ( n_mov .EQ. 0 ) GOTO 2060

      IF ( n_mov .GT. 99 ) GOTO 2061


      ALLOCATE ( tmove(2,n_mov), amove(n_mov), dmove(n_mov) )

      !

      DO i=1,n_tot

        READ(nml_homog_input(i)%NAME,*) idtst

        SELECT CASE (idtst)

        CASE ('MOV')

          READ(nml_homog_input(i)%DATE,*) tmove(:,i)

          amove(i) = nml_homog_input(i)%VALUE1

          dmove(i) = nml_homog_input(i)%VALUE2

          IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )             &

               WRITE (mdss,968) i, tmove(:,i), amove(i), dmove(i)

        CASE DEFAULT

          GOTO 2062

        END SELECT

      END DO

      !

      nmvmax = n_mov

      DO i=1, nrgrd

        CALL w3setg ( i, mdse, mdst )

        CALL wmsetm ( i, mdse, mdst )

        nmv    = n_mov

        CALL wmdimd ( i, mdse, mdst, 0 )

        DO ii=1, nmv

          tmv(:,4,ii) = tmove(:,ii)

          amv(ii,4)   = amove(ii)

          dmv(ii,4)   = dmove(ii)

        END DO

      END DO

      !

    END IF

    !

    ! 7.  Work load distribution ----------------------------------------- /

    ! 7.a Initialize arrays

    !

    !     *******************************************************

    !     *** NOTE : OUTPUT PROCESSOR ASSIGNMENT NEEDS TO BE  ***

    !     ***        CONSISTENT WITH ASSIGNMENT IN W3INIT.    ***

    !     *******************************************************

    !

    ALLOCATE ( allprc(nmproc,nrgrd) , modmap(nmproc,nrgrp) ,        &

         loadmp(nmproc,nrgrp) )

    !

    allprc = 0

    modmap = 0

    loadmp = 0

    !

    ! 7.b Determine number of output processors

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,970)

    !

    ncproc = nmproc

    upproc = upproc .AND. unipts .AND. iostyp.GT.1

    !

    ! 7.b.1 Unified point output

    !

    IF ( unipts ) THEN

      IF ( nmproc.GE.10 .AND. upproc ) THEN

        ncproc = nmproc - 1

      ELSE

        IF ( upproc .AND. mdss.NE.mdso .AND. nmpscr.EQ.improc ) &

             WRITE (mdss,971) 'Separate process for point' //    &

             ' output disabled.'

        upproc = .false.

      END IF

      IF ( nmpupt .EQ. improc ) THEN

        ii     = len_trim(mnames(0))

        CALL wmuget ( mdss, mdst, mdsup, 'OUT' )

        CALL wmuset ( mdss, mdst, mdsup, .true., 'OUT',         &

             trim(fnmpre)//'out_pnt.'//mnames(0)(1:ii),  &

             'Unified point output')

#ifdef W3_ASCII

        CALL wmuget ( mdss, mdst, mdsupa, 'OUA' )

        CALL wmuset ( mdss, mdst, mdsupa, .true., 'OUA',         &

             trim(fnmpre)//'out_pnt.'//mnames(0)(1:ii)//'.txt',  &

             'Unified point output ascii')

#endif

      END IF

    END IF

    !

    IF ( upproc .AND. mdss.NE.mdso .AND. nmpscr.EQ.improc )         &

         WRITE (mdss,972) nmpupt

    !

    ! 7.b.2 Other output

    !

    ALLOCATE ( ndpout(nrgrd) )

    ndpout = 0

    !

    IF ( iostyp .GT. 1 ) THEN

      DO i=1, nrgrd

        ! FIELD

        IF ( odat( 3,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        ! TRACK

        IF ( odat(13,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        ! PARTITION

        IF ( odat(28,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        ! POINT .OR. RESTART .OR. BOUNDARY

        IF ( odat( 8,i) .GT. 0 .OR.  odat(18,i) .GT. 0 .OR.       &

             odat(23,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        ! RESTART2

        IF ( odat(38,i) .GT. 0 ) ndpout(i) = ndpout(i) + 1

        IF ( iostyp .EQ. 2 ) ndpout(i) = min( 1 , ndpout(i) )

      END DO

    END IF

    !

    ! ..... Reduce IOSTYP if not enough resources to run IOSTYP = 3

    !

    IF ( iostyp.EQ.3 .AND.                                          &

         ( ( .NOT.pshare .AND. 4*sum(ndpout).GT.ncproc )          &

         .OR.( pshare .AND. 4*maxval(ndpout).GT.ncproc ) ) ) THEN

      DO i=1, nrgrd

        ndpout(i) = min( 1 , ndpout(i) )

      END DO

      iostyp = 2

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,971) 'Separate processes for output' //     &

           ' types disabled.'

    END IF

    !

    ! ..... Force sharing of output processes if not enough resources

    !

    IF ( iostyp.GT.1 .AND. .NOT.pshare .AND.                        &

         4*sum(ndpout).GT.ncproc ) THEN

      pshare = .true.

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,971) 'Grids sharing output processes.'

    END IF

    !

    ! ..... Disable output processes if not enough resources

    !

    IF ( iostyp.GT.1 .AND. 4*maxval(ndpout).GT.ncproc ) THEN

      ndpout = 0

      iostyp = 1

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,971) 'Separate processes for output' //     &

           ' disabled.'

    END IF

    !

    ! ..... Number of output processes (except for unified point output)

    !

    npoutt = 0

    IF ( iostyp .GT. 1 ) THEN

      IF ( pshare ) THEN

        npoutt = maxval(ndpout)

      ELSE

        npoutt = sum(ndpout)

      END IF

    END IF

    ncproc = ncproc - npoutt

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      IF ( npoutt .EQ. 0 ) THEN

        WRITE (mdss,971) 'No (other) dedicated output processes.'

      ELSE

        WRITE (mdss,973) ncproc+1, ncproc+npoutt, npoutt

      END IF

    END IF

    !

    ! 7.c Set communicators and ALLPRC array

    !

#ifdef W3_T

    WRITE (mdst,9070)

#endif

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,974)

    IF ( nmplog.EQ.improc ) WRITE (mdso,1974)

    !

#ifdef W3_MPI

    CALL mpi_comm_group ( mpi_comm_mwave, bgroup, ierr_mpi )

#endif

    ALLOCATE ( tmprnk(nmproc) )

    napres = ncproc

    !

    DO i=1, nrgrd

      !

      ip1    = max( 1 , min( ncproc , 1+nint(real(ncproc)*rp1(i)) ) )

      ipn    = max( ip1 , min( ncproc , nint(real(ncproc)*rpn(i)) ) )

      outstr = '-----'

      !

      CALL wmsetm ( i, mdse, mdst )

      naploc = 1 + ipn - ip1

      napadd = naploc

#ifdef W3_MPI

      croot  = ip1

      fbcast = naploc .NE. ncproc

      fbcast = naploc .NE. ncproc .OR.                         &

           ( iostyp.GT.1 .AND. .NOT.pshare )

#endif

      DO j=ip1, ipn

        tmprnk(1+j-ip1) = j - 1

      END DO

      !

      IF ( iostyp .GT. 1 ) THEN

        IF ( pshare ) napres = ncproc

        DO j=1, ndpout(i)

          napadd = napadd + 1

          tmprnk(napadd) = napres

          napres = napres + 1

        END DO

      END IF

      !

      IF ( upproc ) THEN

        napadd = napadd + 1

        tmprnk(napadd) = nmproc - 1

      END IF

      !

#ifdef W3_MPI

      CALL mpi_group_incl ( bgroup, napadd, tmprnk, lgroup,    &

           ierr_mpi )

      CALL mpi_comm_create ( mpi_comm_mwave, lgroup,           &

           mpi_comm_grd, ierr_mpi )

      CALL mpi_group_free ( lgroup, ierr_mpi )

#endif

      !

      DO ii=ip1, ipn

        allprc(ii,i) = 1 + ii - ip1

      END DO

      ii     = ii - ip1

      !

      IF ( pshare .OR. i.EQ.1 ) THEN

        napadd = ncproc

      ELSE

        napadd = ncproc + sum(ndpout(1:i-1))

      END IF

      IF ( iostyp .GT. 1 ) THEN

        DO j=1, ndpout(i)

          napadd = napadd + 1

          ii     = ii + 1

          allprc(napadd,i) = ii

        END DO

      END IF

      !

      IF ( upproc ) THEN

        ii     = ii + 1

        allprc(nmproc,i) = ii

      END IF

      !

#ifdef W3_T

      WRITE (mdst,9071) i, allprc(:,i)

#endif

      !

      ! ... output

      !

      !

      IF ( iostyp .LE. 1 ) THEN

        !

        IF ( odat( 3,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-1))+1

          outstr(1) = stout

        END IF

        IF ( odat( 8,i) .GT. 0 .OR. unipts ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-2))+1

          outstr(2) = stout

        END IF

        IF ( odat(13,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-5))+1

          outstr(3) = stout

        END IF

        IF ( odat(18,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(naploc)+1

          outstr(4) = stout

        END IF

        IF ( odat(23,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-3))+1

          outstr(5) = stout

        END IF

        IF ( odat(28,i) .GT. 0 ) THEN

          WRITE (stout,'(I5.5)') tmprnk(max(1,naploc-4))+1

          outstr(6) = stout

        END IF

        !

      ELSE

        !

        ! set last proc for point and disable point for the grid

        IF ( unipts ) THEN

          WRITE (stout,'(I5.5)') tmprnk(ii) + 1

          outstr(2) = stout

          odat(8,i) = 0

          IF ( upproc ) ii = ii - 1

        END IF

        !

        IF ( iostyp .EQ. 2 ) THEN

          !

          WRITE (stout,'(I5.5)') tmprnk(ii) + 1

          IF ( odat( 3,i) .GT. 0 ) outstr(1) = stout

          IF ( odat( 8,i) .GT. 0 .OR.                           &

               ( unipts .AND. .NOT.upproc ) )    &

               outstr(2) = stout

          IF ( odat(13,i) .GT. 0 ) outstr(3) = stout

          IF ( odat(18,i) .GT. 0 ) outstr(4) = stout

          IF ( odat(23,i) .GT. 0 ) outstr(5) = stout

          IF ( odat(28,i) .GT. 0 ) outstr(6) = stout

          !

        ELSE IF ( iostyp .EQ. 3 ) THEN

          !

          IF ( odat( 3,i).GT.0 ) THEN

            WRITE (stout,'(I5.5)') tmprnk(ii) + 1

            outstr(1) = stout

            ii        = ii - 1

          END IF

          IF ( odat(13,i).GT.0 ) THEN

            WRITE (stout,'(I5.5)') tmprnk(ii) + 1

            outstr(3) = stout

            ii        = ii - 1

          END IF

          IF ( odat(28,i).GT.0 ) THEN

            WRITE (stout,'(I5.5)') tmprnk(ii) + 1

            outstr(6) = stout

            ii        = ii - 1

          END IF

          WRITE (stout,'(I5.5)') tmprnk(ii) + 1

          IF ( odat( 8,i) .GT. 0 ) outstr(2) = stout

          IF ( odat(18,i) .GT. 0 ) outstr(4) = stout

          IF ( odat(23,i) .GT. 0 ) outstr(5) = stout

          !

        END IF

        !

      END IF

      !

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                    &

           WRITE (mdss,975) mnames(i), ip1, ipn, outstr

      IF ( nmplog .EQ. improc )                                     &

           WRITE (mdso,1975)mnames(i), ip1, ipn, outstr

      !

#ifdef W3_MPI

      IF ( fbcast ) THEN

        tmprnk(1) = ip1 - 1

        napbct    = 1

        DO j=1, nmproc

          IF ( allprc(j,i) .EQ. 0 ) THEN

            napbct = napbct + 1

            tmprnk(napbct) = j - 1

          END IF

        END DO

        CALL mpi_group_incl ( bgroup, napbct, tmprnk,       &

             lgroup, ierr_mpi )

        CALL mpi_comm_create ( mpi_comm_mwave, lgroup,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_group_free ( lgroup, ierr_mpi )

      END IF

#endif

      !

    END DO

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) THEN

      WRITE (mdss,976)

      IF ( unipts ) WRITE (mdss,977) nmpupt

      WRITE (mdss,*)

    END IF

    !

    IF ( nmplog .EQ. improc ) THEN

      WRITE (mdso,1976)

      IF ( unipts ) WRITE (mdso,1977) nmpupt

      WRITE (mdso,*)

    END IF

    !

    DEALLOCATE ( tmprnk, ndpout )

    !

    ! 7.d Set MODMAP and LOADMP arrays

    !

    DO jj=1, nrgrp

      DO ii=1, ingrp(jj,0)

        i      = ingrp(jj,ii)

        DO j=1, nmproc

          IF ( allprc(j,i) .NE. 0 ) THEN

            loadmp(j,jj) = loadmp(j,jj) + 1

            IF ( loadmp(j,jj) .EQ. 1 ) THEN

              modmap(j,jj) = i

            ELSE

              modmap(j,jj) = -1

            END IF

          END IF

        END DO

      END DO

    END DO

    !

#ifdef W3_T

    WRITE (mdst,8042)

    DO j=1, nrgrp

      WRITE (mdst,8044) j, modmap(:,j)

    END DO

    WRITE (mdst,8043)

    DO j=1, nrgrp

      WRITE (mdst,8044) j, loadmp(:,j)

    END DO

#endif

    !

    ! 7.e Warnings

    !

    IF ( nmproc .GT. 1 ) THEN

      DO i=1, nrgrp

        ip1    = minval( loadmp(:ncproc,i) )

        ipn    = maxval( loadmp(:ncproc,i) )

        IF ( ip1.NE.ipn .AND. improc.EQ.nmperr )                  &

             WRITE (mdse,1040) i, ip1, ipn

      END DO

    END IF

    !

    DEALLOCATE ( rp1, rpn, loadmp )

    !

    ! 7.f Reset NMPSCR to first processor of first rank 1 grid

    !

#ifdef W3_MPI

    CALL wmsetm ( ingrp(1,1), mdse, mdst )

    nmpscr = croot

#endif

    !

#ifdef W3_MPI

    CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

    !

    ! 8.  Actual initializations ----------------------------------------- /

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8'

    prft0  = prftn

#endif

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,980)

    ALLOCATE ( tsync(2,0:nrgrd), tmax(2,nrgrd), toutp(2,0:nrgrd),   &

         tdata(2,nrgrd), grstat(nrgrd), dtres(nrgrd) )

    !

    tsync(1,:) = -1

    tsync(2,:) =  0

    tmax(1,:) = -1

    tmax(2,:) =  0

    toutp(1,:) = -1

    toutp(2,:) =  0

    tdata(1,:) = -1

    tdata(2,:) =  0

    grstat     = 99

    !

    ! 8.a Loop over models for per-model initialization

    !

#ifdef W3_T

    WRITE (mdst,9080)

#endif

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.a'

    prft0  = prftn

#endif

    !

    DO i=1, nrgrd

      j      = len_trim(mnames(i))

      DO nmpsc2=1, nmproc

        IF ( allprc(nmpsc2,i) .EQ. 1 ) EXIT

      END DO

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )                    &

           WRITE (mdss,981) i, mnames(i)(1:j)

      !

#ifdef W3_MPI

      CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

      !

      ! 8.a.1 Wave model initialization (NOTE: sets all grid pointers)

      ! ..... Initial output file hook up

      !

      CALL wmsetm ( i, mdse, mdst )

#ifdef W3_MPI

      mpi_comm_loc = mpi_comm_grd

      IF ( mpi_comm_loc .EQ. mpi_comm_null ) cycle

#endif

      !

      CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

      CALL wmuset ( mdse, mdst, ndsfnd, .true., desc='Log file' )

      mds( 1,i) = ndsfnd

      !

      ! ... this one overwrites the combined setting MDS( 3,I) = MDST above

      !

      !       CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' )

      !       CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., DESC='Test output' )

      !       MDS( 3,I) = NDSFND

      !

      DO j=1, 6

        IF ( j.EQ.4 .OR. j.EQ.5 ) cycle

        IF ( odat(5*(j-1)+3,i) .GT. 0 ) THEN

          CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

          CALL wmuset ( mdse, mdst, ndsfnd, .true.,              &

               desc='Raw output file' )

          SELECT CASE (j)

          CASE (1)

            mds(7,i) = ndsfnd

#ifdef W3_ASCII

            CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

            CALL wmuset ( mdse, mdst, ndsfnd, .true.,            &

                 desc='ASCII output file' )

            mds(14,i) = ndsfnd  ! ASCII

#endif

          CASE (2)

            mds(8,i) = ndsfnd

#ifdef W3_ASCII

            CALL wmuget ( mdse, mdst, ndsfnd, 'OUT' )

            CALL wmuset ( mdse, mdst, ndsfnd, .true.,            &

                 desc='ASCII output file' )

            mds(15,i) = ndsfnd  ! ASCII

#endif

          CASE (3)

            mds(12,i) = ndsfnd

            CALL wmuget ( mdse, mdst, ndsfnd, 'INP' )

            CALL wmuset ( mdse, mdst, ndsfnd, .true.,           &

                 desc='Input data file' )

            mds(11,i) = ndsfnd

          CASE (6)

            mds(13,i) = ndsfnd

          END SELECT

        END IF

      END DO

      !

      CALL wmuget ( mdse, mdst, ndsfnd, 'INP' )

      CALL wmuset ( mdse, mdst, ndsfnd, .true.,                     &

           desc='Input data file' )

      mds(9,i) = ndsfnd

      !

      IF ( odat(5*(5-1)+3,i) .GT. 0 ) THEN

        CALL wmuget ( mdse, mdst, ndsfnd, 'OUT', 9 )

        mds(10,i) = ndsfnd

        DO ii=0, 8

          CALL wmuset ( mdse, mdst, ndsfnd+ii, .true.,            &

               desc='Raw output file' )

        END DO

      END IF

      !

      ! ..... Model initialization

      !

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,982)


      CALL w3init ( i, .true., mnames(i), mds(:,i), ntrace(:,i),    &

           odat(:,i),                          &

           flgrd(:,:,i),flgr2(:,:,i),flgd(:,i),flg2(:,i),  &

           ot2(i)%NPTS, ot2(i)%X, ot2(i)%Y, ot2(i)%PNAMES, &

           iprt(:,i), lprt(i), mpi_comm_loc)

      !

      ! ..... Finalize I/O file hook up

      !

      ii     = len_trim(filext)

      jj     = len_trim(fnmpre)

      CALL wmuinq ( mdse, mdst, mds(1,i) )

      IF ( mds(3,i) .NE. mdst ) CALL wmuinq ( mdse, mdst, mds(3,i) )

      !

      IF ( mds(7,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. napfld ) THEN

          tname  = trim(fnmpre)//'out_grd.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(7,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(7,i), .false. )

          mds(7,i) = -1

        END IF

      END IF

      !

      IF ( mds(8,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. nappnt ) THEN

          tname  = trim(fnmpre)//'out_pnt.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(8,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(8,i), .false. )

          mds(8,i) = -1

        END IF

      END IF

      !

      IF ( mds(9,i) .NE. -1 ) THEN

        IF ( flbpi ) THEN

          tname  = trim(fnmpre)//'nest.' // filext(:ii)

          CALL wmuset ( mdse, mdst, mds(9,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse, mdst, mds(9,i), .false. )

          mds(9,i) = -1

        END IF

      END IF

      !

      IF ( mds(10,i) .NE. -1 ) THEN

        IF ( flbpo .AND. iaproc.EQ.napbpt ) THEN

          tname  = trim(fnmpre)//'nestN.' // filext(:ii)

          DO j=0, nfbpo-1

            WRITE (tname(jj+5:jj+5),'(I1)') j + 1

            CALL wmuset ( mdse, mdst, mds(10,i)+j, .true.,      &

                 name=tname )

          END DO

          DO j=nfbpo, 8

            CALL wmuset ( mdse,mdst, mds(10,i)+j, .false. )

          END DO

        ELSE

          DO j=0, 8

            CALL wmuset ( mdse,mdst, mds(10,i)+j, .false. )

          END DO

          mds(10,i) = -1

        END IF

      END IF

      !

      IF ( mds(11,i) .NE. -1 ) THEN

        tname  = trim(fnmpre)//'track_i.' // filext(:ii)

        CALL wmuset ( mdse,mdst, mds(11,i), .true., name=tname )

      END IF

      !

      IF ( mds(12,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. naptrk ) THEN

          tname  = trim(fnmpre)//'track_o.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(12,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(12,i), .false. )

          mds(12,i) = -1

        END IF

      END IF

      !

      IF ( mds(13,i) .NE. -1 ) THEN

        IF ( iaproc .EQ. napprt ) THEN

          tname  = trim(fnmpre)//'partition.' // filext(:ii)

          CALL wmuset ( mdse,mdst, mds(13,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(13,i), .false. )

          mds(13,i) = -1

        END IF

      END IF

      !

#ifdef W3_ASCII

      IF ( mds(14,i) .NE. -1 ) THEN ! Grid output (ASCII)

        IF ( iaproc .EQ. napfld ) THEN

          tname  = trim(fnmpre)//'out_grd.' // filext(:ii) // '.txt'

          CALL wmuset ( mdse,mdst, mds(14,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(14,i), .false. )

          mds(14,i) = -1

        END IF

      END IF

      !

      IF ( mds(15,i) .NE. -1 ) THEN ! Point output (ASCII)

        IF ( iaproc .EQ. nappnt ) THEN

          tname  = trim(fnmpre)//'out_pnt.' // filext(:ii) // '.txt'

          CALL wmuset ( mdse,mdst, mds(15,i), .true., name=tname )

        ELSE

          CALL wmuset ( mdse,mdst, mds(15,i), .false. )

          mds(15,i) = -1

        END IF

      END IF

#endif

!

#ifdef W3_T

      WRITE (mdst,9081) i, time

#endif

      !

      ! 8.a.2 Data file initialization (forcing)

      !

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,983)

      CALL w3seti ( i, mdse, mdst )

      !

      !!Li  Stop modifying GTYPE from input forcing file.  JGLi08Apr2021.

      jjj = gtype

      !

      ! ..... regular input files

      !

      DO j=jfirst, 6

        IF ( inflags1(j) ) THEN

          idinp(i,j) = idstr(j)

          IF ( inpmap(i,j) .LT. 0 ) cycle

          CALL w3fldo ('READ', idinp(i,j), mdsf(i,j), mdst, mdse2,&

               !!Li     NX, NY, GTYPE, IERR, MNAMES(I),           &

               nx, ny,   jjj, ierr, mnames(i),           &

               trim(fnmpre) )

          IF ( ierr .NE. 0 ) GOTO 2080

          !

          !!Li   Print a warning message when GTYPE not matching forcing field one.

          IF ( (jjj .NE. gtype) .AND. (improc .EQ. nmpsc2) )       &

               WRITE (mdse, *) ' *** Warning: grid', i, ' GTYPE=',  &

               gtype, ' not matching field', j, ' grid type', jjj

          !

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,985) idflds(j)

        ELSE

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,984) idflds(j)

        END IF

      END DO

      !

      ! ..... assimilation data files

      !

      !       version 3.07: Data assimilation part ignored for now ....

      !

      ! ..... finalize file info data base

      !

      DO j=jfirst, 9

        IF ( mdsf(i,j) .NE. -1 ) CALL wmuinq ( mdse, mdst, mdsf(i,j) )

      END DO

      !

      ! ..... Adjust input flags for other than native or CPL input,

      !       and initialize input arrays one set at a time as needed.

      !

      IF ( SIZE(inflags1) .NE. SIZE(tflags) ) THEN

        WRITE (mdse,'(/2A)') ' *** ERROR WMINITNML: ', &

             .NE.'SIZE(INFLAGS1)SIZE(TFLAGS) ***'

        CALL extcde ( 999 )

      END IF

      IF ( SIZE(inflags2) .NE. SIZE(tflags) ) THEN

        WRITE (mdse,'(/2A)') ' *** ERROR WMINITNML: ', &

             .NE.'SIZE(INFLAGS2)SIZE(TFLAGS) ***'

        CALL extcde ( 999 )

      END IF


      tflags = inflags1

      !

      DO j=jfirst, 9

        IF ( inpmap(i,j) .NE. 0 ) THEN

          !

          tflags(j) = .true.

          inflags1     = .false.

          inflags1(j)  = .true.

          iinit     = .false.

          CALL w3dimi ( i, mdse, mdst )

          !

          IF ( j.EQ.2 ) ALLOCATE ( wadats(i)%CA0(nsea) ,          &

               wadats(i)%CAI(nsea) ,          &

               wadats(i)%CD0(nsea) ,          &

               wadats(i)%CDI(nsea) )

          !

          IF ( j.EQ.3 ) ALLOCATE ( wadats(i)%UA0(nsea) ,          &

               wadats(i)%UAI(nsea) ,          &

               wadats(i)%UD0(nsea) ,          &

               wadats(i)%UDI(nsea) ,          &

               wadats(i)%AS0(nsea) ,          &

               wadats(i)%ASI(nsea) )

          !

          IF ( j.EQ.5 ) ALLOCATE ( wadats(i)%MA0(nsea) ,          &

               wadats(i)%MAI(nsea) ,          &

               wadats(i)%MD0(nsea) ,          &

               wadats(i)%MDI(nsea) )

          !

          IF ( j.EQ.6 ) ALLOCATE ( wadats(i)%RA0(nsea) ,          &

               wadats(i)%RAI(nsea) )

          !

        END IF !  IF ( INPMAP(I,J) .NE. 0 ) THEN

      END DO !  DO J=JFIRST, 9

      !

      inflags1  = tflags

      CALL w3seti ( i, mdse, mdst )

      CALL w3seta ( i, mdse, mdst )

      !

      ! 8.a.3 Status indicator and model times

      !

      DO j=1, notype

        IF ( flout(j) ) THEN

          IF ( toutp(1,i) .EQ. -1 ) THEN

            toutp(:,i) = tonext(:,j)

          ELSE

            dttst  = dsec21( toutp(:,i), tonext(:,j) )

            IF ( dttst .LT. 0. ) toutp(:,i) = tonext(:,j)

          ENDIF

        END IF

      END DO

      !

      grstat(i) =  0

      tsync(:,i) = time(:)

      !

#ifdef W3_SMC

      ! Check GTYPE values after initialization

      IF ( improc .EQ. nmperr ) WRITE(mdse,*) "GRID IMPROC GTYPE", &

           i, improc, grids(i)%GTYPE

#endif

      !

#ifdef W3_T

      WRITE (mdst,9082) grstat(i), toutp(:,i), tsync(:,i)

#endif

      !

    END DO   !! 8.a I-NRGRD loop

    !

#ifdef W3_MPI

    CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

    DO i=1, nrgrd

      CALL wmsetm ( i, mdse, mdst )

      CALL w3setg ( i, mdse, mdst )

      CALL w3seto ( i, mdse, mdst )

      IF ( fbcast .AND. mpi_comm_bct.NE.mpi_comm_null ) THEN

        CALL mpi_bcast ( toutp(1,i), 2, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( tsync(1,i), 2, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( grstat(i), 1, mpi_integer, 0,       &

             mpi_comm_bct, ierr_mpi )

#endif

        !

        ! 8.a.4 Grid sizes etc. for processors that are not used.

        !

#ifdef W3_MPI

        CALL mpi_bcast ( flagll,1, mpi_logical, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( gtype, 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( iclose,1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nx   , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( ny   , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( x0   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( sx   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( y0   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( sy   , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nsea , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nseal, 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dtmax, 1, mpi_real, 0,              &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dtcfl, 1, mpi_real, 0,              &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( filext, 10, mpi_character, 0,       &

             mpi_comm_bct, ierr_mpi )

        IF ( mpi_comm_grd .EQ. mpi_comm_null )               &

             CALL w3dimx  ( i, nx, ny, nsea, mdse, mdst      &

#endif

#ifdef W3_SMC

                                !!  SMC grid related variables are not needed beyond MPI_COMM_GRD

                                !!  so all dimensions are minimised to 1.  JGLi29Mar2021

#endif

#ifdef W3_MPI

#ifdef W3_SMC

                                !!Li        , NCel, NUFc, NVFc, NRLv, NBSMC  &

                                !!Li        , NARC, NBAC, NSPEC              &

             , 1, 1, 1, 1, 1, 1, 1, 1         &

#endif

             )

        CALL mpi_bcast ( hqfac, nx*ny, mpi_real, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( hpfac, nx*ny, mpi_real, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( xgrd, nx*ny, mpi_double_precision, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( ygrd, nx*ny, mpi_double_precision, 0,           &

             mpi_comm_bct, ierr_mpi )

        IF ( mpi_comm_grd .EQ. mpi_comm_null )               &

             gsu = w3gsuc( .false., flagll, iclose,          &

             xgrd, ygrd )

        CALL mpi_bcast ( dxdp, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dxdq, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dydp, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dydq, nx*ny, mpi_real, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( mapsta, nx*ny, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( mapst2, nx*ny, mpi_integer, 0,      &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( gridshift, 1, mpi_double_precision, 0, &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

        CALL mpi_bcast ( nk   , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nth  , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( xfr  , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( fr1  , 1, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

        IF ( mpi_comm_grd .EQ. mpi_comm_null )               &

             CALL w3dims ( i, nk, nth, mdse, mdst )

        CALL mpi_bcast ( th , nth, mpi_real   , 0,           &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

        CALL mpi_bcast ( naproc,1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nappnt,1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( nbi  , 1, mpi_integer, 0,           &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

        CALL mpi_bcast ( flout,  8, mpi_logical, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( dtout , 8, mpi_real, 0,             &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( tonext,16, mpi_integer, 0,          &

             mpi_comm_bct, ierr_mpi )

        CALL mpi_bcast ( tolast,16, mpi_integer, 0,          &

             mpi_comm_bct, ierr_mpi )

#endif

        !

#ifdef W3_MPI

      END IF

    END DO

    CALL mpi_barrier (mpi_comm_mwave,ierr_mpi)

#endif

    !

    DO i=1, nrgrd

      IF ( allprc(improc,i) .EQ. 0 ) THEN

        CALL w3seto ( i, mdse, mdst )

        iaproc = -1

      END IF

    END DO

    !

    ! 8.a.5 Test output

    !

#ifdef W3_T

    WRITE (mdst,9020) 'AFTER SETUP'

    DO i=1, nrgrd

      WRITE (mdst,9021) i, mds(:,i), ntrace(:,i)

    END DO

#endif

    !

    ! 8.a.6 Check for coordinate system

    !

    DO i=1, nrgrd-1

      IF ( grids(i)%FLAGLL .NEQV. grids(i+1)%FLAGLL ) GOTO 2070

    END DO

    !

    ! 8.b Input files

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.c'

    prft0  = prftn

#endif

    !

    DO i=1, nrinp

      !

      IF ( .NOT. useinp(i) ) cycle

      !

      j      = len_trim(mnames(-i))

      IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) THEN

        WRITE (mdss,988) i, mnames(-i)(1:j)

        WRITE (mdss,987)

      END IF

      !

      CALL w3iogr ( 'GRID', ndsrec, -i, mnames(-i)(1:j) )

      CALL w3dimi ( -i, mdse, mdst )

      !

      IF ( cplinp(i) ) cycle

      !

      DO j=jfirst, 6

        IF ( inflags1(j) ) THEN

          idinp(-i,j) = idstr(j)

          CALL w3fldo ('READ', idinp(-i,j), mdsf(-i,j), mdst,     &

               mdse2, nx, ny, gtype, ierr,               &

               mnames(-i), trim(fnmpre) )

          IF ( ierr .NE. 0 ) GOTO 2080

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,985) idflds(j)

        ELSE

          IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc )              &

               WRITE (mdss,984) idflds(j)

        END IF

      END DO

      !

      ! Skipping assimilation input files for now.

      !

      DO j=jfirst, 9

        IF ( mdsf(-i,j) .NE. -1 ) CALL wmuinq                     &

             ( mdse, mdst, mdsf(-i,j) )

      END DO

      !

    END DO

    !

    DO i=1, nrgrd

      DO j=jfirst, 9

        IF  ( inpmap(i,j).LT.0 .AND. inpmap(i,j).NE.-999) idinp(i,j) = idinp( inpmap(i,j),j)

        !IF ( INPMAP(I,J) .LT. 0 ) IDINP(I,J) = IDINP( INPMAP(I,J),J)

        IF ( inpmap(i,j) .GT. 0 ) idinp(i,j) = idinp(-inpmap(i,j),j)

      END DO

    END DO

    !

    DEALLOCATE ( useinp )

    DEALLOCATE ( cplinp )

    !

    ! 8.c Inter model initialization

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'START Sec. 8.d'

    prft0  = prftn

#endif


    ! 8.c.1 Spectral conversion flags and source term flags

    !

    CALL wmrspc

    !

    DO i=1, nrgrd

      CALL w3setg ( i, mdse, mdst )

      flagst = .true.

    END DO

    !

    ! 8.c.2 Relation to lower ranked grids

    !       Includes update of unit numbers, and bound. data initialization.

    !

    ALLOCATE ( flrbpi(nrgrd) )

    CALL wmglow ( flrbpi )

    !

    ! ..... At this point the grid-search-utility (GSU) object for grids

    !       that do not belong to this processor is no longer needed.

    !

#ifdef W3_MPI

    DO i=1, nrgrd

      CALL wmsetm ( i, mdse, mdst )

      CALL w3setg ( i, mdse, mdst )

#endif

      ! the next line (with the W3GSUD call) removed Jan 8 2013.

      ! ...ref: personal communication,

      ! ...email from Rogers to Alves, Campbell, Tolman, Chawla Dec 13 2012.

      ! REMOVED  !/MPI        IF ( MPI_COMM_GRD .EQ. MPI_COMM_NULL ) CALL W3GSUD( GSU )

#ifdef W3_MPI

    END DO

#endif

    !

    ! ..... Unit numbers

    !


    DO i=1, nrgrd

      !

      CALL w3setg ( i, mdse, mdst )

      CALL w3seto ( i, mdse, mdst )

      !

      IF ( bcdump(i) .AND. flrbpi(i) ) THEN

        IF ( improc .EQ. nmperr ) WRITE (mdse,1080) i

        IF ( improc .EQ. nmplog ) WRITE (mdso,1082) i

        bcdump(i) = .false.

      END IF

      !

      IF ( bcdump(i) .AND. nbi.EQ.0 ) THEN

        IF ( improc .EQ. nmperr ) WRITE (mdse,1081) i

        IF ( improc .EQ. nmplog ) WRITE (mdso,1082) i

        bcdump(i) = .false.

      END IF

      !

#ifdef W3_SHRD

      IF ( .NOT. flrbpi(i) .AND. flbpi ) THEN

#endif

#ifdef W3_MPI

        IF ( .NOT. flrbpi(i) .AND. flbpi .AND.                   &

             mpi_comm_grd .NE. mpi_comm_null) THEN

#endif

          CALL wmuset ( mdse, mdst, nds(9), .false. )

          IF ( bcdump(i) .AND. iaproc.EQ.napbpt ) THEN

            j            = len_trim(filext)

            tname(1:5)   = 'nest.'

            tname(6:5+j) = filext(1:j)

            j      = j + 5

            CALL wmuget ( mdse, mdst, nds(9), 'OUT' )

            CALL wmuset ( mdse, mdst, nds(9), .true.,             &

                 name=trim(fnmpre)//tname(1:j),           &

                 desc='Output data file (nest dump)' )

            mds(9,i) = ndsfnd

          ELSE

            nds(9) = -1

          END IF

#ifdef W3_MPI

        END IF ! IF ( .NOT. FLRBPI(I) .AND. FLBPI .AND. MPI_COMM_GRD .NE. MPI_COMM_NULL)

#endif

#ifdef W3_SHRD

      END IF ! IF ( .NOT. FLRBPI(I) .AND. FLBPI )

#endif

      !

    END DO

    !

    ! ..... Data initialization

    !

    DO i=1, nrgrd

#ifdef W3_MPI

      CALL wmsetm ( i, mdse, mdst )

      IF ( mpi_comm_grd .NE. mpi_comm_null ) CALL wmiobs ( i )

#endif

#ifdef W3_SHRD

      CALL wmiobs ( i )

#endif

    END DO

    !

    DO i=1, nrgrd

#ifdef W3_MPI

      CALL wmsetm ( i, mdse, mdst )

      IF ( mpi_comm_grd .NE. mpi_comm_null ) CALL wmiobg ( i )

#endif

#ifdef W3_SHRD

      CALL wmiobg ( i )

#endif

    END DO

    !

#ifdef W3_MPI

    DO i=1, nrgrd

      CALL wmsetm ( i, mdse, mdst )

      IF ( mpi_comm_grd .NE. mpi_comm_null ) CALL wmiobf ( i )

    END DO

#endif

    !

    ! 8.c.3 Relation to same ranked grids

    !

#ifdef W3_SMC

    !!  Check whether there is a SMC grid group.   JGLi12Apr2021

    ngrpsmc = 0

    DO jj=1, nrgrp

      j = 0

      DO ii=1, ingrp(jj,0)

        i = ingrp(jj,ii)

        IF( grids(i)%GTYPE .EQ. smctype ) j = j + 1

      ENDDO

      IF( j .GT. 1 )  ngrpsmc = jj

    ENDDO

    IF( improc.EQ.nmperr )  WRITE (mdse,*) " NGRPSMC =", ngrpsmc


    !!  Equal ranked SMC grid group uses its own sub.   JGLi12Apr2021

    IF( ngrpsmc .GT. 0 ) THEN

      CALL wmsmceql

    ELSE

#endif

      !

      CALL wmgeql

      !

#ifdef W3_SMC

    ENDIF

#endif

    !

    ! 8.c.4 Relation to higher ranked grids

    !

    IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,938) &

         'Computing relation to higher ranked grids'

    CALL wmghgh

    IF ( mdss.NE.mdso .AND. nmpsc2.EQ.improc ) WRITE (mdss,938) &

         'Finished computing relation to higher ranked grids'

    !

    ! 8.c.5 Unified point output

    !

    IF ( unipts ) THEN

      !

      outpts(0)%TONEXT(1,2) =        odat( 6,0)

      outpts(0)%TONEXT(2,2) =        odat( 7,0)

      outpts(0)%DTOUT (  2) = real( odat( 8,0) )

      outpts(0)%TOLAST(1,2) =        odat( 9,0)

      outpts(0)%TOLAST(2,2) =        odat(10,0)

      !

      tout   = outpts(0)%TONEXT(:,2)

      tlst   = outpts(0)%TOLAST(:,2)

      !

      DO

        dttst   = dsec21( stime , tout )

        IF ( dttst .LT. 0 ) THEN

          CALL tick21 ( tout, outpts(0)%DTOUT(2) )

        ELSE

          EXIT

        END IF

      END DO

      !

      outpts(0)%TONEXT(:,2) = tout

      !

      dttst  = dsec21( tout , tlst )

      IF (( dttst .LT. 0. ) .OR. ( odat(8,0) .EQ. 0 )) THEN

        unipts = .false.

      ELSE

        CALL wmiopp ( ot2(0)%NPTS, ot2(0)%X, ot2(0)%Y,          &

             ot2(0)%PNAMES )

      END IF

      !

#ifdef W3_MPI

      DO i=1, nrgrd

        CALL wmsetm ( i, mdse, mdst )

        CALL w3setg ( i, mdse, mdst )

        CALL w3seto ( i, mdse, mdst )

        IF ( fbcast .AND. mpi_comm_bct.NE.mpi_comm_null ) THEN

          CALL mpi_bcast ( nopts, 1, mpi_integer, 0,       &

               mpi_comm_bct, ierr_mpi )

        END IF

      END DO

#endif

      !

    END IF ! IF ( UNIPTS )

    !

    ! 8.c.6 Output

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                      &

         WRITE (mdss,938) 'Additional group information'

    !

    IF ( maxval(grdlow(:,0)) .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,933) 'Lower rank grid dependence'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,933) 'Lower rank grid dependence'

      DO i=1, nrgrd

        WRITE (line(1:6),'(1X,I3,2X)') i

        jjj    = 6

        IF ( grdlow(i,0) .NE. 0 ) THEN

          DO j=1, grdlow(i,0)

            WRITE (line(jjj+1:jjj+3),'(I3)') grdlow(i,j)

            jjj    = jjj + 3

          END DO

        ELSE IF ( flrbpi(i) ) THEN

          jjj    = 21

          line(7:jjj) = ' Data from file'

        ELSE

          jjj    = 22

          line(7:jjj) = ' No dependencies'

        END IF

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE(mdss,934) line(1:jjj)

        IF ( nmplog .EQ. improc ) WRITE(mdso,934) line(1:jjj)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

      IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    ELSE

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,937) 'No lower rank grid dependencies'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,937) 'No lower rank grid dependencies'

    END IF ! IF ( MAXVAL(GRDLOW(:,0)) .GT. 0 )

    DEALLOCATE ( flrbpi )

    !

    IF ( maxval(grdeql(:,0)) .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,933) 'Same rank grid dependence'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,933) 'Same rank grid dependence'

      DO i=1, nrgrd

        WRITE (line(1:6),'(1X,I3,2X)') i

        jjj    = 6

        IF ( grdeql(i,0) .NE. 0 ) THEN

          DO j=1, grdeql(i,0)

            WRITE (line(jjj+1:jjj+3),'(I3)') grdeql(i,j)

            jjj    = jjj + 3

          END DO

        ELSE

          jjj    = 22

          line(7:jjj) = ' No dependencies'

        END IF

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE(mdss,934) line(1:jjj)

        IF ( nmplog .EQ. improc ) WRITE(mdso,934) line(1:jjj)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

      IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    ELSE

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,937) 'No same rank grid dependencies'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,937) 'No same rank grid dependencies'

    END IF ! IF ( MAXVAL(GRDEQL(:,0)) .GT. 0 )

    !

    IF ( maxval(grdhgh(:,0)) .GT. 0 ) THEN

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,933) 'Higher rank grid dependence'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,933) 'Higher rank grid dependence'

      DO i=1, nrgrd

        WRITE (line(1:6),'(1X,I3,2X)') i

        jjj    = 6

        IF ( grdhgh(i,0) .NE. 0 ) THEN

          DO j=1, grdhgh(i,0)

            WRITE (line(jjj+1:jjj+3),'(I3)') grdhgh(i,j)

            jjj    = jjj + 3

          END DO

        ELSE

          jjj    = 22

          line(7:jjj) = ' No dependencies'

        END IF

        IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                &

             WRITE(mdss,934) line(1:jjj)

        IF ( nmplog .EQ. improc ) WRITE(mdso,934) line(1:jjj)

      END DO

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,935)

      IF ( nmplog .EQ. improc ) WRITE (mdso,935)

    ELSE

      IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc )                  &

           WRITE (mdss,937) 'No higher rank grid dependencies'

      IF ( nmplog .EQ. improc )                                   &

           WRITE (mdso,937) 'No higher rank grid dependencies'

    END IF ! IF ( MAXVAL(GRDHGH(:,0)) .GT. 0 )

    !

#ifdef W3_T

    WRITE (mdst,9083)

    DO i=-nrinp, nrgrd

      WRITE (mdst,9084) i, idinp(i,:)

    END DO

#endif

    !

    !    Test output of connected units (always)

    !

    CALL wmuset ( mdse, mdst, scratch, .false. )

    IF ( tstout ) CALL wmudmp ( mdst, 0 )

    !

    DEALLOCATE ( mds, ntrace, odat, flgrd, flgr2, flgd, flg2, inames,&

         mnames                                              &

         ,outff )

    !

#ifdef W3_MPI

    CALL mpi_barrier ( mpi_comm_mwave, ierr_mpi )

#endif

    !

    CALL date_and_time ( values=clkdt2 )

    clkfin = tdiff( clkdt1,clkdt2 )

    !

#ifdef W3_MPRF

    CALL prtime ( prftn )

    WRITE (mdsp,990) prft0, prftn, get_memory(), 'END'

#endif

    !

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,998)

#ifdef W3_O10

    IF ( mdss.NE.mdso .AND. nmpscr.EQ.improc ) WRITE (mdss,999)

#endif

    !

    RETURN

    !

    ! Escape locations read errors :

    !

2003 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1003)

    CALL extcde ( 2003 )

    RETURN

    !

2104 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1104) ierr

    CALL extcde ( 1104 )

    RETURN

    !

2004 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1004) ierr

    CALL extcde ( 2004 )

    RETURN

    !

2010 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1010) ierr

    CALL extcde ( 2010 )

    RETURN

    !

2011 CONTINUE

    ! === no process number filtering for test file !!! ===

    WRITE (mdse,1011) ierr

    CALL extcde ( 2011 )

    RETURN

    !

2020 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1020)

    CALL extcde ( 2020 )

    RETURN

    !

2021 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1021)

    CALL extcde ( 2021 )

    RETURN

    !

2030 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1030) mnames(i), inames(i,j)

    CALL extcde ( 2030 )

    RETURN

    !

2031 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1031) inames(i,j), j

    CALL extcde ( 2031 )

    RETURN

    !

    !2050 CONTINUE

    !     IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1040)

    !     CALL EXTCDE ( 2050 )

    !     RETURN

    !

2051 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1051) mn(:ii)

    CALL extcde ( 2051 )

    RETURN

    !

2052 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1052) j

    CALL extcde ( 2052 )

    RETURN

    !

2053 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1053)

    CALL extcde ( 2053 )

    RETURN

    !

2054 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1054)

    CALL extcde ( 2054 )

    RETURN

    !

2055 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1055)

    CALL extcde ( 2055 )

    RETURN

    !

2060 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1060)

    CALL extcde ( 2060 )

    RETURN

    !

2061 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1061) idtst, n_mov

    CALL extcde ( 2061 )

    RETURN

    !

2062 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1062) idtst

    CALL extcde ( 2062 )

    RETURN

    !

2070 CONTINUE

    IF ( improc .EQ. nmperr ) WRITE (mdse,1070)

    CALL extcde ( 2070 )

    RETURN

    !

2080 CONTINUE

    CALL extcde ( 2080 )

    RETURN

    !

    ! Formats

    !

900 FORMAT ( ' ========== STARTING MWW3 INITIALIZATION (WMINITNML) =', &

         '============================'/)

901 FORMAT ( ' WAVEWATCH III log file            ',                 &

         '                     version ',a/                     &

         ' ==================================',                 &

         '==================================='/                 &

         ' multi-grid model driver                          ',  &

         'date : ',a10/50x,'time :  ',a8)

    !

910 FORMAT ( '  Opening input file ',a,' (unit number',i3,')')

911 FORMAT ( '  Opening output file ',a,' (unit number',i3,')')

912 FORMAT (/'  Comment character : ''',a,'''')

    !

920 FORMAT (/'  Number of grids          :',i3)

921 FORMAT ( '  No input data grids.')

922 FORMAT ( '  Input data grids         :',i3)

923 FORMAT ( '  Single point output file : ',a)

1923 FORMAT (/'  Output server type       :',i3)

2923 FORMAT ( '  Single point output proc : ',a)

3923 FORMAT ( '  Grids share output procs : ',a)

    !

924 FORMAT (/'  Input grid information : '/                         &

         '  nr extension  lev.   cur.   wind   ice    tau',     &

         '    rho    data'/    &

         ' ----------------------------------------------',     &

         '---------------')

925 FORMAT (1x,i3,1x,a10,6(1x,a6),3(1x,a1))

926 FORMAT ( ' ----------------------------------------------',     &

         '---------------')

    !

927 FORMAT (/'  Grid for point output : '/                          &

         '  nr extension  '/ ' ---------------')

928 FORMAT (5x,a10)

929 FORMAT ( ' ---------------')

    !

930 FORMAT (/'  Wave grid information : '/                          &

         '  nr extension  lev.   cur.   wind   ice    tau',     &

         '    rho    data   move1 rnk grp dmp'/                 &

         ' -----------------------------------------------',    &

         '-----------------------------------')

931 FORMAT (1x,i3,1x,a10,6(1x,a6),3(1x,a1),2x,a4,2i4,3x,a1)

932 FORMAT ( ' -----------------------------------------------',    &

         '-----------------------------------'/)

933 FORMAT ( '  ',a,' : '/                                          &

         '  nr   grids (part of comm.)'/                        &

         ' -----------------------------------------------',    &

         '---------------------')

934 FORMAT (a)

935 FORMAT ( ' -----------------------------------------------',    &

         '---------------------'/)

936 FORMAT (/'  ',a,' : '/                                          &

         '  nr   Depends on '/                                  &

         ' -----------------------------------------------',    &

         '---------------------')

937 FORMAT ( '  ',a/)

938 FORMAT (/'  ',a/)

    !

940 FORMAT (/'  Time interval : '/                                  &

         ' --------------------------------------------------')

941 FORMAT ( '       Starting time : ',a)

942 FORMAT ( '       Ending time   : ',a/)

943 FORMAT (/'  Model settings : '/                                 &

         ' --------------------------------------------------')

944 FORMAT ( '       Masking computation in nesting : ',a)

945 FORMAT ( '       Masking output in nesting      : ',a/)

    !

950 FORMAT (/'  Output requests : (',a,') '/                        &

         ' ==================================================')

951 FORMAT (/'       Type',i2,' : ',a/                              &

         '      -----------------------------------------')

952 FORMAT ( '            From     : ',a)

953 FORMAT ( '            To       : ',a)

954 FORMAT ( '            Interval : ',a/)

955 FORMAT ( '            Fields   : ',a)

956 FORMAT ( '                       ',a)

957 FORMAT ( '            Point  1 : ',2e14.6,2x,a)

958 FORMAT ( '              ',i6,' : ',2e14.6,2x,a)

959 FORMAT ( '            No points defined')

960 FORMAT ( '            The file with ',a,' data is ',a,'.')

961 FORMAT ( '            IX fls   : ',3i6/                         &

         '            IY fls   : ',3i6)

962 FORMAT (/'  Output request for model ',a,' (nr',i3,') '/        &

         ' ==================================================')

963 FORMAT ( '            Output disabled')

    !

965 FORMAT (/'  Grid movement data (!/MGP, !/MGW): '/               &

         ' --------------------------------------------------')

966 FORMAT ( '       ',a)

967 FORMAT ( '       ',i6,2x,a)

968 FORMAT ( '          ',i6,i11.8,i7.6,2f8.2)

    !

970 FORMAT(//'  Assigning resources : '/                            &

         ' --------------------------------------------------')

971 FORMAT ( '       ',a)

972 FORMAT ( '       Process ',i5.5,' reserved for all point output.')

973 FORMAT ( '       Processes ',i5.5,' through ',i5.5,' [',i3,']', &

         ' reserved for output.')

974 FORMAT (/                                                       &

         5x,'  grid           comp.      grd    pnt    trk    rst    bpt    prt'/     &

         5x,' ------------------------------------------------------', &

         '-------------')

975 FORMAT (5x,'  ',a10,2x,i5.5,'-',i5.5,6(2x,a5))

976 FORMAT(5x,' -------------------------------------------------', &

         '------------------')

977 FORMAT (5x,'    Unified point output at ',i5.5)

1974 FORMAT ('  Resource assignement (processes) : '/                &

         '  grid           comp.      grd    pnt    trk    rst    bpt    prt'/     &

         ' ------------------------------------------------------', &

         '-------------')

1975 FORMAT ('  ',a10,2x,i5.5,'-',i5.5,6(2x,a5))

1976 FORMAT (' ---------------------------------------------------', &

         '----------------')

1977 FORMAT ('    Unified point output at ',i5.5)

    !

980 FORMAT(//'  Initializations :'/                                 &

         ' --------------------------------------------------')

981 FORMAT ( '       Model number',i3,' [',a,']')

982 FORMAT ( '          Initializing wave model ...')

983 FORMAT ( '          Initializing model input ...')

984 FORMAT ( '            ',a,': file not needed')

985 FORMAT ( '            ',a,': file OK')

986 FORMAT ( '       Unified point output [',a,']')

987 FORMAT ( '          Initializing grids ...')

988 FORMAT ( '       Input data grid',i3,' [',a,']')

    !

#ifdef W3_MPRF

990 FORMAT (1x,3f12.3,' WMINITNML',1x,a)

#endif

    !

998 FORMAT ( '  Running the model :'/                               &

         ' --------------------------------------------------'/)

999 FORMAT ( ' ========== END OF MWW3 INITIALIZATION (WMINITNML) ===', &

         '============================'/)

    !

1003 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     PREMATURE END OF POINT FILE'/)

    !

1104 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     ERROR IN OPENING POINT FILE'/                     &

         '     IOSTAT =',i5/)

    !

1004 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     ERROR IN READING FROM POINT FILE'/                &

         '     IOSTAT =',i5/)

1010 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     ERROR IN OPENING LOG FILE'/                       &

         '     IOSTAT =',i5/)

1011 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     ERROR IN OPENING TEST FILE'/                      &

         '     IOSTAT =',i5/)

1020 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     ILLEGAL NUMBER OF GRIDS ( < 1 ) '/)

1021 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     ILLEGAL NUMBER OF INPUT GRIDS ( < 0 ) '/)

1030 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     INPUT GRID NAME NOT FOUND '/                      &

         '     WAVE GRID  : ',a/                                 &

         '     INPUT NAME : ',a/)

1031 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/         &

         '     REQUESTED INPUT TYPE NOT FOUND IN INPUT GRID '/   &

         '     INPUT GRID : ',a/                                 &

         '     INPUT TYPE : ',i8/)

1032 FORMAT (/' *** WAVEWATCH III WARNING IN WMINITNML : *** '/       &

         '     INPUT GRID ',a,' NOT USED '/)

1040 FORMAT ( ' *** WAVEWATCH III WARNING IN W3MLTI : ***'/           &

         '     POSSIBLE LOAD IMBALANCE GROUP',i3,' :',2i6/)

    !1040 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

    !              '     ILLEGAL TIME INTERVAL'/)

1050 FORMAT (/' *** WAVEWATCH III WARNING IN W3MLTI : ***'/           &

         '     UNIFIED POINT OUTPUT BUT NO OUTPUT'/              &

         '     UNIFIED POINT OUTPUT DISABLED'/)

1051 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     ILLEGAL MODEL ID [',a,']'/)

1052 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     ILLEGAL OUTPUT TYPE',i10/)

1053 FORMAT (/' *** WAVEWATCH III WARNING IN W3MLTI : ***'/           &

         '     OUTPUT POINTS FOR INDIVIDUAL GRIDS CANNOT BE DEFINED'/  &

         '     WHEN UNIFIED POINT OUTPUT IS REQUESTED'/)

1054 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     POINT OUTPUT ACTIVATED, BUT NO POINTS DEFINED'/)

1055 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     POINT OUTPUT ACTIVATED, BUT NO FILE DEFINED'/)

1060 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     NO MOVING GRID DATA PRESENT'/)

1061 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     TOO MANY HOMOGENEOUS FIELDS : ',a,1x,i4/)

1062 FORMAT (/' *** WAVEWATCH III ERROR IN W3MLTI : ***'/             &

         '     HOMOGENEOUS NAME NOT RECOGNIZED : ', a/)

1070 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : ***'/          &

         '     ALL GRIDS ARE NOT USING THE SAME COORDINATE SYSTEM'/)

1080 FORMAT (/' *** BOUNDARY DATA READ, WILL NOT DUMP, GRID :',i4,    &

         ' ***')

1081 FORMAT (/' *** NO BOUNDARY DATA TO DUMP, GRID :',i4,' ***')

1082 FORMAT ( '  No boundary data dump for grid',i3/)

    !

#ifdef W3_T

9000 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS    : ',5i6/          &

         '               INPUT FILE NAME : ',a)

#endif

    !

#ifdef W3_T

9020 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS FOR GRIDS (',a,')'/  &

         15x,'GRID MDS(1-15)',43x,'NTRACE')

9021 FORMAT (14x,16i4)

9022 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS FOR INTPUT FILES'/   &

         15x,'GRID MDSF(JFIRST-9)')

9030 FORMAT ( ' TEST WMINITNML : FILE EXTENSIONS, INPUT FLAGS,',   &

         ' RANK AND GROUP, PROC RANGE')

9031 FORMAT ( '            ',i3,1x,a,20l2,2i4,2f6.2)

9032 FORMAT ( ' TEST WMINITNML : PROCESSED RANK NUMBERS')

9033 FORMAT ( '             ',i3,1x,a,1x,i4)

9034 FORMAT ( ' TEST WMINITNML : NUMBER OF GROUPS :',i4)

9035 FORMAT ( ' TEST WMINITNML : SIZE OF GROUPS :',20i3)

9036 FORMAT ( ' TEST WMINITNML : GROUP SIZE AND COMPONENTS :')

9037 FORMAT ( '             ',2i3,':',20i3)

#endif

    !

#ifdef W3_T

9050 FORMAT ( ' TEST WMINITNML : GRID NUMBER',i3,' =================')

9051 FORMAT ( ' TEST WMINITNML : ODAT   : ',i9.8,i7.6,i7,i9.8,i7.6,  &

         5(/24x,i9.8,i7.6,i7,i9.8,i7.6) )

9052 FORMAT ( ' TEST WMINITNML : FLGRD  : ',5(5l2,1x)/24x,5(5l2,1x))

9053 FORMAT ( ' TEST WMINITNML : OUTFF   : ',i9.8 &

         5(/24x,i9.8) )

#endif

    !

#ifdef W3_T

9060 FORMAT ( ' TEST WMINITNML : GRID MOVEMENT DATA')

9061 FORMAT ( '             ',i8.8,i7,1x,2f8.2)

#endif

    !

#ifdef W3_T

9070 FORMAT ( ' TEST WMINITNML : ALLPRC ')

9071 FORMAT ( ' ',i3,'  : ',250i3)

8042 FORMAT ( ' TEST WMINITNML : MODMAP ')

8043 FORMAT ( ' TEST WMINITNML : LOADMP ')

8044 FORMAT ( '        ',i3,'  : ',250i2)

#endif

    !

#ifdef W3_T

9080 FORMAT ( ' TEST WMINITNML : MODEL INITIALIZATION')

9081 FORMAT ( '               MODEL AND TIME   :',i4,i10.8,i8.6)

9082 FORMAT ( '               STATUS AND TIMES :',i4,3(i10.8,i8.6))

9083 FORMAT ( ' TEST WMINITNML : IDINP AFTER INITIALIZATION :')

9084 FORMAT ( '               ',i4,17(2x,a3))

#endif

    !/

    !/ End of WMINITNML ----------------------------------------------------- /

    !/

  END SUBROUTINE wminitnml


  !/

  !/ End of module WMINITMD -------------------------------------------- /

  !/

END MODULE wminitmd