w3initmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
 
!/ ------------------------------------------------------------------- /
MODULE w3initmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         22-Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/    28-Dec-2004 : Origination (out of W3WAVEMD).      ( version 3.06 )
  !/                  Multiple grid version.
  !/    03-Jan-2005 : Add US2x to MPI communication.      ( version 3.06 )
  !/    04-Jan-2005 : Add grid output flags to W3INIT.    ( version 3.06 )
  !/    07-Feb-2005 : Combined vs. separate test output.  ( version 3.07 )
  !/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
  !/    21-Jul-2005 : Add output fields.                  ( version 3.07 )
  !/    09-Nov-2005 : Drying out of points added.         ( version 3.08 )
  !/    13-Jun-2006 : Splitting STORE in G/SSTORE.        ( version 3.09 )
  !/    26-Jun-2006 : adding wiring for output type 6.    ( version 3.09 )
  !/    27-Jun-2006 : Adding file name preamble.          ( version 3.09 )
  !/    04-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
  !/    02-Aug-2006 : Adding W3MPIP.                      ( version 3.10 )
  !/    02-Nov-2006 : Adding partitioning options.        ( version 3.10 )
  !/    11-Jan-2007 : Updating IAPPRO computation.        ( version 3.10 )
  !/    02-Apr-2007 : Add partitioned field data.         ( version 3.11 )
  !/                  Add user-defined field data.
  !/    01-May-2007 : Move O7a output to W3IOPP.          ( version 3.11 )
  !/    08-May-2007 : Starting from calm as an option.    ( version 3.11 )
  !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
  !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11 )
  !/    29-Feb-2008 : Add NEC compiler directives.        ( version 3.13 )
  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
  !/    23-Jul-2009 : Implement unstructured grids        ( version 3.14 )
  !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
  !/                  (W. E. Rogers & T. J. Campbell, NRL)
  !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
  !/                  (W. E. Rogers & T. J. Campbell, NRL)
  !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
  !/                  specify index closure for a grid.   ( version 3.14 )
  !/                  (T. J. Campbell, NRL)
  !/    02-Sep.2012 : Set up for > 999 test files.        ( version 4.10 )
  !/                  Reset UST initialization.
  !/    03-Sep-2012 : Switch test file on/off (TSTOUT)    ( version 4.10 )
  !/    03-Sep-2012 : Clean up of UG grids                ( version 4.08 )
  !/    30-Sep-2012 : Implemetation of tidal constituents ( version 4.09 )
  !/    07-Dec-2012 : Initialize UST non-zero.            ( version 4.11 )
  !/    12-Dec-2012 : Changes for SMC grid.  JG_Li        ( version 4.11 )
  !/    26-Dec-2012 : Modify field output MPI for new     ( version 4.11 )
  !/                  structure and smaller memory footprint.
  !/    02-Jul-2013 : Bug fix MPI_FLOAT -> MPI_REAL.      ( version 4.11 )
  !/    10-Oct-2013 : CG and WN values at DMIN for ISEA=0 ( version 4.12 )
  !/    14-Nov-2013 : Remove UST(DIR) initialization.     ( version 4.13 )
  !/    15-Dec-2013 : Adds fluxes to ice                  ( version 5.01 )
  !/    01-May-2017 : Adds directional MSS parameters     ( version 6.04 )
  !/    05-Jun-2018 : Adds PDLIB/MEMCHECK/DEBUG           ( version 6.04 )
  !/    21-Aug-2018 : Add WBT parameter                   ( version 6.06 )
  !/    26-Aug-2018 : UOST (Mentaschi et al. 2015, 2018)  ( version 6.06 )
  !/    25-Sep-2020 : Extra fields for coupling restart   ( version 7.10 )
  !/    22-Mar-2021 : Extra coupling fields               ( version 7.13 )
  !/    22-Jun-2021 : GKE NL5 (Q. Liu)                    ( version 7.13 )
  !/
  !/    Copyright 2009-2013 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.
  !/
  !/    Note: Changes in version numbers not logged above.
  !/
  !  1. Purpose :
  !
  !  2. Variables and types :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      CRITOS    R.P.  Public   Critical percentage of resources used
  !                               for output to trigger warning.
  !      WWVER     C*10  Public   Model version number.
  !      SWITCHES  C*256 Public   switches taken from bin/switch
  !     ----------------------------------------------------------------
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      W3INIT    Subr. Public   Wave model initialization.
  !      W3MPII    Subr. Public   Initialize MPI data transpose.
  !      W3MPIO    Subr. Public   Initialize MPI output gathering.
  !      W3MPIP    Subr. Public   Initialize MPI point output gathering.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !     See subroutine documentation.
  !
  !  5. Remarks :
  !
  !  6. Switches :
  !
  !       !/SHRD  Switch for shared / distributed memory architecture.
  !       !/DIST  Id.
  !       !/MPI   Id.
  !
  !       !/S     Enable subroutine tracing.
  !       !/Tn    Enable test output.
  !       !/MPIT  Enable test output (MPI).
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  ! module default
  implicit none
 
  PUBLIC
  !/
  REAL, PARAMETER                :: critos = 15.
  CHARACTER(LEN=10), PARAMETER   :: wwver  = '7.14  '
  CHARACTER(LEN=512), PARAMETER  :: switches  = &
       __ww3_switches__
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3init ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD,  FLGR2, FLGD, &
       FLG2, NPT, XPT, YPT, PNAMES, IPRT, PRTFRM, MPI_COMM, FLAGSTIDEIN)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         03-Sep-2012 |
    !/                  +-----------------------------------+
    !/
    !/    17-Mar-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
    !/    13-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/                  Major changes to logistics.
    !/    14-Feb-2000 : Exact-NL added.                     ( version 2.01 )
    !/    24-Jan-2001 : Flat grid version.                  ( version 2.06 )
    !/    24-Jan-2002 : Zero time step for data ass.        ( version 2.17 )
    !/    18-Feb-2002 : Point output diagnostics added.     ( version 2.18 )
    !/    13-Nov-2002 : Add stress vector.                  ( version 3.00 )
    !/    20-Aug-2003 : Output server options added.        ( version 3.04 )
    !/    28-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/                  Taken out of W3WAVE.
    !/    04-Jan-2005 : Add grid output flags to par list.  ( version 3.06 )
    !/    07-Feb-2005 : Combined vs. separate test output.  ( version 3.07 )
    !/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
    !/    09-Nov-2005 : Drying out of points added.         ( version 3.08 )
    !/    26-Jun-2006 : adding wiring for output type 6.    ( version 3.09 )
    !/    27-Jun-2006 : Adding file name preamble.          ( version 3.09 )
    !/    02-Aug-2006 : Adding W3MPIP.                      ( version 3.10 )
    !/    02-Nov-2006 : Adding partitioning options.        ( version 3.10 )
    !/    11-Jan-2007 : Updating IAPPRO computation.        ( version 3.10 )
    !/    01-May-2007 : Move O7a output to W3IOPP.          ( version 3.11 )
    !/    08-May-2007 : Starting from calm as an option.    ( version 3.11 )
    !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11
    !/    13-Sep-2009 : Add coupling option                 ( version 3.14 )
    !/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/    29-Oct-2010 : Implement unstructured grids        ( version 3.14.1 )
    !/                  (A. Roland and F. Ardhuin)
    !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
    !/                  specify index closure for a grid.   ( version 3.14 )
    !/                  (T. J. Campbell, NRL)
    !/    02-Sep.2012 : Set up for > 999 test files.        ( version 4.10 )
    !/    03-Sep-2012 : Switch test file on/off (TSTOUT)    ( version 4.10 )
    !/    03-Sep-2012 : Clean up of UG grids                ( version 4.08 )
    !/
    !  1. Purpose :
    !
    !     Initialize WAVEWATCH III.
    !
    !  2. Method :
    !
    !     Initialize data structure and wave fields from data files.
    !     Initialize grid from local and instantaneous data.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number.
    !       FEXT    Char   I   Extension of data files.
    !       MDS     I.A.   I   Array with dataset numbers (see below),
    !                          saved as NDS in W3ODATMD.
    !                           1: General output unit number ("log file").
    !                           2: Error output unit number.
    !                           3: Test output unit number.
    !                           4: "screen", i.e., direct output location,
    !                              can be the screen or the output file of
    !                              the shell.
    !                           5: Model definition file unit number.
    !                           6: Restart file unit number.
    !                           7: Grid output file unit number.
    !                           8: Point output file unit number.
    !                           9: Input boundary data file unit number.
    !                          10: Output boundary data file unit number
    !                              (first).
    !                          11: Track information file unit number.
    !                          12: Track output file unit number.
    !                          13: Wave separation output file unit number.
    !                          14: Grid output file unit number.
    !                          15: Point output file unit number. ascii
    !       MTRACE  I.A.   I   Array with subroutine tracing information.
    !                           1: Output unit number for trace.
    !                           2: Maximum number of trace prints.
    !       ODAT    I.A.   I   Output data, five parameters per output type
    !                           1-5  Data for OTYPE = 1; gridded fields.
    !                                1 YYYMMDD for first output.
    !                                2 HHMMSS for first output.
    !                                3 Output interval in seconds.
    !                                4 YYYMMDD for last output.
    !                                5 HHMMSS for last output.
    !                           6-10 Id. for OTYPE = 2; point output.
    !                          11-15 Id. for OTYPE = 3; track point output.
    !                          16-20 Id. for OTYPE = 4; restart files.
    !                          21-25 Id. for OTYPE = 5; boundary data.
    !                          31-35 Id. for OTYPE = 7; coupling data.
    !                          36-40 Id. for OTYPE = 8; second restart file
    !       FLGRD   L.A.   I   Flags for gridded output.
    !       FLGR2   L.A.   I   Flags for coupling output.
    !       NPT     Int.   I   Number of output points
    !       X/YPT   R.A.   I   Coordinates of output points.
    !       PNAMES  C.A.   I   Output point names.
    !       IPRT    I.A.   I   Partitioning grid info.
    !       PRTFRM  I.A.   I   Partitioning format flag.
    !       MPI_COMM Int.  I   MPI communicator to be used for model.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG    Subr. W3GDATMD Point to data structure.
    !      W3SETW    Subr. W3WDATMD Point to data structure.
    !      W3DIMW    Subr.   Id.    Set array sizes in data structure.
    !      W3SETA    Subr. W3ADATMD Point to data structure.
    !      W3DIMA    Subr.   Id.    Set array sizes in data structure.
    !      W3SETI    Subr. W3IDATMD Point to data structure.
    !      W3DIMI    Subr.   Id.    Set array sizes in data structure.
    !      W3SETO    Subr. W3ODATMD Point to data structure.
    !      W3DMO5    Subr.   Id.    Set array sizes in data structure.
    !      ITRACE    Subr. W3SERVMD Subroutine tracing initialization.
    !      STRACE    Subr.   Id.    Subroutine tracing.
    !      EXTCDE    Subr.   Id.    Program abort.
    !      WWDATE    Subr.   Id.    System date.
    !      WWTIME    Subr.   Id.    System time.
    !      DSEC21    Func. W3TIMEMD Compute time difference.
    !      TICK21    Func.   Id.    Advance the clock.
    !      STME21    Func.   Id.    Print the time readable.
    !      PRTBLK    Func. W3ARRYMD Print plot of array.
    !      W3IOGR    Subr. W3IOGRMD Read/write model definition file.
    !      W3IORS    Subr. W3IORSMD Read/write restart file.
    !      W3IOPP    Subr. W3IOPOMD Preprocess point output.
    !      CALL MPI_COMM_SIZE, CALL MPI_COMM_RANK
    !                Subr. mpif.h   Standard MPI routines.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !     Any program shell or integrated model which uses WAVEWATCH III.
    !
    !  6. Error messages :
    !
    !     On opening of log file only. Other error messages are generated
    !     by W3IOGR and W3IORS.
    !
    !  7. Remarks :
    !
    !     - The log file is called 'log.FEXT', where FEXT is passed to
    !       the routine.
    !     - The test output file is called 'test.FEXT' in shared memory
    !       version or testNNN.FEXT in distributed memory version.
    !     - A water level and ice coverage are transferred with the
    !       restart file. To assure consistency within the model, the
    !       water level and ice coverage are re-evaluated at the 0th
    !       time step in the actual wave model routine.
    !     - 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 (MDS(1),FILE=..."
    !
    !  8. Structure :
    !
    !     ----------------------------------------------------
    !      1.  Set-up of idata structures and I/O.
    !        a Point to proper data structures.
    !        b Number of processors and processor number.
    !        c Open files.
    !        d Dataset unit numbers
    !        e Subroutine tracing
    !        f Initial and test outputs
    !      2.  Model definition.
    !        a Read model definition file         ( W3IOGR )
    !        b Save MAPSTA.
    !        c MPP preparation
    !      3.  Model initialization.
    !        a Read restart file.                 ( W3IORS )
    !        b Compare grid and restart MAPSTA.
    !        c Initialize with winds if requested (set flag).
    !        d Initialize calm conditions if requested.
    !        e Preparations for prop. scheme.
    !      4.  Set-up output times.
    !        a Unpack ODAT.
    !        b Check if output available.
    !        c Get first time per output and overall.
    !        d Prepare point output               ( W3IOPP )
    !      5.  Define wavenumber grid.
    !        a Calculate depth.
    !        b Fill wavenumber and group velocity arrays.
    !      6.  Initialize arrays.
    !      7.  Write info to log file.
    !      8.  Final MPI set up  ( W3MPII , W3MPIO , W3MPIP )
    !     ----------------------------------------------------
    !
    !  9. Switches :
    !
    !       !/SHRD  Switch for shared / distributed memory architecture.
    !       !/DIST  Id.
    !       !/MPI   Id.
    !
    !       !/S     Enable subroutine tracing.
    !       !/Tn    Enable test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    use w3servmd, only : print_memcheck
 
    USE constants
    !/
    USE w3gdatmd, ONLY: w3setg, rstype
    USE w3wdatmd, ONLY: w3setw, w3dimw
    USE w3adatmd, ONLY: w3seta, w3dima
    USE w3idatmd, ONLY: w3seti, w3dimi
    USE w3odatmd, ONLY: w3seto, w3dmo5
    USE w3iogomd, ONLY: w3flgrdupdt
    USE w3iogrmd, ONLY: w3iogr
    USE w3iorsmd, ONLY: w3iors
    USE w3iopomd, ONLY: w3iopp
    USE w3servmd, ONLY: itrace, extcde, wwdate, wwtime
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    USE w3timemd, ONLY: dsec21, tick21, stme21
    USE w3arrymd, ONLY: prtblk
    !/
    USE w3gdatmd, ONLY: nx, ny, nsea, nseal, mapsta, mapst2, mapfs, &
         mapsf, flagll,   &
         iclose, zb, trnx, trny, dmin, dtcfl, dtmax, &
         flck, nk, nth, nspec, sig, gname
#ifdef W3_PDLIB
    USE w3gdatmd, ONLY : flcth, b_jgs_block_gauss_seidel, b_jgs_use_jacobi
#endif
    USE w3wdatmd, ONLY: time, tlev, tice, trho, wlv, ust, ustdir, va
    USE w3odatmd, ONLY: ndso, ndse, ndst, screen, nds, ntproc,      &
         naproc, iaproc, naplog, napout, naperr,     &
         napfld, nappnt, naptrk, naprst, napbpt,     &
         napprt, tofrst, dtout, tonext, tolast,      &
         flout, flogrd, flbpo, nopts, ptnme,         &
         ptloc, iptint, ptifac, undef, idout, flbpi, &
         outpts, fnmpre, ix0, ixn, ixs, iy0, iyn,    &
         iys, flform, iostyp, unipts, upproc, notype,&
         flogr2, nogrp, ngrpp, flogd, flog2
#ifdef W3_NL5
    USE w3odatmd, ONLY: tosnl5
#endif
    USE w3adatmd, ONLY: nsealm, iappro, flcold, fliwnd, dw, cg, wn, &
         ua, ud, u10, u10d, as
#ifdef W3_MPI
    USE w3adatmd, ONLY: mpi_comm_wave, mpi_comm_wcmp
#endif
    USE w3idatmd, ONLY: fllev, flcur, flwind, flice, fltaua, flrhoa,&
         flmdn, flmth, flmvs, flic1, flic2, flic3,   &
         flic4, flic5
    USE w3dispmd, ONLY: wavnu1, wavnu3
    USE w3parall, ONLY: set_up_nseal_nsealm
#ifdef W3_PDLIB
    USE w3parall, ONLY: synchronize_ipgl_etc_array, isea_to_jsea
    use yownodepool, only: npa
    use yowrankmodule, only : rank
#endif
    USE w3gdatmd, ONLY: gtype, ungtype
#ifdef W3_PDLIB
    USE pdlib_w3profsmd, ONLY : pdlib_mapsta_init, set_iobdp_pdlib, pdlib_iobp_init, set_iobpa_pdlib
    USE pdlib_w3profsmd, ONLY : block_solver_init, block_solver_explicit_init, pdlib_init, deallocate_pdlib_global
    use yowdatapool, only: istatus
#endif
#ifdef W3_SETUP
    USE w3wavset, ONLY : preparation_fd_scheme
    USE w3wdatmd, ONLY: zeta_setup
    USE w3gdatmd, ONLY : do_change_wlv
#endif
    USE w3triamd, ONLY: nvectri, area_si, coordmax, spatial_grid
    USE w3gdatmd, ONLY: fsn,fspsi,fsfct,fsnimp, fstotalimp, fstotalexp, xgrd, ygrd
    USE w3gdatmd, ONLY: fsrefraction, fsfreqshift
    USE w3parall, ONLY: init_get_jsea_isproc, init_get_isea
#ifdef W3_TIMINGS
    USE w3parall, ONLY: print_my_time
#endif
#if defined W3_PDLIB && defined W3_DEBUGCOH
    USE pdlib_w3profsmd, ONLY: all_va_integral_print, test_mpi_status
#endif
#if defined W3_PDLIB && defined W3_DEBUGINIT
    USE pdlib_w3profsmd, ONLY: print_wn_statistic
#endif
#ifdef W3_UOST
    USE w3uostmd, ONLY: uost_setgrid
#endif
    !/
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)           :: IMOD, MDS(15), MTRACE(2),      &
         ODAT(40),NPT, IPRT(6),&
         MPI_COMM
    LOGICAL, INTENT(IN)           :: IsMulti
    REAL, INTENT(INOUT)           :: XPT(NPT), YPT(NPT)
    LOGICAL, INTENT(INOUT)        :: FLGRD(NOGRP,NGRPP), FLGD(NOGRP),&
         FLGR2(NOGRP,NGRPP), FLG2(NOGRP),&
         PRTFRM
    CHARACTER, INTENT(IN)         :: FEXT*(*)
    CHARACTER(LEN=40), INTENT(IN) :: PNAMES(NPT)
    LOGICAL, INTENT(IN), OPTIONAL :: FLAGSTIDEIN(4)
    INTEGER                       :: NSEALout, NSEALMout
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    integer :: IRANK, I, ISTAT
    INTEGER                 :: IE, IFL, IFT, IERR, NTTOT, NTLOC,    &
         NTTARG, IK, IP, ITH, IX, IY, &
         J, J0, TOUT(2), TLST(2), ISEA, IS,   &
         K, I1, I2, JSEA, NTTMAX
#ifdef W3_DIST
    INTEGER                 :: ISTEP, ISP, IW
#endif
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI, BGROUP, LGROUP
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_T
    INTEGER                 :: NX0, NXN
    INTEGER, ALLOCATABLE    :: MAPOUT(:,:)
#endif
#ifdef W3_MPI
    INTEGER, ALLOCATABLE    :: TMPRNK(:)
#endif
    INTEGER, ALLOCATABLE    :: NT(:), MAPTST(:,:)
#ifdef W3_T
    INTEGER, SAVE           :: NXS = 49
#endif
    REAL                    :: DTTST, DEPTH, FRACOS
    REAL                    :: FACTOR
    REAL                    :: WLVeff
#ifdef W3_T
    REAL, ALLOCATABLE      :: XOUT(:,:)
#endif
    LOGICAL                 :: OPENED
    CHARACTER(LEN=8)        :: STTIME
    CHARACTER(LEN=10)       :: STDATE
    INTEGER                 :: ISPROC
#ifdef W3_DIST
    CHARACTER(LEN=12)       :: FORMAT
#endif
    CHARACTER(LEN=23)       :: DTME21
    CHARACTER(LEN=30)       :: LFILE, TFILE
#ifdef W3_PDLIB
    INTEGER                 :: IScal(1), IPROC
#endif
    integer                 :: memunit
    !/
    !/ ------------------------------------------------------------------- /
    !
    ! 1.  Set-up of data structures and I/O  ----------------------------- /
    ! 1.a Point to proper data structures.
 
    CALL w3seto ( imod, mds(2), mds(3) )
 
    memunit = 10000+iaproc
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 1a')
 
    CALL w3setg ( imod, mds(2), mds(3) )
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 1b')
 
    CALL w3setw ( imod, mds(2), mds(3) )
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 1c')
 
    CALL w3seta ( imod, mds(2), mds(3) )
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 1d')
 
    CALL w3seti ( imod, mds(2), mds(3) )
#ifdef W3_UOST
    CALL uost_setgrid(imod)
#endif
#ifdef W3_TIMINGS
    CALL print_my_time("Case 2")
#endif
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 1e')
    !
    !
    ! 1.b Number of processors and processor number.
    !     Overwrite some initializations from W3ODATMD.
    !
    !     *******************************************************
    !     *** NOTE : OUTPUT PROCESSOR ASSIGNMENT NEEDS TO BE  ***
    !     ***        CONSISTENT WITH ASSIGNMENT IN WMINIT.    ***
    !     *******************************************************
    !
#ifdef W3_SHRD
    ntproc = 1
    naproc = 1
    iaproc = 1
    iostyp = 1
#endif
    !
#ifdef W3_MPI
    mpi_comm_wave = mpi_comm
    CALL mpi_comm_size ( mpi_comm_wave, ntproc, ierr_mpi )
    naproc = ntproc
    CALL mpi_comm_rank ( mpi_comm_wave, iaproc, ierr_mpi )
    iaproc = iaproc + 1
#endif
    memunit = 10000+iaproc
    !
    IF ( iostyp .LE. 1 ) THEN
      !
      napfld = max(1,naproc-1)
      nappnt = max(1,naproc-2)
      naptrk = max(1,naproc-5)
      naprst = naproc
      napbpt = max(1,naproc-3)
      napprt = max(1,naproc-4)
      !
    ELSE
      !
      nappnt = naproc
      IF ( unipts .AND. upproc ) naproc = max(1,ntproc - 1)
      napfld = naproc
      naprst = naproc
      napbpt = naproc
      naptrk = naproc
      napprt = naproc
      !
      IF ( iostyp .EQ. 2 ) THEN
        naproc = max(1,naproc-1)
      ELSE IF ( iostyp .EQ. 3 ) THEN
        !
        ! For field or coupling output
        !
        IF ( odat( 3).GT.0 .OR.  odat(33).GT.0 ) THEN
          napfld =       naproc
          naproc = max(1,naproc-1)
        END IF
        IF ( odat(13).GT.0 ) THEN
          naptrk =       naproc
          naproc = max(1,naproc-1)
        END IF
        IF ( odat(28).GT.0 ) THEN
          napprt =       naproc
          naproc = max(1,naproc-1)
        END IF
        IF ( odat( 8).GT.0 ) nappnt = naproc
        IF ( odat(18).GT.0 ) naprst = naproc
        IF ( odat(23).GT.0 ) napbpt = naproc
        IF ( ( odat( 8).GT.0 .OR. odat(18).GT.0 .OR.           &
             odat(23).GT.0 ) ) naproc = max(1,naproc-1)
      END IF
    END IF
    !
    fracos = 100. * real(ntproc-naproc) / real(ntproc)
    IF ( fracos.GT.critos .AND. iaproc.EQ.naperr ) WRITE (ndse,8002) fracos
    !
#ifdef W3_MPI
    IF ( naproc .EQ. ntproc ) THEN
      mpi_comm_wcmp = mpi_comm_wave
    ELSE
      CALL mpi_comm_group ( mpi_comm_wave, bgroup, ierr_mpi )
      ALLOCATE ( tmprnk(naproc) )
      DO j=1, naproc
        tmprnk(j) = j - 1
      END DO
      CALL mpi_group_incl ( bgroup, naproc, tmprnk, lgroup, ierr_mpi )
      CALL mpi_comm_create ( mpi_comm_wave, lgroup, mpi_comm_wcmp, ierr_mpi )
      CALL mpi_group_free ( lgroup, ierr_mpi )
      CALL mpi_group_free ( bgroup, ierr_mpi )
      DEALLOCATE ( tmprnk )
    END IF
#endif
    !
    lpdlib = .false.
#ifdef W3_PDLIB
    lpdlib = .true.
#endif
    IF (fstotalimp .and. .NOT. lpdlib) THEN
      WRITE(ndse,*) 'IMPTOTAL is selected'
      WRITE(ndse,*) 'But PDLIB is not'
      CALL flush(ndse)
      stop
    ELSE IF (fstotalexp .and. .NOT. lpdlib) THEN
      WRITE(ndse,*) 'EXPTOTAL is selected'
      WRITE(ndse,*) 'But PDLIB is not'
      CALL flush(ndse)
      stop
    END IF
#ifdef W3_PDLIB
    IF (b_jgs_block_gauss_seidel .AND. .NOT. b_jgs_use_jacobi) THEN
      WRITE(ndse,*) 'B_JGS_BLOCK_GAUSS_SEIDEL is used but the Jacobi solver is not choosen'
      WRITE(ndse,*) .eqv.'Please set JGS_USE_JACOBI  .true.'
      CALL flush(ndse)
      stop
    ENDIF
#endif
 
    !
    ! 1.c Open files without unpacking MDS ,,,
    !
    ie     = len_trim(fext)
    lfile  = 'log.' // fext(:ie)
    ifl    = len_trim(lfile)
#ifdef W3_SHRD
    tfile  = 'test.' // fext(:ie)
#endif
#ifdef W3_DIST
    iw     = 1 + int( log10( real(naproc) + 0.5 ) )
    iw     = max( 3 , min( 9 , iw ) )
    WRITE (FORMAT,'(A5,I1.1,A1,I1.1,A4)')                    &
         '(A4,I', iw, '.', iw, ',2A)'
    WRITE (tfile,format) 'test',                             &
         outpts(imod)%IAPROC, '.', fext(:ie)
#endif
    ift    = len_trim(tfile)
    j      = len_trim(fnmpre)
    !
    IF ( outpts(imod)%IAPROC .EQ. outpts(imod)%NAPLOG ) &
         OPEN (mds(1), file=fnmpre(:j)//lfile(:ifl),err=888,iostat=ierr)
    !
    IF ( mds(3).NE.mds(1) .AND. mds(3).NE.mds(4) .AND. tstout ) THEN
      INQUIRE (mds(3),opened=opened)
      IF ( .NOT. opened ) OPEN (mds(3),file=fnmpre(:j)//tfile(:ift), err=889, &
           iostat=ierr)
    END IF
    !
    ! 1.d Dataset unit numbers
    !
    nds    = mds
    ndso   = nds(1)
    ndse   = nds(2)
    ndst   = nds(3)
    screen = nds(4)
    !
    ! 1.e Subroutine tracing
    !
    CALL itrace ( mtrace(1), mtrace(2) )
    !
    ! 1.f Initial and test outputs
    !
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2')
    !
    IF ( iaproc .EQ. naplog ) THEN
      CALL wwdate ( stdate )
      CALL wwtime ( sttime )
      WRITE (ndso,900) wwver, stdate, sttime
    END IF
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2a')
    !
#ifdef W3_S
    CALL strace (ient, 'W3INIT')
#endif
#ifdef W3_T
    WRITE(ndst,9000) imod, fext(:ie)
    WRITE (ndst,9001) ntproc, naproc, iaproc, naplog, napout,    &
         naperr, napfld, nappnt, naptrk, naprst, napbpt, napprt
    WRITE (ndst,9002) ndso, ndse, ndst, screen
    WRITE (ndst,9003) lfile(:ifl), tfile(:ift)
#endif
    !
    ! 2.  Model definition ---------------------------------------------- /
    ! 2.a Read model definition file
    !
    CALL w3iogr ( 'READ', nds(5), imod, fext )
    IF (gtype .eq. ungtype) THEN
      CALL spatial_grid
      CALL nvectri
      CALL coordmax
#ifdef W3_PDLIB
      IF(.false.) THEN
#endif
        CALL area_si(1)
#ifdef W3_PDLIB
      ENDIF
#endif
    ENDIF
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2b')
#ifdef W3_PDLIB
    IF (gtype .ne. ungtype) THEN
#endif
#ifdef W3_SETUP
      CALL preparation_fd_scheme(imod)
#endif
#ifdef W3_PDLIB
    ELSE
#endif
 
#ifdef W3_PDLIB
      CALL pdlib_init(imod)
#endif
      call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2c')
 
#ifdef W3_TIMINGS
      CALL print_my_time("After PDLIB_INIT")
#endif
 
#ifdef W3_PDLIB
      CALL synchronize_ipgl_etc_array(imod, ismulti)
#endif
      call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2cc')
 
#ifdef W3_PDLIB
    END IF
#endif
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2d')
 
    ! Update of output parameter flags based on mod_def parameters (for 3D arrays)
 
    CALL w3flgrdupdt ( ndso, ndse, flgrd, flgr2, flgd, flg2 )
 
#ifdef W3_TIMINGS
    CALL print_my_time("After W3FLGRDUPDT")
#endif
 
    IF ( flagll ) THEN
      factor = 1.
    ELSE
      factor = 1.e-3
    END IF
    IF ( iaproc .EQ. naplog ) WRITE (ndso,920)
    !
    ! 2.b Save MAPSTA
    !
    ALLOCATE ( maptst(ny,nx) )
    maptst  = mapsta
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2e')
    !
    !
    ! 2.c MPP preparation
    ! 2.c.1 Set simple counters and variables
    !
    CALL set_up_nseal_nsealm(nsealout, nsealmout)
    nseal  = nsealout
    nsealm = nsealmout
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2f')
#ifdef W3_DIST
    IF ( nsea .LT. naproc ) GOTO 820
    IF (lpdlib .eqv. .false.) THEN
      IF ( nspec .LT. naproc ) GOTO 821
    END IF
#endif
 
#ifdef W3_PDLIB
    IF ((iaproc .LE. naproc).and.(gtype .eq. ungtype)) THEN
      CALL block_solver_init(imod)
      CALL pdlib_iobp_init(imod)
      CALL set_iobpa_pdlib
      IF (fstotalexp) THEN
        CALL block_solver_explicit_init()
      ENDIF
    ENDIF
#endif
 
#ifdef W3_TIMINGS
    CALL print_my_time("After BLOCK_SOLVER_INIT")
#endif
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2g')
    !
    !
    ! 2.c.2 Allocate arrays
    !
    IF ( iaproc .LE. naproc ) THEN
      CALL w3dimw ( imod, ndse, ndst )
      call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2h')
    ELSE
      CALL w3dimw ( imod, ndse, ndst, .false. )
      call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2i')
    END IF
#ifdef W3_TIMINGS
    CALL print_my_time("After W3DIMW")
#endif
    CALL w3dima ( imod, ndse, ndst )
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2j')
 
    CALL w3dimi ( imod, ndse, ndst , flagstidein )
#ifdef W3_TIMINGS
    CALL print_my_time("After W3DIMI")
#endif
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 3')
    !
    ! 2.c.3 Calculated expected number of prop. calls per processor
    !
    nttot  = 0
    DO ik=1, nk
      ntloc  = 1 + int(dtmax/(dtcfl*sig(ik)/sig(1))-0.001)
      nttot  = nttot + ntloc*nth
    END DO
    nttarg = 1 + (nttot-1)/naproc
    nttarg = nttarg + int(dtmax/(dtcfl*sig(nk)/sig(1))-0.001)
    nttmax = nttarg + 5
    !
    ! 2.c.4 Initialize IAPPRO
    !
    iappro = 1
    ALLOCATE ( nt(nspec) )
    nt     = nttot
#ifdef W3_DIST
    IF (lpdlib .eqv. .false.) THEN
      !
      DO
        !
        ! 2.c.5 First sweep filling IAPPRO
        !
        DO ip=1, naproc
          istep  = ip
          isp    = 0
          nt(ip) = 0
          DO j=1, 1+nspec/naproc
            isp    = isp + istep
            IF ( mod(j,2) .EQ. 1 ) THEN
              istep  = 2*(naproc-ip) + 1
            ELSE
              istep  = 2*ip - 1
            END IF
            IF ( isp .LE. nspec ) THEN
              ik     = 1 + (isp-1)/nth
              ntloc  = 1 + int(dtmax/(dtcfl*sig(ik)/sig(1))-0.001)
              IF ( nt(ip)+ntloc .LE. nttarg ) THEN
                iappro(isp) = ip
                nt(ip)      = nt(ip) + ntloc
              ELSE
                iappro(isp) = -1
              END IF
            END IF
          END DO
        END DO
        !
        ! 2.c.6 Second sweep filling IAPPRO
        !
        DO ip=1, naproc
          IF ( nt(ip) .LT. nttarg ) THEN
            DO isp=1, nspec
              IF ( iappro(isp) .EQ. -1 ) THEN
                ik     = 1 + (isp-1)/nth
                ntloc  = 1 + int(dtmax/(dtcfl*sig(ik)/sig(1))-0.001)
                IF ( nt(ip)+ntloc .LE. nttarg ) THEN
                  iappro(isp) = ip
                  nt(ip)      = nt(ip) + ntloc
                END IF
              END IF
            END DO
          END IF
        END DO
        !
        ! 2.c.7 Check if all served
        !
        IF ( minval(iappro(1:nspec)) .GT. 0 ) THEN
          EXIT
        ELSE
          nttarg = nttarg + 1
          IF ( nttarg .GE. nttmax ) EXIT
          IF ( iaproc .EQ. naperr ) WRITE (ndse,8028)
        END IF
        !
      END DO
    END IF
#endif
    !
#ifdef W3_TIMINGS
    CALL print_my_time("After Case 14")
#endif
    ! 2.c.8 Test output
    !
#ifdef W3_T
    WRITE (ndst,9020)
    DO ip=1, naproc
      WRITE (ndst,9021) ip, nt(ip), nttarg
    END DO
    !
    WRITE (ndst,9025)
    DO ik=nk, 1, -1
      WRITE (ndst,9026) ik, (iappro(ith+(ik-1)*nth),ith=1,min(24,nth))
      IF ( nth .GT. 24 ) WRITE (ndst,9027) (iappro(ith+(ik-1)*nth),ith=25,nth)
    END DO
#endif
    !
    ! 2.c.9 Test if any spectral points are left out
    !
#ifdef W3_DIST
    IF (lpdlib .eqv. .false.) THEN
      DO isp=1, nspec
        IF ( iappro(isp) .EQ. -1. ) GOTO 829
      END DO
    END IF
#endif
    DEALLOCATE ( nt )
    !
    ! 3.  Model initialization ------------------------------------------- /
    ! 3.a Read restart file
    !
    va(:,:) = 0.
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "Before W3IORS call", 1)
#endif
#ifdef W3_TIMINGS
    CALL print_my_time("Before W3IORS")
#endif
    CALL w3iors ( 'READ', nds(6), sig(nk), imod)
#ifdef W3_TIMINGS
    CALL print_my_time("After W3IORS")
#endif
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 3a')
 
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "After W3IORS call", 1)
#endif
    flcold = rstype.LE.1  .OR. rstype.EQ.4
    IF ( iaproc .EQ. naplog ) THEN
      IF (rstype.EQ.0) THEN
        WRITE (ndso,930) 'cold start (idealized).'
      ELSE IF ( rstype .EQ. 1 ) THEN
        WRITE (ndso,930) 'cold start (wind).'
      ELSE IF ( rstype .EQ. 4 ) THEN
        WRITE (ndso,930) 'cold start (calm).'
      ELSE
        WRITE (ndso,930) 'full restart.'
      END IF
    END IF
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 4.2", 1)
#endif
#ifdef W3_TIMINGS
    CALL print_my_time("After restart inits")
#endif
 
    !
    ! 3.b Compare MAPSTA from grid and restart
    !
    DO ix=1, nx
      DO iy=1, ny
        IF ( abs(mapsta(iy,ix)).EQ.2 .OR.                           &
             abs(maptst(iy,ix)).EQ.2 ) THEN
          mapsta(iy,ix) = sign( maptst(iy,ix) , mapsta(iy,ix) )
        END IF
      END DO
    END DO
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 3b')
    !
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 4.3", 1)
#endif
    !
    ! 3.b2 Set MAPSTA associated to PDLIB
    !
#ifdef W3_PDLIB
    IF (gtype .eq. ungtype) THEN
      CALL pdlib_mapsta_init(imod)
    END IF
#endif
    !
    ! 3.c Initialization from wind fields
    !
    fliwnd = rstype.EQ.1
#ifdef W3_T
    IF ( fliwnd ) WRITE (ndst,9030)
#endif
    !
    ! 3.d Initialization with calm conditions
    !
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 5", 1)
#endif
    IF ( rstype .EQ. 4 ) THEN
      va(:,:) = 0.
#ifdef W3_T
      WRITE (ndst,9031)
#endif
    END IF
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 4')
    !
    ! 3.e Prepare propagation scheme
    !
    IF ( .NOT. flcur ) flck = .false.
#ifdef W3_PDLIB
    IF (fstotalimp .and. fsrefraction) THEN
      flcth = .false.
    END IF
    IF (fstotalimp .and. fsfreqshift) THEN
      flck = .false.
    END IF
#endif
    !
    ! 4.  Set-up output times -------------------------------------------- *
    ! 4.a Unpack ODAT
    !
    DO j=1, notype
      j0 = (j-1)*5
      tonext(1,j) =        odat(j0+1)
      tonext(2,j) =        odat(j0+2)
      dtout(  j) = real( odat(j0+3) )
      tolast(1,j) =        odat(j0+4)
      tolast(2,j) =        odat(j0+5)
    END DO
    !
    ! J=8, second stream of restart files
    j=8
    j0 = (j-1)*5
    IF(odat(j0+1) .NE. 0) THEN
      tonext(1,j) =        odat(j0+1)
      tonext(2,j) =        odat(j0+2)
      dtout(  j) = real( odat(j0+3) )
      tolast(1,j) =        odat(j0+4)
      tolast(2,j) =        odat(j0+5)
      flout(8) = .true.
    ELSE
      flout(8) = .false.
    END IF
    !
    ! 4.b Check if output available
    !
    flout(1) = .false.
    flogrd   = flgrd
    flogd    = flgd
    DO j=1, nogrp
      DO k=1, ngrpp
        flout(1) = flout(1) .OR. flogrd(j,k)
      END DO
    END DO
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 6", 1)
#endif
    !
    flout(7) = .false.
    flogr2   = flgr2
    flog2    = flg2
    DO j=1, nogrp
      DO k=1, ngrpp
        flout(7) = flout(7) .OR. flogr2(j,k)
      END DO
    END DO
    !
    flout(2) = npt .GT. 0
    !
    flout(3) = .true.
    !
    flout(4) = .true.
    !
    flout(5) = flbpo
    IF ( flbpo ) THEN
      CALL w3dmo5 ( imod, ndse, ndst, 4 )
    ELSE
      dtout(5) = 0.
    END IF
    !
    ix0    = max(  1, iprt(1) )
    ixn    = min( nx, iprt(2) )
    ixs    = max(  1, iprt(3) )
    iy0    = max(  1, iprt(4) )
    iyn    = min( ny, iprt(5) )
    iys    = max(  1, iprt(6) )
    flform = prtfrm
    flout(6) = ix0.LE.ixn .AND. iy0.LE.iyn
    !
    ! 4.c Get first time per output and overall.
    !
    tofrst(1) = -1
    tofrst(2) =  0
    !
    !      WRITE(*,*) 'We set NOTYPE=0 just for DEBUGGING'
    !      NOTYPE=0 ! ONLY FOR DEBUGGING PURPOSE
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 7", 1)
#endif
#ifdef W3_TIMINGS
    CALL print_my_time("Before NOTYPE loop")
#endif
    DO j=1, notype
      !
      ! ... check time step
      !
      dtout(j) = max( 0. , dtout(j) )
      flout(j) = flout(j) .AND. ( dtout(j) .GT. 0.5 )
      !
      ! ... get first time
      !
      IF ( flout(j) ) THEN
#ifdef W3_NL5
        IF (j .EQ. 2) tosnl5 = tonext(:, 2)
#endif
        tout = tonext(:,j)
        tlst = tolast(:,j)
        !
        DO
          dttst   = dsec21( time , tout )
          IF ( ( j.NE.4 .AND. dttst.LT.0. ) .OR.                  &
               ( j.EQ.4 .AND. dttst.LE.0. ) ) THEN
            CALL tick21 ( tout, dtout(j) )
          ELSE
            EXIT
          END IF
        END DO
        !
        ! ... reset first time
        !
        tonext(:,j) = tout
        !
        ! ... check last time
        !
        dttst  = dsec21( tout , tlst )
        IF ( dttst.LT.0.) flout(j) = .false.
        !
        ! ... check overall first time
        !
        IF ( flout(j) ) THEN
          IF ( tofrst(1).EQ.-1 ) THEN
            tofrst = tout
          ELSE
            dttst  = dsec21( tout , tofrst )
            IF ( dttst.GT.0.) THEN
              tofrst = tout
            END IF
          END IF
        END IF
        !
      END IF
      !
    END DO
    !
    ! J=8, second stream of restart files
    !
    j=8
    !
    ! ... check time step
    !
    dtout(j) = max( 0. , dtout(j) )
    flout(j) = flout(j) .AND. ( dtout(j) .GT. 0.5 )
    !
    ! ... get first time
    !
    IF ( flout(j) ) THEN
      tout = tonext(:,j)
      tlst = tolast(:,j)
      !
      DO
        dttst   = dsec21( time , tout )
        IF ( ( j.NE.4 .AND. dttst.LT.0. ) .OR.                  &
             ( j.EQ.4 .AND. dttst.LE.0. ) ) THEN
          CALL tick21 ( tout, dtout(j) )
        ELSE
          EXIT
        END IF
      END DO
      !
      ! ... reset first time
      !
      tonext(:,j) = tout
      !
      ! ... check last time
      !
      dttst  = dsec21( tout , tlst )
      IF ( dttst.LT.0.) flout(j) = .false.
      !
      ! ... check overall first time
      !
      IF ( flout(j) ) THEN
        IF ( tofrst(1).EQ.-1 ) THEN
          tofrst = tout
        ELSE
          dttst  = dsec21( tout , tofrst )
          IF ( dttst.GT.0.) THEN
            tofrst = tout
          END IF
        END IF
      END IF
      !
    END IF
    ! END J=8
    !
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 5')
#ifdef W3_TIMINGS
    CALL print_my_time("After NOTYPE loop")
#endif
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 8.1", 1)
#endif
    !
    ! 4.d Preprocessing for point output.
    !
    IF ( flout(2) ) CALL w3iopp ( npt, xpt, ypt, pnames, imod )
#ifdef W3_PDLIB
    CALL deallocate_pdlib_global(imod)
#endif
    !
#ifdef W3_T
    WRITE (ndst,9040)
    DO j=1, 5
      WRITE (ndst,9041) tonext(1,j),tonext(2,j),dtout(j),flout(j)
    END DO
    WRITE (ndst,9042)
    WRITE (ndst,9043) tofrst
#endif
    !
    ! 5.  Define wavenumber grid ----------------------------------------- *
    ! 5.a Calculate depth
    !
#ifdef W3_T
    ALLOCATE ( mapout(nx,ny), xout(nx,ny) )
    xout = -1.
#endif
    !
    maptst = mod(mapst2/2,2)
    mapst2 = mapst2 - 2*maptst
 
    !
    !Li   For multi-resolution SMC grid, these 1-NX and 1-NY nested loops
    !Li   may miss the refined cells as they are not 1-1 corresponding to
    !Li   the (Nx,NY) regular grid.  The loop is now modified to run over
    !Li   full NSEA points.   JGLi24Jan2012
    !Li   DO IY=1, NY
    !Li     DO IX=1, NX
    !Li       ISEA   = MAPFS(IY,IX)
#ifdef W3_DEBUGSTP
    max_val = 0
    min_val = 0
#endif
    DO isea=1, nsea
      ix = mapsf(isea,1)
      iy = mapsf(isea,2)
#ifdef W3_T
      mapout(ix,iy) = mapsta(iy,ix)
#endif
      !Li     IF ( ISEA .NE. 0) THEN
      wlveff=wlv(isea)
#ifdef W3_SETUP
      IF (do_change_wlv) THEN
        wlveff=wlveff + zeta_setup(isea)
      END IF
#endif
#ifdef W3_DEBUGSTP
      max_val = max(max_val, wlveff)
      min_val = min(min_val, wlveff)
#endif
      dw(isea) = max( 0. , wlveff-zb(isea) )
#ifdef W3_T
      xout(ix,iy) = dw(isea)
#endif
      IF ( wlveff-zb(isea) .LE.0. ) THEN
        maptst(iy,ix) = 1
        mapsta(iy,ix) = -abs(mapsta(iy,ix))
      END IF
      !Li     END IF
    END DO
    !Li   END DO
#ifdef W3_DEBUGSTP
    WRITE(740+iaproc,*) 'w3initmd 1: max/min(WLVeff)=', max_val, min_val
    FLUSH(740+iaproc)
    max_val = 0
    min_val = 0
#endif
    DO jsea=1, nseal
      CALL init_get_isea(isea, jsea)
      wlveff=wlv(isea)
#ifdef W3_SETUP
      IF (do_change_wlv) THEN
        wlveff=wlveff + zeta_setup(isea)
      END IF
#endif
#ifdef W3_DEBUGSTP
      max_val = max(max_val, wlveff)
      min_val = min(min_val, wlveff)
#endif
      dw(isea) = max( 0. , wlveff-zb(isea) )
      IF ( wlveff-zb(isea) .LE.0. ) THEN
        va(:,jsea) = 0.
      END IF
    END DO
#ifdef W3_DEBUGSTP
    WRITE(740+iaproc,*) 'w3initmd 2: max/min(WLVeff)=', max_val, min_val
    FLUSH(740+iaproc)
#endif
    !
#ifdef W3_PDLIB
    IF ( iaproc .LE. naproc ) THEN
      CALL set_iobdp_pdlib
    ENDIF
#endif
 
    !
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 8.2", 1)
#endif
 
    !
    mapst2 = mapst2 + 2*maptst
    !
    DEALLOCATE ( maptst )
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 6')
    !
#ifdef W3_T
    WRITE (ndst,9050)
    nx0    = 1
    DO
      nxn    = min( nx0+nxs-1 , nx )
      CALL prtblk (ndst, nx, ny, nx, xout, mapout, 0, 0., nx0, nxn, 1, 1, &
           ny, 1, 'Depth', 'm')
      IF ( nxn .NE. nx ) THEN
        nx0    = nx0 + nxs
      ELSE
        EXIT
      END IF
    END DO
    DEALLOCATE ( mapout, xout )
#endif
#ifdef W3_TIMINGS
    CALL print_my_time("Before section 5.b")
#endif
    !
    ! 5.b Fill wavenumber and group velocity arrays.
    !
    DO is=0, nsea
      IF (is.GT.0) THEN
        depth  = max( dmin , dw(is) )
      ELSE
        depth = dmin
      END IF
      !
#ifdef W3_T1
      WRITE (ndst,9051) is, depth
#endif
      !
      DO ik=0, nk+1
        !
        !         Calculate wavenumbers and group velocities.
#ifdef W3_PDLIB
        CALL wavnu3(sig(ik),depth,wn(ik,is),cg(ik,is))
#else
        CALL wavnu1(sig(ik),depth,wn(ik,is),cg(ik,is))
#endif
        !
#ifdef W3_T1
        WRITE (ndst,9052) ik, tpi/sig(ik), wn(ik,is), cg(ik,is)
#endif
        !
      END DO
    END DO
 
    !
    ! 6.  Initialize arrays ---------------------------------------------- /
    !     Some initialized in W3IORS
    !
    ua     = 0.
    ud     = 0.
    u10    = 0.
    u10d   = 0.
    !
    as     = undef
    !
    as(0) = 0.
    dw(0) = 0.
    !
    ! 7.  Write info to log file ----------------------------------------- /
    !
    IF ( iaproc .EQ. naplog ) THEN
      !
      WRITE (ndso,970) gname
      IF (   fllev    ) WRITE (ndso,971) 'Prescribed'
      IF (.NOT. fllev ) WRITE (ndso,971) 'No'
      IF (   flcur    ) WRITE (ndso,972) 'Prescribed'
      IF (.NOT. flcur ) WRITE (ndso,972) 'No'
      IF (   flwind   ) WRITE (ndso,973) 'Prescribed'
      IF (.NOT. flwind) WRITE (ndso,973) 'No'
      IF (   flice    ) WRITE (ndso,974) 'Prescribed'
      IF (.NOT. flice ) WRITE (ndso,974) 'No'
      IF (   fltaua   ) WRITE (ndso,988) 'Prescribed'
      IF (.NOT. fltaua) WRITE (ndso,988) 'No'
      IF (   flrhoa   ) WRITE (ndso,989) 'Prescribed'
      IF (.NOT. flrhoa) WRITE (ndso,989) 'No'
      !
      IF (   flmdn    ) WRITE (ndso,9972) 'Prescribed'
      IF (.NOT. flmdn ) WRITE (ndso,9972) 'No'
      IF (   flmth    ) WRITE (ndso,9971) 'Prescribed'
      IF (.NOT. flmth ) WRITE (ndso,9971) 'No'
      IF (   flmvs    ) WRITE (ndso,9970) 'Prescribed'
      IF (.NOT. flmvs ) WRITE (ndso,9970) 'No'
 
      IF (   flic1    ) WRITE (ndso,9973) 'Prescribed'
      IF (.NOT. flic1 ) WRITE (ndso,9973) 'No'
      IF (   flic2    ) WRITE (ndso,9974) 'Prescribed'
      IF (.NOT. flic2 ) WRITE (ndso,9974) 'No'
      IF (   flic3    ) WRITE (ndso,9975) 'Prescribed'
      IF (.NOT. flic3 ) WRITE (ndso,9975) 'No'
      IF (   flic4    ) WRITE (ndso,9976) 'Prescribed'
      IF (.NOT. flic4 ) WRITE (ndso,9976) 'No'
      IF (   flic5    ) WRITE (ndso,9977) 'Prescribed'
      IF (.NOT. flic5 ) WRITE (ndso,9977) 'No'
 
      IF ( flout(1) ) THEN
        WRITE (ndso,975)
        DO j=1,nogrp
          DO k=1,ngrpp
            IF ( flogrd(j,k) ) WRITE (ndso,976) idout(j,k)
          END DO
        END DO
      END IF
      !
      IF ( flout(7) ) THEN
        WRITE (ndso,987)
        DO j=1,nogrp
          DO k=1,ngrpp
            IF ( flogr2(j,k) ) WRITE (ndso,976) idout(j,k)
          END DO
        END DO
      END IF
      !
      IF ( flout(2) ) THEN
        WRITE (ndso,977) nopts
        IF ( nopts .EQ. 0 ) THEN
          WRITE (ndso,978)
        ELSE
          IF ( flagll ) THEN
            WRITE (ndso,979)
          ELSE
            WRITE (ndso,985)
          END IF
          DO ip=1, nopts
            IF ( flagll ) THEN
              WRITE (ndso,980) ip, factor*ptloc(1,ip), factor*ptloc(2,ip), ptnme(ip)
            ELSE
              WRITE (ndso,986) ip, factor*ptloc(1,ip), factor*ptloc(2,ip), ptnme(ip)
            END IF
          END DO
        END IF
      END IF
      !
      CALL stme21 ( time , dtme21 )
      WRITE (ndso,981) dtme21
      IF (fllev) THEN
        CALL stme21 ( tlev , dtme21 )
        WRITE (ndso,982) dtme21
      END IF
      IF (flice) THEN
        CALL stme21 ( tice , dtme21 )
        WRITE (ndso,983) dtme21
      END IF
      IF (flrhoa) THEN
        CALL stme21 ( trho , dtme21 )
        WRITE (ndso,990) dtme21
      END IF
      !
      WRITE (ndso,984)
      !
    END IF
    !
    IF ( nopts .EQ. 0 ) flout(2) = .false.
    call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 7 - After allocation of group velocities')
    !
    ! Boundary set up for the directions
    !
#ifdef W3_DEBUGCOH
    CALL all_va_integral_print(imod, "W3INIT, step 8.3", 1)
#endif
    !
    ! 8.  Final MPI set up ----------------------------------------------- /
    !
#ifdef W3_MPI
    CALL w3mpii ( imod )
    CALL w3mpio ( imod )
    IF ( flout(2) ) CALL w3mpip ( imod )
#endif
    !
#ifdef W3_DEBUGINIT
    CALL print_wn_statistic("W3INIT leaving")
#endif
#ifdef W3_TIMINGS
    CALL print_my_time("Leaving W3INIT")
#endif
    RETURN
    !
    ! Escape locations read errors :
    !
#ifdef W3_DIST
820 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,8020) nsea, naproc
    CALL extcde ( 820 )
    !
821 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,8021) nspec, naproc
    CALL extcde ( 821 )
    !
829 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,8029)
    CALL extcde ( 829 )
#endif
 
    !
888 CONTINUE
    IF ( iaproc .EQ. naperr ) WRITE (ndse,8000) ierr
    CALL extcde ( 1 )
    !
889 CONTINUE
    ! === no process number filtering for test file !!! ===
    WRITE (ndse,8001) ierr
    CALL extcde ( 2 )
    !
    ! Formats
    !
900 FORMAT ( ' WAVEWATCH III log file            ',             &
         '                     version ',a/                     &
         ' ==================================',                 &
         '==================================='/                 &
         50x,'date : ',a10/50x,'time :  ',a8)
920 FORMAT (/' Model definition file read.')
930 FORMAT ( ' Restart file read; ',a)
    !
970 FORMAT (/' Grid name : ',a)
971 FORMAT (/' ',a,' water levels.')
972 FORMAT ( ' ',a,' curents.')
973 FORMAT ( ' ',a,' winds.')
974 FORMAT ( ' ',a,' ice fields.')
988 FORMAT ( ' ',a,' momentum')
989 FORMAT ( ' ',a,' air density')
9972 FORMAT( ' ',a,' mud density.')
9971 FORMAT( ' ',a,' mud thickness.')
9970 FORMAT( ' ',a,' mud viscosity.')
9973 FORMAT( ' ',a,' ice parameter 1')
9974 FORMAT( ' ',a,' ice parameter 2')
9975 FORMAT( ' ',a,' ice parameter 3')
9976 FORMAT( ' ',a,' ice parameter 4')
9977 FORMAT( ' ',a,' ice parameter 5')
    !
975 FORMAT (/' Gridded output fields : '/                            &
         '--------------------------------------------------')
976 FORMAT ( '     ',a)
    !
977 FORMAT (/' Point output requested for',i6,' points : '/          &
         '------------------------------------------')
978 FORMAT (/'      Point output disabled')
979 FORMAT                                                           &
         (/'      point  |  longitude  |   latitude  |  name  '/     &
         '     --------|-------------|-------------|----------------')
985 FORMAT                                                           &
         (/'      point  |      X      |      Y      |  name  '/     &
         '     --------|-------------|-------------|----------------')
980 FORMAT ( 5x,i5,'   |',2(f10.2,'   |'),2x,a)
986 FORMAT ( 5x,i5,'   |',2(f8.1,'E3   |'),2x,a)
    !
981 FORMAT (/' Initial time     : ',a)
982 FORMAT ( ' Water level time : ',a)
983 FORMAT ( ' Ice field time   : ',a)
990 FORMAT ( ' Air density time : ',a)
    !
984 FORMAT (//                                                       &
         37x,'  |         input         |      output      |'/       &
         37x,'  |-----------------------|------------------|'/       &
         2x,'   step | pass |    date      time   |',                &
         ' b w l c t r i i1 i5 d | g p t r b f c r2 |'/              &
         2x,'--------|------|---------------------|',                &
         '-----------------------|------------------|'/              &
         2x,'--------+------+---------------------+',                &
         '---------------------------+--------------+')
987 FORMAT (/' Coupling output fields : '/                           &
         '--------------------------------------------------')
    !
8000 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/               &
         '     ERROR IN OPENING LOG FILE'/                           &
         '     IOSTAT =',i5/)
8001 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/               &
         '     ERROR IN OPENING TEST FILE'/                          &
         '     IOSTAT =',i5/)
8002 FORMAT (/' *** WAVEWATCH III WARNING IN W3INIT : '/             &
         '     SIGNIFICANT PART OF RESOURCES RESERVED FOR',          &
         ' OUTPUT :',f6.1,'%'/)
#ifdef W3_DIST
8020 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/               &
         '     NUMBER OF SEA POINTS LESS THAN NUMBER OF PROC.'/      &
         '     NSEA, NAPROC =',2i8/)
8021 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/               &
         '     NUMBER OF SPECTRAL POINTS LESS THAN NUMBER OF PROC.'/ &
         '     NSPEC, NAPROC =',2i8/)
8028 FORMAT (/' *** WAVEWATCH III WARNING IN W3INIT : '/             &
         '     INCREASING TARGET IN MPP PROPAGATION MAP.'/           &
         '     IMBALANCE BETWEEN OVERALL AND CFL TIME STEPS'/)
8029 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/               &
         '     SOMETHING WRONG WITH MPP PROPAGATION MAP.'/           &
         '     CALL HENDRIK !!!'/)
#endif
    !
#ifdef W3_T
9000 FORMAT ( 'TEST W3INIT: MOD. NR. AND FILE EXT.: ',i4,' [',a,']')
9001 FORMAT ( '             NR. OF PROCESSORS     : ',3i4/        &
         '             ASSIGNED PROCESSORS     ',9i4)
9002 FORMAT ( '             DATA SET NUMBERS      : ',4i4)
9003 FORMAT ( '             LOG FILE              : [',a,']'/     &
         '             TEST FILE             : [',a,']')
    !
9020 FORMAT (' TEST W3INIT : IP, NTTOT, NTTARG :')
9021 FORMAT ( '         ',3i8)
9025 FORMAT (' TEST W3INIT : MPP PROPAGATION MAP SPECTRAL COMP.')
9026 FORMAT (4x,i4,2x,24i4)
9027 FORMAT (10x,24i4)
    !
9030 FORMAT (' TEST W3INIT : INITIALIZATION USING WINDS, ',       &
         'PERFORMED IN W3WAVE')
9031 FORMAT (' TEST W3INIT : STARTING FROM CALM CONDITIONS')
    !
9040 FORMAT (' TEST W3INIT : OUTPUT DATA, FIRST TIME, STEP, FLAG')
9041 FORMAT ('              ',i9.8,i7.6,f8.1,3x,l1)
9042 FORMAT (' TEST W3INIT : FIRST TIME :')
9043 FORMAT ('              ',i9.8,i7.6)
    !
9050 FORMAT (' TEST W3INIT : INITIAL DEPTHS')
#endif
#ifdef W3_T1
9051 FORMAT (' TEST W3INIT : ISEA =',i6,'  DEPTH =',f7.1,         &
         '  IK, T, K, CG :')
9052 FORMAT ('               ',i3,f8.2,f8.4,f8.2)
#endif
    !/
    !/ End of W3INIT ----------------------------------------------------- /
    !/
  END SUBROUTINE w3init
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3mpii ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         11-May-2007 |
    !/                  +-----------------------------------+
    !/
    !/    04-Jan-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
    !/    13-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    28-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/                  Taken out of W3WAVE.
    !/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
    !/    13-Jun-2006 : Splitting STORE in G/SSTORE.        ( version 3.09 )
    !/    11-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/
    !  1. Purpose :
    !
    !     Perform initializations for MPI version of model.
    !     Data transpose only.
    !
    !  2. Method :
    !
    !     Some derived data types are defined.  All communiction in
    !     W3GATH, W3SCAT and W3WAVE are initialized so that all
    !     communication can be performed with single MPI_STARTALL,
    !     MPI_TESTALL and MPI_WAITALL calls.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !
    !      MPI_TYPE_VECTOR, MPI_TYPE_COMMIT
    !                Subr. mpif.h   MPI derived data type routines.
    !
    !      MPI_SEND_INIT, MPI_RECV_INIT
    !                Subr. mpif.h   MPI persistent communication calls.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3INIT    Subr. W3INITMD Wave model initialization routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     None.
    !
    !  7. Remarks :
    !
    !     - Basic MPP set up partially performed in W3INIT.
    !     - Each processor has to be able to send out individual error
    !       messages in this routine !
    !     - No testing on IMOD, since only called by W3INIT.
    !     - In version 3.09 STORE was split into a send and receive
    !       buffer, to avoid/reduce possible conflicts between the FORTRAN
    !       and MPI standards when a gather is posted in a given buffer
    !       right after a send is completed.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD  Switch for shared / distributed memory architecture.
    !       !/DIST  Id.
    !       !/MPI   MPI communication calls.
    !
    !       !/S     Subroutine tracing,
    !       !/T     Test output, general.
    !       !/MPIT  Test output, MPI communications details.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    USE w3gdatmd, ONLY: nsea
    USE w3adatmd, ONLY: nsealm
    USE w3gdatmd, ONLY: gtype, ungtype
    USE constants, ONLY: lpdlib
#ifdef W3_MPI
    USE w3gdatmd, ONLY: nspec
    USE w3wdatmd, ONLY: va
    USE w3adatmd, ONLY: mpi_comm_wave, ww3_field_vec,         &
         ww3_spec_vec, iappro, wadats,         &
         nrqsg1, irqsg1, nrqsg2, irqsg2,       &
         gstore, sstore, mpibuf, bstat,        &
         bispl, isploc, ibfloc, nsploc
#endif
    USE w3odatmd, ONLY: ndst, naproc, iaproc
    !/
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: NXXXX
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI, ISP, IH, ITARG,       &
         IERR1, IERR2, IP
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3MPII')
#endif
    !
    ! 1.  Set up derived data types -------------------------------------- /
    !
    nxxxx  = nsealm * naproc
    !
#ifdef W3_MPI
    CALL mpi_type_vector ( nsealm, 1, naproc, mpi_real, ww3_field_vec, ierr_mpi )
    CALL mpi_type_vector ( nsealm, 1, nspec, mpi_real, ww3_spec_vec, ierr_mpi )
    CALL mpi_type_commit ( ww3_field_vec, ierr_mpi )
    CALL mpi_type_commit ( ww3_spec_vec, ierr_mpi )
#endif
    !
#ifdef W3_MPIT
    WRITE (ndst,9010) ww3_field_vec, ww3_spec_vec
#endif
    !
#ifdef W3_MPI
    IF( iaproc .GT. naproc ) THEN
      nsploc = 0
      nrqsg1 = 0
      nrqsg2 = 0
#endif
#ifdef W3_MPIT
      WRITE (ndst,9011)
#endif
#ifdef W3_MPI
      RETURN
    END IF
#endif
    !
    ! 2.  Set up scatters and gathers for W3WAVE ------------------------- /
    !     ( persistent communication calls )
    !
#ifdef W3_DIST
    IF (lpdlib .eqv. .false.) THEN
#endif
#ifdef W3_MPI
      nsploc = 0
      DO isp=1, nspec
        IF ( iappro(isp) .EQ. iaproc ) nsploc = nsploc + 1
      END DO
      !
      nrqsg1 = nspec - nsploc
      ALLOCATE ( wadats(imod)%IRQSG1(max(1,nrqsg1),2) )
      irqsg1 => wadats(imod)%IRQSG1
      ih     = 0
#endif
      !
#ifdef W3_MPIT
      WRITE (ndst,9021)
#endif
#ifdef W3_MPI
      DO isp=1, nspec
        IF ( iappro(isp) .NE. iaproc ) THEN
          itarg  = iappro(isp) - 1
          ih     = ih + 1
          CALL mpi_send_init ( va(isp,1), 1, ww3_spec_vec, itarg, isp, mpi_comm_wave, &
               irqsg1(ih,1), ierr1 )
          CALL mpi_recv_init ( va(isp,1), 1, ww3_spec_vec, itarg, isp, mpi_comm_wave, &
               irqsg1(ih,2), ierr2 )
#endif
#ifdef W3_MPIT
          WRITE (ndst,9022) ih, isp, itarg+1, irqsg1(ih,1), ierr1, irqsg1(ih,2), ierr2
#endif
#ifdef W3_MPI
        END IF
      END DO
#endif
#ifdef W3_MPIT
      WRITE (ndst,9023)
      WRITE (ndst,9020) nrqsg1
#endif
      !
      ! 3.  Set up scatters and gathers for W3SCAT and W3GATH -------------- /
      !     Also set up buffering of data.
      !
#ifdef W3_MPI
      nrqsg2 = max( 1 , naproc-1 )
      ALLOCATE ( wadats(imod)%IRQSG2(nrqsg2*nsploc,2), &
           wadats(imod)%GSTORE(naproc*nsealm,mpibuf),  &
           wadats(imod)%SSTORE(naproc*nsealm,mpibuf) )
      nrqsg2 = naproc - 1
      !
      irqsg2 => wadats(imod)%IRQSG2
      gstore => wadats(imod)%GSTORE
      sstore => wadats(imod)%SSTORE
      !
      ih     = 0
      isploc = 0
      ibfloc = 0
      wadats(imod)%GSTORE = 0.
      wadats(imod)%SSTORE = 0.
#endif
      !
      ! 3.a Loop over local spectral components
      !
#ifdef W3_MPIT
      WRITE (ndst,9031)
#endif
      !
#ifdef W3_MPI
      DO isp=1, nspec
        IF ( iappro(isp) .EQ. iaproc ) THEN
          !
          isploc = isploc + 1
          ibfloc = ibfloc + 1
          IF ( ibfloc .GT. mpibuf ) ibfloc = 1
          !
          ! 3.b Loop over non-local processes
          !
          DO ip=1, naproc
            IF ( ip .NE. iaproc ) THEN
              !
              itarg  = ip - 1
              ih     = ih + 1
              !
              CALL mpi_recv_init ( wadats(imod)%GSTORE(ip,ibfloc), 1, ww3_field_vec, &
                   itarg, isp, mpi_comm_wave, irqsg2(ih,1), ierr2 )
              CALL mpi_send_init ( wadats(imod)%SSTORE(ip,ibfloc), 1, ww3_field_vec, &
                   itarg, isp, mpi_comm_wave, irqsg2(ih,2), ierr2 )
#endif
#ifdef W3_MPIT
              WRITE (ndst,9032) ih, isp, itarg+1, ibfloc, irqsg2(ih,1), ierr1, &
                   irqsg2(ih,2), ierr2
#endif
              !
              ! ... End of loops
              !
#ifdef W3_MPI
            END IF
          END DO
          !
        END IF
      END DO
#endif
      !
#ifdef W3_MPIT
      WRITE (ndst,9033)
      WRITE (ndst,9030) nsploc, nrqsg2, ih
#endif
      !
      ! 4.  Initialize buffer management ----------------------------------- /
      !
#ifdef W3_MPI
      bstat  = 0
      bispl  = 0
      isploc = 0
      ibfloc = 0
#endif
      !
#ifdef W3_DIST
    END IF
#endif
    RETURN
    !
    ! Format statements
    !
#ifdef W3_MPIT
9010 FORMAT ( ' TEST W3MPII: DATA TYPES DEFINED'/                 &
         '              WW3_FIELD_VEC : ',i10/                    &
         '              WW3_SPEC_VEC  : ',i10)
9011 FORMAT ( ' TEST W3MPII: NO COMPUTATIONS ON THIS NODE')
9020 FORMAT ( ' TEST W3MPII: W3WAVE COMM. SET UP FINISHED'/       &
         '              NRQSG1        : ',i10)
9021 FORMAT (/' TEST W3MPII: COMMUNICATION CALLS FOR W3WAVE '/    &
         ' +------+------+------+--------------+--------------+'/ &
         ' |  IH  |  ISP | TARG |    SCATTER   |    GATHER    |'/ &
         ' |      |      |      |   handle err |   handle err |'/ &
         ' +------+------+------+--------------+--------------+')
9022 FORMAT ( ' |',3(i5,' |'),2(i9,i4,' |'))
9023 FORMAT (                                                     &
         ' +------+------+------+--------------+--------------+'/)
9030 FORMAT ( ' TEST W3MPII: GATH/SCAT COMM. SET UP FINISHED'/    &
         '              NSPLOC        : ',i10/                    &
         '              NRQSG2        : ',i10/                    &
         '              TOTAL REQ.    : ',i10/)
9031 FORMAT (/' TEST W3MPII: COMM. CALLS FOR W3GATH/W3SCAT '/     &
         ' +------+------+------+------+--------------+',         &
         '--------------+'/                                       &
         ' |  IH  |  ISP | TARG | IBFR |     GATHER   |',         &
         '    SCATTER   |'/                                       &
         ' |      |      |      |      |   handle err |',         &
         '   handle err |'/                                       &
         ' +------+------+------+------+--------------+',         &
         '--------------+')
9032 FORMAT ( ' |',4(i5,' |'),2(i9,i4,' |'))
9033 FORMAT ( ' +------+------+------+------+--------------+',    &
         '--------------+'/)
#endif
    !/
    !/ End of W3MPII ----------------------------------------------------- /
    !/
  END SUBROUTINE w3mpii
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3mpio ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         11-Nov-2015 |
    !/                  +-----------------------------------+
    !/
    !/    17-Mar-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
    !/    11-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    20-Aug-2003 : Output server options added.        ( version 3.04 )
    !/    28-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/                  Taken out of W3WAVE.
    !/    03-Jan-2005 : Add US2x to MPI communication.      ( version 3.06 )
    !/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
    !/    21-Jul-2005 : Add output fields.                  ( version 3.07 )
    !/    04-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
    !/    02-Aug-2006 : W3MPIP split off.                   ( version 3.10 )
    !/    02-Apr-2007 : Add partitioned field data.         ( version 3.11 )
    !/                  Add user-defined field data.
    !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/    21-Jun-2007 : Dedicated output processes.         ( version 3.11 )
    !/    25-Dec-2012 : Modify field output MPI for new     ( version 4.11 )
    !/                  structure and smaller memory footprint.
    !/    02-Jul-2013 : Bug fix MPI_FLOAT -> MPI_REAL.      ( version 4.11 )
    !/    11-Nov-2015 : Added ICEF                          ( version 5.08 )
    !/
    !  1. Purpose :
    !
    !     Prepare MPI persistent communication needed for WAVEWATCH I/O
    !     routines.
    !
    !  2. Method :
    !
    !     Create handles as needed.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3XDMA    Subr. W3ADATMD Dimension expanded output arrays.
    !      W3SETA    Subr.    "     Set pointers for output arrays
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !
    !      MPI_SEND_INIT, MPI_RECV_INIT
    !                Subr. mpif.h   MPI persistent communication calls.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3INIT    Subr. W3INITMD Wave model initialization routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !     - The communication as set up in W3MPII uses tags with number
    !       ranging from 1 through NSPEC. New and unique tags for IO
    !       related communication are assigned here dynamically.
    !     - No testing on IMOD, since only called by W3INIT.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/MPI   MPI communication calls.
    !
    !       !/S     Enable subroutine tracing.
    !       !/MPIT  Enable test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
#ifdef W3_MPI
    USE w3adatmd, ONLY: w3xdma, w3seta, w3xeta
    USE w3iorsmd, ONLY: oarst
#endif
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !/
    USE w3gdatmd, ONLY: nsea
    USE w3adatmd, ONLY: nsealm
#ifdef W3_MPI
    USE w3gdatmd, ONLY: nx, nspec, mapfs, e3df, p2msf, us3df, usspf
    USE w3wdatmd, ONLY: va, ust, ustdir, asf, fpis, icef
    USE w3adatmd, ONLY: mpi_comm_wave, ww3_field_vec
    USE w3adatmd, ONLY: hs, wlm, t02
#endif
 
 
#ifdef W3_MPI
    USE w3adatmd, ONLY: t0m1, thm, ths, fp0, thp0, &
         dtdyn, fcut, sppnt, aba, abd, uba, ubd,   &
         sxx, syy, sxy, usero, phs, ptp, plp,      &
         pdir, psi, pws, pwst, pnr, phiaw, phioc,  &
         tusx, tusy, tauwix, tauwiy, tauox,        &
         tauoy, ussx, ussy, mssx, mssy, mssd,      &
         mscx, mscy, mscd, prms, tpms, charn,      &
         tws, tauwnx, tauwny, bhd, cge,            &
         cflxymax, cflthmax, cflkmax, whitecap,    &
         bedforms, phibbl, taubbl, t01,            &
         p2sms, us3d, ef,  th1m, sth1m, th2m,      &
         sth2m, hsig, phice, tauice, ussp,         &
         stmaxe, stmaxd, hmaxe, hcmaxe, hmaxd,     &
         hcmaxd, qp, pthp0, pqp, ppe, pgw, psw,    &
         ptm1, pt1, pt2, pep, wbt, cx, cy,         &
         tauocx, tauocy, wnmean, qkk, skew, embia1, embia2
#endif
 
#ifdef W3_MPI
    USE w3gdatmd, ONLY: nk
    USE w3odatmd, ONLY: ndst, iaproc, naproc, ntproc, flout,  &
         napfld, nappnt, naprst, napbpt, naptrk,              &
         nogrp, ngrpp, noge, flogrr
    USE w3odatmd, ONLY: outpts, nrqgo, nrqgo2, irqgo, irqgo2, &
         flogrd, nrqpo, nrqpo2, irqpo1, irqpo2,               &
         nopts, iptint, nrqrs, irqrs, nblkrs,                 &
         rsblks, irqrss, vaaux, nrqbp, nrqbp2,                &
         irqbp1, irqbp2, nfbpo, nbo2, isbpo,                  &
         abpos, nrqtr, irqtr, it0pnt, it0trk,                 &
         it0prt, noswll, noextr, ndse, iostyp,                &
         flogr2
    USE w3parall, ONLY : init_get_jsea_isproc
#endif
    USE w3gdatmd, ONLY: gtype, ungtype
    USE constants, ONLY: lpdlib
    !/
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_MPI
    INTEGER                 :: IK, IFJ
    INTEGER                 :: IH, IT0, IROOT, IT, IERR, I0,   &
         IFROM, IX(4), IY(4), IS(4),     &
         IP(4), I, J, JSEA, ITARG, IB,   &
         JSEA0, JSEAN, NSEAB, IBOFF,     &
         ISEA, ISPROC, K, NRQMAX
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT
#endif
#ifdef W3_MPI
    LOGICAL                 :: FLGRDALL(NOGRP,NGRPP)
    LOGICAL                 :: FLGRDARST(NOGRP,NGRPP)
#endif
#ifdef W3_MPIT
    CHARACTER(LEN=5)      :: STRING
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3MPIO')
#endif
    !
    ! 1.  Set-up for W3IOGO ---------------------------------------------- /
    !
#ifdef W3_MPI
    DO j=1, nogrp
      DO k=1, ngrpp
        flgrdall(j,k) =  (flogrd(j,k) .OR. flogr2(j,k))
        flgrdarst(j,k) =  (flgrdall(j,k) .OR. flogrr(j,k))
      END DO
    END DO
    !
    nrqgo  = 0
    nrqgo2 = 0
    it0    = nspec
    iroot  = napfld - 1
    !
    !
    IF ((flout(1) .OR. flout(7)) .and. (.not. lpdlib)) THEN
      !
      ! NRQMAX is the maximum number of output fields that require MPI communication,
      ! aimed to gather field values stored in each processor into one processor in
      ! charge of model output; for each of such fields, this routine requires one
      ! call to MPI_SEND_INIT and MPI_RECV_INIT storing the communication request
      ! handles in the vectors IRQGO and IRQGO2 respectively.
      ! NRQMAX is calculated as the sum of all fields described before (Hs)
      !    + 2 or 3 component fields (CUR) + 3 component fields + extra fields
      ! For group 1 fields except ICEF, all processors contain information on all
      ! grid points because they are input fields, and therefore this MPI
      ! communication is not necessary and they do not contribute to NRQMAX.
      !
      ! Calculation of NRQMAX splitted by output groups and field type
      !       scalar                2-comp   3-comp
      nrqmax =   1           +    0  +    0  +  &  ! group 1
           18                +    0  +    0  +  &  ! group 2
           0                 +    0  +    0  +  &  ! group 3 (extra contributions below)
           2+(noge(4)-2)*(noswll+1) +    0  +    0  +  &  ! group 4
           11                +    3  +    1  +  &  ! group 5
           12                +    7  +    1  +  &  ! group 6 (extra contributions below)
           5                 +    4  +    1  +  &  ! group 7
           5                 +    2  +    0  +  &  ! group 8
           5                 +    0  +    0  +  &  ! group 9
           noextr            +    0  +    0        ! group 10
 
      ! Extra contributions to NRQMAX from group 3
      DO ifj=1,5
        IF ( flgrdall( 3,ifj)) nrqmax = nrqmax + e3df(3,ifj) - e3df(2,ifj) + 1
      END DO
      ! Extra contributions to NRQMAX from group 6
      IF ( flgrdall( 6,9)) nrqmax = nrqmax + p2msf(3) - p2msf(2) + 1
      IF ( flgrdall( 6, 8) ) nrqmax = nrqmax + 2*nk
      IF ( flgrdall( 6,12) ) nrqmax = nrqmax + 2*nk
      !
      IF ( nrqmax .GT. 0 ) THEN
        ALLOCATE ( outpts(imod)%OUT1%IRQGO(nrqmax) )
        ALLOCATE ( outpts(imod)%OUT1%IRQGO2(nrqmax*naproc) )
      END IF
      irqgo  => outpts(imod)%OUT1%IRQGO
      irqgo2 => outpts(imod)%OUT1%IRQGO2
      !
      ! 1.a Sends of fields
      !
      ih     = 0
      !
      IF ( iaproc .LE. naproc ) THEN
        it     = it0
#ifdef W3_MPIT
        WRITE (ndst,9010) '(SEND)'
#endif
        !
        IF ( flgrdall( 1, 12) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (icef(iaproc), 1, ww3_field_vec, iroot, it, &
               mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 1/09', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 1) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (hs(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/01', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 2) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (wlm(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/02', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 3) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (t02(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/03', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 4) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (t0m1(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/04', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 5) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (t01(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/05', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 6) .OR. flgrdall( 2,18) ) THEN
          ! TP output shares FP0 internal field with FP
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (fp0(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/06', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 7) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (thm(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/07', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 8) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (ths(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/09', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 9) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (thp0(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/09', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 10) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (hsig(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/10', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 11) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (stmaxe(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/11', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 12) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (stmaxd(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/12', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 13) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (hmaxe(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/13', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 14) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (hcmaxe(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/14', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 15) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (hmaxd(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/15', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 16) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (hcmaxd(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/16', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 17) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (wbt(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/17', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 2, 19) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (wnmean(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 2/19', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 3, 1) ) THEN
          DO ik=e3df(2,1),e3df(3,1)
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (ef(1,ik),nsealm , mpi_real, iroot, &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'EF', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 3, 2) ) THEN
          DO ik=e3df(2,2),e3df(3,2)
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (th1m(1,ik),nsealm , mpi_real, iroot, &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'TH1M', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 3, 3) ) THEN
          DO ik=e3df(2,3),e3df(3,3)
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (sth1m(1,ik),nsealm , mpi_real, iroot, &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'STH1M', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 3, 4) ) THEN
          DO ik=e3df(2,4),e3df(3,4)
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (th2m(1,ik),nsealm , mpi_real, iroot, &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'TH2M', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 3, 5) ) THEN
          DO ik=e3df(2,5),e3df(3,5)
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (sth2m(1,ik),nsealm , mpi_real, iroot, &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'STH2M', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 1) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (phs(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/01', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 2) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (ptp(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/02', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 3) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (plp(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/03', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 4) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pdir(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/04', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 5) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (psi(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/05', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 6) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pws(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/06', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 7) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pthp0(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/07', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 8) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pqp(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/08', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4, 9) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (ppe(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/09', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4,10) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pgw(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/10', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4,11) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (psw(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/11', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4,12) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (ptm1(1,k),nsealm , mpi_real, iroot,   &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/12', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        !
        IF ( flgrdall( 4,13) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pt1(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/13', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4,14) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pt2(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/14', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4,15) ) THEN
          DO k=0, noswll
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (pep(1,k),nsealm , mpi_real, iroot,    &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/15', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 4,16) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (pwst(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 4/16', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 4,17) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (pnr(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 4/17', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 1) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (ust(iaproc), 1, ww3_field_vec,      &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr )
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/01', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (ustdir(iaproc), 1, ww3_field_vec,       &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr )
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/01', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (asf(iaproc), 1, ww3_field_vec,       &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr )
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/01', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 2) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (charn(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/02', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 3) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (cge(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/03', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 4) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (phiaw(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/04', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 5) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauwix(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/05', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauwiy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/05', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 6) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauwnx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/06', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauwny(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/06', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 7) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (whitecap(1,1),nsealm , mpi_real, iroot,&
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/07', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 8) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (whitecap(1,2),nsealm , mpi_real, iroot,&
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/08', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 9) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (whitecap(1,3),nsealm , mpi_real, iroot,&
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/09', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5,10) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (whitecap(1,4),nsealm , mpi_real, iroot,&
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/10', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 5, 11) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tws(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 5/11', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 1) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (sxx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/01', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (syy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/01', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (sxy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/01', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 2) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauox(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/02', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauoy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/02', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 3) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (bhd(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/03', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 4) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (phioc(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/04', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 5) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tusx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/05', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tusy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/05', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 6) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (ussx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/06', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (ussy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/06', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 7) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (prms(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/07', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tpms(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/07', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 8) ) THEN
          DO ik=1,2*nk
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (us3d(1,ik),nsealm , mpi_real, iroot,  &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'US3D ', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 6, 9) ) THEN
          DO k=p2msf(2),p2msf(3)
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (p2sms(1,k),nsealm , mpi_real, iroot,  &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'P2SMS', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 6,10) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauice(1,1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/10', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauice(1,2),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/10', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6,11) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (phice(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/11', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 6, 12) ) THEN
          DO ik=1,2*nk
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (ussp(1,ik),nsealm , mpi_real, iroot,  &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, 'USSP ', iroot, it, irqgo(ih), ierr
#endif
          END DO
        END IF
        !
        IF ( flgrdall( 6, 13) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauocx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/13', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (tauocy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 6/13', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 7, 1) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (aba(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/01', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (abd(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/01', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 7, 2) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (uba(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/02', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (ubd(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/02', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 7, 3) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (bedforms(1,1),nsealm , mpi_real,      &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/03', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (bedforms(1,2),nsealm , mpi_real,      &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/03', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (bedforms(1,3),nsealm , mpi_real,      &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/03', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 7, 4) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (phibbl(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/04', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 7, 5) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (taubbl(1,1),nsealm , mpi_real,        &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/05', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (taubbl(1,2),nsealm , mpi_real,        &
               iroot, it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 7/05', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 1) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (mssx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/01', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (mssy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/01', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 2) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (mscx(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/02', iroot, it, irqgo(ih), ierr
#endif
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (mscy(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/02', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 3) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (mssd(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/03', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 4) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (mscd(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/04', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 5) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (qp(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/05', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 6) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (qkk(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/06', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 7) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (skew(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/07', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 8) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (embia1(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/08', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 8, 9) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (embia2(1),nsealm , mpi_real, iroot,   &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 8/09', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 9, 1) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (dtdyn(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 9/01', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 9, 2) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (fcut(1),nsealm , mpi_real, iroot,    &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 9/02', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 9, 3) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (cflxymax(1),nsealm , mpi_real, iroot, &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 9/03', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 9, 4) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (cflthmax(1),nsealm , mpi_real, iroot, &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 9/04', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        IF ( flgrdall( 9, 5) ) THEN
          ih     = ih + 1
          it     = it + 1
          CALL mpi_send_init (cflkmax(1),nsealm , mpi_real, iroot,  &
               it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9011) ih, ' 9/05', iroot, it, irqgo(ih), ierr
#endif
        END IF
        !
        DO i=1, noextr
          IF ( flgrdall(10, i) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_send_init (usero(1,i),nsealm , mpi_real, iroot,  &
                 it, mpi_comm_wave, irqgo(ih), ierr)
#ifdef W3_MPIT
            WRITE (string,'(A3,I2.2)') '10/', i
            WRITE (ndst,9011) ih, string, iroot, it, irqgo(ih), ierr
#endif
          END IF
        END DO
        !
        nrqgo  = ih
#ifdef W3_MPIT
        WRITE (ndst,9012)
        WRITE (ndst,9013) nrqgo, nrqmax
#endif
        !
      END IF !IF ( IAPROC .LE. NAPROC ) THEN
      !
      IF ( nrqgo .GT. nrqmax ) THEN
        WRITE (ndse,1010) nrqgo, nrqmax
        CALL extcde (10)
      END IF
      !
      IF ( iaproc .EQ. napfld ) THEN
        !
        ! 1.b Setting up expanded arrays
        !
        IF (napfld .EQ. naprst) THEN
          CALL w3xdma ( imod, ndse, ndst, flgrdarst )
        ELSE
          CALL w3xdma ( imod, ndse, ndst, flgrdall )
        ENDIF
        !
        ! 1.c Receives of fields
        !
        CALL w3xeta ( imod, ndse, ndst )
#ifdef W3_MPIT
        WRITE (ndst,9010) '(RECV)'
#endif
        !
        ih     = 0
        !
        DO i0=1, naproc
          it     = it0
          ifrom  = i0 - 1
          !
          IF ( flgrdall( 1, 12) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (icef(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 1/09', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 1) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (hs(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/01', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 2) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (wlm(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/02', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 3) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (t02(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/03', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 4) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (t0m1(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/04', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 5) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (t01(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/05', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 6) .OR. flgrdall( 2,18) ) THEN
            ! TP output shares FP0 internal field with FP
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (fp0(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/06', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 7) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (thm(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/07', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 8) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (ths(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/08', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 9) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (thp0(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/09', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 10) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (hsig(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/10', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 11) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (stmaxe(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/11', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 12) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (stmaxd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/12', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 13) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (hmaxe(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/13', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 14) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (hcmaxe(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/14', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 15) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (hmaxd(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/15', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 16) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (hcmaxd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/16', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 17) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (wbt(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/17', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 2, 19) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (wnmean(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 2/19', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 3, 1) ) THEN
            DO ik=e3df(2,1),e3df(3,1)
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (ef(i0,ik),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'EF', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 3, 2) ) THEN
            DO ik=e3df(2,2),e3df(3,2)
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (th1m(i0,ik),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'TH1M', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 3, 3) ) THEN
            DO ik=e3df(2,3),e3df(3,3)
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (sth1m(i0,ik),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'STH1M', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 3, 4) ) THEN
            DO ik=e3df(2,4),e3df(3,4)
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (th2m(i0,ik),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'TH2M', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 3, 5) ) THEN
            DO ik=e3df(2,5),e3df(3,5)
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (sth2m(i0,ik),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'STH2M', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 1) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (phs(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/01', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 2) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (ptp(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/02', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 3) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (plp(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/03', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 4) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pdir(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/04', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 5) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (psi(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/05', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 6) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pws(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/06', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 7) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pthp0(i0,k),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/07', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 8) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pqp(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/08', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4, 9) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (ppe(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/09', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,10) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pgw(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/10', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,11) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (psw(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/11', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,12) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (ptm1(i0,k),1,ww3_field_vec, ifrom, it,&
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/12', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,13) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pt1(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/13', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,14) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pt2(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/14', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,15) ) THEN
            DO k=0, noswll
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (pep(i0,k),1,ww3_field_vec, ifrom, it,  &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, ' 4/15', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 4,16) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (pwst(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/16', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 4,17) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (pnr(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 4/17', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 1) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (ust(i0), 1, ww3_field_vec, ifrom,   &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/01', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (ustdir(i0), 1, ww3_field_vec, ifrom,   &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/01', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (asf(i0), 1, ww3_field_vec, ifrom,   &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/01', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 2) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (charn(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/02', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 3) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (cge(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/03', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 4) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (phiaw(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/04', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 5) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauwix(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/05', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauwiy(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/05', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 6) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauwnx(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/06', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauwny(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/06', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 7) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (whitecap(i0,1),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/07', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 8) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (whitecap(i0,2),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/08', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5, 9) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (whitecap(i0,3),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/09', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5,10) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (whitecap(i0,4),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/10', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 5,11) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tws(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 5/11', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 1) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (sxx(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/01', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (syy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/01', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (sxy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/01', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 2) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauox(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/02', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauoy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/02', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 3) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (bhd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/03', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 4) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (phioc(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/04', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 5) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tusx(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/05', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tusy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/05', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 6) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (ussx(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/06', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (ussy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/06', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 7) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (prms(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/07', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tpms(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/07', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 8) ) THEN
            DO ik=1,2*nk
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (us3d(i0,ik),1,ww3_field_vec, ifrom, it, &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'US3D ', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF (  flgrdall( 6, 9) ) THEN
            DO k=p2msf(2),p2msf(3)
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (p2sms(i0,k),1,ww3_field_vec, ifrom, it, &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'P3SMS', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 6,10) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauice(i0,1),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/10', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauice(i0,2),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/10', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6,11) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (phice(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/11', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 6, 12) ) THEN
            DO ik=1,2*nk
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (ussp(i0,ik),1,ww3_field_vec, ifrom, it, &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9011) ih, 'USSP ', ifrom, it, irqgo2(ih), ierr
#endif
            END DO
          END IF
          !
          IF ( flgrdall( 6, 13) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauocx(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/13', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (tauocy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 6/13', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 7, 1) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (aba(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/01', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (abd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/01', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 7, 2) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (uba(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/02', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (ubd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/02', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 7, 3) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (bedforms(i0,1),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/03', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (bedforms(i0,2),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/03', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (bedforms(i0,3),1,ww3_field_vec, ifrom,  &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/03', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 7, 4) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (phibbl(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/04', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 7, 5) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (taubbl(i0,1),1,ww3_field_vec, ifrom,    &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/05', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (taubbl(i0,2),1,ww3_field_vec, ifrom,    &
                 it, mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 7/05', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 1) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (mssx(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/01', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (mssy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/01', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 2) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (mscx(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/02', ifrom, it, irqgo2(ih), ierr
#endif
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (mscy(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/02', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 3) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (mssd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/03', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 4) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (mscd(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/04', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 5) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (qp(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/05', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 6) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (qkk(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/06', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 7) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (skew(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/07', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 8) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (embia1(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/08', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 8, 9) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (embia2(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 8/09', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 9, 1) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (dtdyn(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 9/01', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 9, 2) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (fcut(i0),1,ww3_field_vec, ifrom, it,  &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 9/02', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 9, 3) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (cflxymax(i0),1,ww3_field_vec, ifrom, it,&
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 9/03', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 9, 4) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (cflthmax(i0),1,ww3_field_vec, ifrom, it,&
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 9/04', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          IF ( flgrdall( 9, 5) ) THEN
            ih     = ih + 1
            it     = it + 1
            CALL mpi_recv_init (cflkmax(i0),1,ww3_field_vec, ifrom, it, &
                 mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9011) ih, ' 9/05', ifrom, it, irqgo2(ih), ierr
#endif
          END IF
          !
          DO i=1, noextr
            !WRITE(740+IAPROC,*) 'SECOND : I=', I, ' / ', NOEXTR, ' val=', FLGRDALL(10, I)
            IF ( flgrdall(10, i) ) THEN
              ih     = ih + 1
              it     = it + 1
              CALL mpi_recv_init (usero(i0,i),1,ww3_field_vec, ifrom, it, &
                   mpi_comm_wave, irqgo2(ih), ierr )
#ifdef W3_MPIT
              WRITE (string,'(A3,I2.2)') '10/', i
              WRITE (ndst,9011) ih, string, ifrom, it, irqgo2(ih), ierr
#endif
            END IF
          END DO
          !
        END DO
        !
        nrqgo2 = ih
#ifdef W3_MPIT
        WRITE (ndst,9012)
        WRITE (ndst,9014) nrqgo2, nrqmax*naproc
#endif
        !
        CALL w3seta ( imod, ndse, ndst )
        !
      END IF ! IF ( IAPROC .EQ. NAPFLD ) THEN
      !
      IF ( nrqgo2 .GT. nrqmax*naproc ) THEN
        WRITE (ndse,1011) nrqgo2, nrqmax*naproc
        CALL extcde (11)
      END IF
      !
    END IF ! IF ((FLOUT(1) .OR. FLOUT(7)) .and. (.not. LPDLIB)) THEN
    !
    ! 2.  Set-up for W3IORS ---------------------------------------------- /
    ! 2.a General preparations
    !
    nrqrs  = 0
    ih     = 0
    iroot  = naprst - 1
    !
    IF ((flout(4) .OR. flout(8)) .and. (.not. lpdlib)) THEN
      IF (oarst) THEN
        ALLOCATE ( outpts(imod)%OUT4%IRQRS(34*naproc) )
      ELSE
        ALLOCATE ( outpts(imod)%OUT4%IRQRS(3*naproc) )
      ENDIF
      irqrs  => outpts(imod)%OUT4%IRQRS
      !
      ! 2.b Fields at end of file (always)
      !
#ifdef W3_MPIT
      WRITE (ndst,9020)
#endif
      !
      IF ( iaproc.NE.naprst .AND. iaproc.LE.naproc ) THEN
        !
        ih     = ih + 1
        it     = it0 + 1
        CALL mpi_send_init (ust(iaproc), 1, ww3_field_vec, &
             iroot, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
        WRITE (ndst,9021) ih, 'S U*', iroot, it, irqrs(ih), ierr
#endif
        !
        ih     = ih + 1
        it     = it0 + 2
        CALL mpi_send_init (ustdir(iaproc), 1, ww3_field_vec, &
             iroot, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
        WRITE (ndst,9021) ih, 'S UD', iroot, it, irqrs(ih), ierr
#endif
        !
        ih     = ih + 1
        it     = it0 + 3
        CALL mpi_send_init (fpis(iaproc), 1, ww3_field_vec, &
             iroot, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
        WRITE (ndst,9021) ih, 'S FP', iroot, it, irqrs(ih), ierr
#endif
        !
      ELSE IF ( iaproc .EQ. naprst ) THEN
        DO i0=1, naproc
          ifrom  = i0 - 1
          IF ( i0 .NE. iaproc ) THEN
            !
            ih     = ih + 1
            it     = it0 + 1
            CALL mpi_recv_init (ust(i0),1,ww3_field_vec, &
                 ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9021) ih, 'R U*', ifrom, it, irqrs(ih), ierr
#endif
            !
            ih     = ih + 1
            it     = it0 + 2
            CALL mpi_recv_init (ustdir(i0),1,ww3_field_vec, &
                 ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9021) ih, 'R UD', ifrom, it, irqrs(ih), ierr
#endif
            !
            ih     = ih + 1
            it     = it0 + 3
            CALL mpi_recv_init (fpis(i0),1,ww3_field_vec, &
                 ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9021) ih, 'R FP', ifrom, it, irqrs(ih), ierr
#endif
          END IF
        END DO
      END IF
      !
      IF (oarst) THEN
        IF ( flogrr( 1, 2) ) THEN
          ih     = ih + 1
          it     = it0 + 4
          CALL mpi_send_init (cx(iaproc), 1, ww3_field_vec,   &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S CX', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 5
          CALL mpi_send_init (cy(iaproc), 1, ww3_field_vec,   &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S CY', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 1, 12) ) THEN
          ih     = ih + 1
          it     = it0 + 6
          CALL mpi_send_init (icef(iaproc), 1, ww3_field_vec, &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S IF', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 2, 1) ) THEN
          ih     = ih + 1
          it     = it0 + 7
          CALL mpi_send_init (hs(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S HS', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 2, 2) ) THEN
          ih     = ih + 1
          it     = it0 + 8
          CALL mpi_send_init (wlm(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S WL', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 2, 4) ) THEN
          ih     = ih + 1
          it     = it0 + 9
          CALL mpi_send_init (t0m1(1), nsealm, mpi_real,      &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S T0', iroot, it, irqrs(ih), ierr
#endif
        ENDIF
        !
        IF ( flogrr( 2, 5) ) THEN
          ih     = ih + 1
          it     = it0 + 10
          CALL mpi_send_init (t01(1), nsealm, mpi_real,      &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S T1', iroot, it, irqrs(ih), ierr
#endif
        ENDIF
        !
        IF ( flogrr( 2, 6) ) THEN
          ih     = ih + 1
          it     = it0 + 11
          CALL mpi_send_init (fp0(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S FP', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 2, 7) ) THEN
          ih     = ih + 1
          it     = it0 + 12
          CALL mpi_send_init (thm(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S TH', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 2, 19) ) THEN
          ih     = ih + 1
          it     = it0 + 13
          CALL mpi_send_init (wnmean(1), nsealm, mpi_real,    &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S WM', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 5, 2) ) THEN
          ih     = ih + 1
          it     = it0 + 14
          CALL mpi_send_init (charn(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S CH', iroot, it, irqrs(ih), ierr
#endif
        ENDIF
        !
        IF ( flogrr( 5, 5) ) THEN
          ih     = ih + 1
          it     = it0 + 15
          CALL mpi_send_init (tauwix(1), nsealm, mpi_real,    &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S WX', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 16
          CALL mpi_send_init (tauwiy(1), nsealm, mpi_real,    &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S WY', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 5, 11) ) THEN
          ih     = ih + 1
          it     = it0 + 17
          CALL mpi_send_init (tws(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S TS', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6, 2) ) THEN
          ih     = ih + 1
          it     = it0 + 18
          CALL mpi_send_init (tauox(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S OX', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 19
          CALL mpi_send_init (tauoy(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S OY', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6, 3) ) THEN
          ih     = ih + 1
          it     = it0 + 20
          CALL mpi_send_init (bhd(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S BH', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6, 4) ) THEN
          ih     = ih + 1
          it     = it0 + 21
          CALL mpi_send_init (phioc(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S PH', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6, 5) ) THEN
          ih     = ih + 1
          it     = it0 + 22
          CALL mpi_send_init (tusx(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S UX', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 23
          CALL mpi_send_init (tusy(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S UY', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6, 6) ) THEN
          ih     = ih + 1
          it     = it0 + 24
          CALL mpi_send_init (ussx(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S SX', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 25
          CALL mpi_send_init (ussy(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S SY', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6,10) ) THEN
          ih     = ih + 1
          it     = it0 + 26
          CALL mpi_send_init (tauice(1,1), nsealm, mpi_real,  &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S I1', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 27
          CALL mpi_send_init (tauice(1,2), nsealm, mpi_real,  &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S I2', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 6,13) ) THEN
          ih     = ih + 1
          it     = it0 + 28
          CALL mpi_send_init (tauocx(1), nsealm, mpi_real,    &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S TX', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 29
          CALL mpi_send_init (tauocy(1), nsealm, mpi_real,    &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S TY', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 7, 2) ) THEN
          ih     = ih + 1
          it     = it0 + 30
          CALL mpi_send_init (uba(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S BA', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 31
          CALL mpi_send_init (ubd(1), nsealm, mpi_real,     &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S BD', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 7, 4) ) THEN
          ih     = ih + 1
          it     = it0 + 32
          CALL mpi_send_init (phibbl(1), nsealm, mpi_real,    &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S PB', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( flogrr( 7, 5) ) THEN
          ih     = ih + 1
          it     = it0 + 33
          CALL mpi_send_init (taubbl(1,1), nsealm, mpi_real,  &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S T1', iroot, it, irqrs(ih), ierr
#endif
          ih     = ih + 1
          it     = it0 + 34
          CALL mpi_send_init (taubbl(1,2), nsealm, mpi_real,  &
               iroot, it, mpi_comm_wave, irqrs(ih), ierr)
#ifdef W3_MPIT
          WRITE (ndst,9021) ih, 'S T2', iroot, it, irqrs(ih), ierr
#endif
        END IF
        !
        IF ( iaproc .EQ. naprst ) THEN
          IF (naprst .NE. napfld) CALL w3xdma ( imod, ndse, ndst, flogrr )
          CALL w3xeta ( imod, ndse, ndst )
          !
          DO i0=1, naproc
            ifrom  = i0 - 1
            IF ( flogrr( 1, 2) ) THEN
              ih     = ih + 1
              it     = it0 + 4
              CALL mpi_recv_init (cx(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R CX', ifrom, it, irqrs(ih), ierr
#endif
              ih     = it0 + 5
              it     = it + 1
              CALL mpi_recv_init (cy(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R CY', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 1, 12) ) THEN
              ih     = ih + 1
              it     = it0 + 6
              CALL mpi_recv_init (icef(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R IF', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 2, 1) ) THEN
              ih     = ih + 1
              it     = it0 + 7
              CALL mpi_recv_init (hs(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R HS', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 2, 2) ) THEN
              ih     = ih + 1
              it     = it0 + 8
              CALL mpi_recv_init (wlm(i0),1,ww3_field_vec,  &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R WL', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 2, 4) ) THEN
              ih     = ih + 1
              it     = it0 + 9
              CALL mpi_recv_init (t0m1(i0),1,ww3_field_vec,  &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R T0', ifrom, it, irqrs(ih), ierr
#endif
            ENDIF
            !
            IF ( flogrr( 2, 5) ) THEN
              ih     = ih + 1
              it     = it0 + 10
              CALL mpi_recv_init (t01(i0),1,ww3_field_vec,  &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R T1', ifrom, it, irqrs(ih), ierr
#endif
            ENDIF
            !
            IF ( flogrr( 2, 6) ) THEN
              ih     = ih + 1
              it     = it0 + 11
              CALL mpi_recv_init (fp0(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R FP', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 2, 7) ) THEN
              ih     = ih + 1
              it     = it0 + 12
              CALL mpi_recv_init (thm(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R TH', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 2, 19) ) THEN
              ih     = ih + 1
              it     = it0 + 13
              CALL mpi_recv_init (wnmean(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R WM', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 5, 2) ) THEN
              ih     = ih + 1
              it     = it0 + 14
              CALL mpi_recv_init (charn(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R CH', ifrom, it, irqrs(ih), ierr
#endif
            ENDIF
            !
            IF ( flogrr( 5, 5) ) THEN
              ih     = ih + 1
              it     = it0 + 15
              CALL mpi_recv_init (tauwix(i0),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R WX', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 16
              CALL mpi_recv_init (tauwiy(i0),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R WY', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 5,11) ) THEN
              ih     = ih + 1
              it     = it0 + 17
              CALL mpi_recv_init (tws(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R TS', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6, 2) ) THEN
              ih     = ih + 1
              it     = it0 + 18
              CALL mpi_recv_init (tauox(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R OX', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 19
              CALL mpi_recv_init (tauoy(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R OY', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6, 3) ) THEN
              ih     = ih + 1
              it     = it0 + 20
              CALL mpi_recv_init (bhd(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R BH', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6, 4) ) THEN
              ih     = ih + 1
              it     = it0 + 21
              CALL mpi_recv_init (phioc(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R PH', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6, 5) ) THEN
              ih     = ih + 1
              it     = it0 + 22
              CALL mpi_recv_init (tusx(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R UX', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 23
              CALL mpi_recv_init (tusy(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R UY', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6, 6) ) THEN
              ih     = ih + 1
              it     = it0 + 24
              CALL mpi_recv_init (ussx(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R SX', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 25
              CALL mpi_recv_init (ussy(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R SY', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6,10) ) THEN
              ih     = ih + 1
              it     = it0 + 26
              CALL mpi_recv_init (tauice(i0,1),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R I1', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 27
              CALL mpi_recv_init (tauice(i0,2),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R I2', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 6,13) ) THEN
              ih     = ih + 1
              it     = it0 + 28
              CALL mpi_recv_init (tauocx(i0),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R SX', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 29
              CALL mpi_recv_init (tauocy(i0),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R SY', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 7, 2) ) THEN
              ih     = ih + 1
              it     = it0 + 30
              CALL mpi_recv_init (uba(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R BA', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 31
              CALL mpi_recv_init (ubd(i0),1,ww3_field_vec, &
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R BD', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 7, 4) ) THEN
              ih     = ih + 1
              it     = it0 + 32
              CALL mpi_recv_init (phibbl(i0),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R PB', ifrom, it, irqrs(ih), ierr
#endif
            END IF
            !
            IF ( flogrr( 7, 5) ) THEN
              ih     = ih + 1
              it     = it0 + 33
              CALL mpi_recv_init (taubbl(i0,1),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R T1', ifrom, it, irqrs(ih), ierr
#endif
              ih     = ih + 1
              it     = it0 + 34
              CALL mpi_recv_init (taubbl(i0,2),1,ww3_field_vec,&
                   ifrom, it, mpi_comm_wave, irqrs(ih), ierr )
#ifdef W3_MPIT
              WRITE (ndst,9021) ih, 'R T2', ifrom, it, irqrs(ih), ierr
#endif
            END IF
          END DO
          !
          CALL w3seta ( imod, ndse, ndst )
        END IF ! IF ( IAPROC .EQ. NAPRST ) THEN
      END IF ! IF (OARST) THEN
      !
      nrqrs  = ih
      IF (oarst) THEN
        it0    = it0 + 34
      ELSE
        it0    = it0 + 3
      ENDIF
      !
#ifdef W3_MPIT
      WRITE (ndst,9022)
      WRITE (ndst,9023) nrqrs
#endif
      !
      ! 2.c Data server mode
      !
      IF ( iostyp .GT. 0 ) THEN
        !
        nblkrs = 10
        rsblks = max( 5 , nsealm/nblkrs )
        IF ( nblkrs*rsblks .LT. nsealm ) rsblks = rsblks + 1
        nblkrs = 1 + (nsealm-1)/rsblks
        !
#ifdef W3_MPIT
        WRITE (ndst,9025) rsblks, nblkrs
#endif
        ih     = 0
        !
        IF ( iaproc .NE. naprst ) THEN
          !
          ALLOCATE ( outpts(imod)%OUT4%IRQRSS(nblkrs) )
          irqrss => outpts(imod)%OUT4%IRQRSS
          !
          DO ib=1, nblkrs
            ih     = ih + 1
            it     = it0 + 3 + ib
            jsea0  = 1 + (ib-1)*rsblks
            jsean  = min( nsealm , ib*rsblks )
            nseab  = 1 + jsean - jsea0
            CALL mpi_send_init (va(1,jsea0), nspec*nseab, mpi_real, iroot, it, &
                 mpi_comm_wave, irqrss(ih), ierr )
#ifdef W3_MPIT
            WRITE (ndst,9026) ih, 'S', ib, iroot, it, irqrss(ih), ierr, nseab
#endif
          END DO
          !
        ELSE
          !
          ALLOCATE ( outpts(imod)%OUT4%IRQRSS(naproc*nblkrs) ,  &
               outpts(imod)%OUT4%VAAUX(nspec,2*rsblks,naproc) )
          !
          irqrss => outpts(imod)%OUT4%IRQRSS
          vaaux  => outpts(imod)%OUT4%VAAUX
          DO ib=1, nblkrs
            it     = it0 + 3 + ib
            jsea0  = 1 + (ib-1)*rsblks
            jsean  = min( nsealm , ib*rsblks )
            nseab  = 1 + jsean - jsea0
            DO i0=1, naproc
              IF ( i0 .NE. naprst ) THEN
                ih     = ih + 1
                ifrom  = i0 - 1
                iboff  = mod(ib-1,2)*rsblks
                CALL mpi_recv_init (vaaux(1,1+iboff,i0), nspec*nseab, mpi_real, &
                     ifrom, it, mpi_comm_wave, irqrss(ih), ierr )
#ifdef W3_MPIT
                WRITE (ndst,9026) ih, 'R', ib, ifrom, it, irqrss(ih), ierr, nseab
#endif
              END IF
            END DO
          END DO
          !
        END IF
        !
#ifdef W3_MPIT
        WRITE (ndst,9027)
        WRITE (ndst,9028) ih
#endif
        it0    = it0 + nblkrs
        !
      END IF
      !
    END IF ! IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN
    !
    ! 3.  Set-up for W3IOBC ( SENDs ) ------------------------------------ /
    !
    nrqbp  = 0
    nrqbp2 = 0
    ih     = 0
    it     = it0
    iroot  = napbpt - 1
    !
    IF ( flout(5) ) THEN
      ALLOCATE ( outpts(imod)%OUT5%IRQBP1(nbo2(nfbpo)),  &
           outpts(imod)%OUT5%IRQBP2(nbo2(nfbpo)) )
      irqbp1 => outpts(imod)%OUT5%IRQBP1
      irqbp2 => outpts(imod)%OUT5%IRQBP2
      !
      ! 3.a Loops over files and points
      !
#ifdef W3_MPIT
      WRITE (ndst,9030) 'MPI_SEND_INIT'
#endif
      !
      DO j=1, nfbpo
        DO i=nbo2(j-1)+1, nbo2(j)
          !
          it     = it + 1
          !
          ! 3.b Residence processor of point
          !
          isea   = isbpo(i)
          CALL init_get_jsea_isproc(isea, jsea, isproc)
          !
          ! 3.c If stored locally, send data
          !
          IF ( iaproc .EQ. isproc ) THEN
            ih     = ih + 1
            CALL mpi_send_init (va(1,jsea),nspec,mpi_real, iroot, it, mpi_comm_wave, &
                 irqbp1(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9031) ih, i, j, iroot, it, irqbp1(ih), ierr
#endif
          END IF
          !
        END DO
      END DO
      !
      ! ... End of loops 4.a
      !
      nrqbp  = ih
      !
#ifdef W3_MPIT
      WRITE (ndst,9032)
      WRITE (ndst,9033) nrqbp
#endif
      !
      ! 3.d Set-up for W3IOBC ( RECVs ) ------------------------------------ /
      !
      IF ( iaproc .EQ. napbpt ) THEN
        !
        ih     = 0
        it     = it0
        !
        ! 3.e Loops over files and points
        !
#ifdef W3_MPIT
        WRITE (ndst,9030) 'MPI_RECV_INIT'
#endif
        !
        DO j=1, nfbpo
          DO i=nbo2(j-1)+1, nbo2(j)
            !
            ! 3.f Residence processor of point
            !
            isea   = isbpo(i)
            CALL init_get_jsea_isproc(isea, jsea, isproc)
            !
            ! 3.g Receive in correct array
            !
            ih     = ih + 1
            it     = it + 1
            itarg  = isproc - 1
            CALL mpi_recv_init (abpos(1,ih),nspec,mpi_real, itarg, it, mpi_comm_wave, &
                 irqbp2(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9031) ih, i, j, itarg, it, irqbp2(ih), ierr
#endif
            !
          END DO
        END DO
        !
        nrqbp2 = ih
        !
        ! ... End of loops 4.e
        !
#ifdef W3_MPIT
        WRITE (ndst,9032)
        WRITE (ndst,9033) nrqbp2
#endif
        !
      END IF
      !
      it0    = it0 + nbo2(nfbpo)
      !
    END IF
    !
#ifdef W3_MPIT
    WRITE (ndst,*)
#endif
    !
    ! 4.  Set-up for W3IOTR ---------------------------------------------- /
    !
    ih     = 0
    iroot  = naptrk - 1
    !
    IF ( flout(3) ) THEN
      !
      ! 4.a U*
      !
#ifdef W3_MPIT
      WRITE (ndst,9040)
#endif
      !
      IF ( iaproc .NE. naptrk ) THEN
        ALLOCATE ( outpts(imod)%OUT3%IRQTR(2) )
        irqtr  => outpts(imod)%OUT3%IRQTR
        ih     = ih + 1
        it     = it0 + 1
        CALL mpi_send_init (ust(iaproc),1,ww3_field_vec, iroot, it, mpi_comm_wave, &
             irqtr(ih), ierr )
#ifdef W3_MPIT
        WRITE (ndst,9041) ih, 'S U*', iroot, it, irqtr(ih), ierr
#endif
        ih     = ih + 1
        it     = it0 + 2
        CALL mpi_send_init (ustdir(iaproc),1,ww3_field_vec, iroot, it, mpi_comm_wave, &
             irqtr(ih), ierr )
#ifdef W3_MPIT
        WRITE (ndst,9041) ih, 'S U*', iroot, it, irqtr(ih), ierr
#endif
      ELSE
        ALLOCATE ( outpts(imod)%OUT3%IRQTR(2*naproc) )
        irqtr  => outpts(imod)%OUT3%IRQTR
        DO i0=1, naproc
          ifrom  = i0 - 1
          IF ( i0 .NE. iaproc ) THEN
            ih     = ih + 1
            it     = it0 + 1
            CALL mpi_recv_init(ust(i0),1,ww3_field_vec, ifrom, it, mpi_comm_wave, &
                 irqtr(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9041) ih, 'R U*', ifrom, it, irqtr(ih), ierr
#endif
            ih     = ih + 1
            it     = it0 + 2
            CALL mpi_recv_init(ustdir(i0),1,ww3_field_vec, ifrom, it, mpi_comm_wave, &
                 irqtr(ih), ierr)
#ifdef W3_MPIT
            WRITE (ndst,9041) ih, 'R U*', ifrom, it, irqtr(ih), ierr
#endif
          END IF
        END DO
      END IF
      !
      nrqtr  = ih
      it0    = it0 + 2
      !
#ifdef W3_MPIT
      WRITE (ndst,9042)
      WRITE (ndst,9043) nrqtr
#endif
      !
    END IF
    !
    ! 5.  Set-up remaining counters -------------------------------------- /
    !
    it0prt = it0
    it0pnt = it0prt + 2*naproc
    it0trk = it0pnt + 5000
#endif
    !
    RETURN
    !
    !     Formats :
    !
#ifdef W3_MPI
1010 FORMAT (/' *** ERROR W3MPIO : ARRAY IRQGO TOO SMALL *** '/)
1011 FORMAT (/' *** ERROR W3MPIO : ARRAY IRQGO2 TOO SMALL *** '/)
#endif
    !
#ifdef W3_MPIT
9010 FORMAT (/' TEST W3MPIO: COMMUNICATION CALLS FOR W3IOGO ',a/    &
         ' +------+-------+------+------+--------------+'/          &
         ' |  IH  |   ID  | TARG |  TAG |   handle err |'/          &
         ' +------+-------+------+------+--------------+')
9011 FORMAT ( ' |',i5,' | ',a5,' |',2(i5,' |'),i9,i4,' |')
9012 FORMAT ( ' +------+-------+------+------+--------------+')
9013 FORMAT ( ' TEST W3MPIO: NRQGO :',2i10)
9014 FORMAT ( ' TEST W3MPIO: NRQGO2:',2i10)
9020 FORMAT (/' TEST W3MPIO: COMM. CALLS FOR W3IORS (F)'/           &
         ' +------+------+------+------+--------------+'/           &
         ' |  IH  |  ID  | TARG |  TAG |   handle err |'/           &
         ' +------+------+------+------+--------------+')
9021 FORMAT ( ' |',i5,' | ',a4,' |',2(i5,' |'),i9,i4,' |')
9022 FORMAT ( ' +------+------+------+------+--------------+')
9023 FORMAT ( ' TEST W3MPIO: NRQRS :',i10)
9025 FORMAT (/' TEST W3MPIO: COMM. CALLS FOR W3IORS (S)'/           &
         '              BLOCK SIZE / BLOCKS : ',2i6/                &
         ' +------+------+------+------+--------------+---------+'/ &
         ' |  IH  |  ID  | TARG |  TAG |   handle err | spectra |'/ &
         ' +------+------+------+------+--------------+---------+')
9026 FORMAT (                                                       &
         ' |',i5,' | ',a1,i3,' |',2(i5,' |'),i9,i4,' |',i8,' |')
9027 FORMAT (                                                       &
         ' +------+------+------+------+--------------+---------+')
9028 FORMAT ( ' TEST W3MPIO: IHMAX :',i10)
9030 FORMAT (/' TEST W3MPIO: ',a,' CALLS FOR W3IOBC'/               &
         ' +------+------+---+------+------+--------------+'/       &
         ' |  IH  | IPT  | F | TARG |  TAG |   handle err |'/       &
         ' +------+------+---+------+------+--------------+')
9031 FORMAT ( ' |',2(i5,' |'),i2,' |',2(i5,' |'),i9,i4,' |')
9032 FORMAT (                                                       &
         ' +------+------+---+------+------+--------------+')
9033 FORMAT ( ' TEST W3MPIO: NRQBC :',i10)
9034 FORMAT ( ' TEST W3MPIO: TOTAL :',i10)
9040 FORMAT (/' TEST W3MPIO: COMMUNICATION CALLS FOR W3IOTR'/       &
         ' +------+------+------+------+--------------+'/           &
         ' |  IH  |  ID  | TARG |  TAG |   handle err |'/           &
         ' +------+------+------+------+--------------+')
9041 FORMAT ( ' |',i5,' | ',a4,' |',2(i5,' |'),i9,i4,' |')
9042 FORMAT (                                                       &
         ' +------+------+------+------+--------------+')
9043 FORMAT ( ' TEST W3MPIO: NRQTR :',i10)
#endif
    !/
    !/ End of W3MPIO ----------------------------------------------------- /
    !/
  END SUBROUTINE w3mpio
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3mpip ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         30-Oct-2009 |
    !/                  +-----------------------------------+
    !/
    !/    02-Aug-2006 : Origination.                        ( version 3.10 )
    !/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
    !/    30-Oct-2009 : Implement curvilinear grid type.    ( version 3.14 )
    !/                  (W. E. Rogers & T. J. Campbell, NRL)
    !/
    !  1. Purpose :
    !
    !     Prepare MPI persistent communication needed for WAVEWATCH I/O
    !     routines.
    !
    !  2. Method :
    !
    !     Create handles as needed.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !
    !      MPI_SEND_INIT, MPI_RECV_INIT
    !                Subr. mpif.h   MPI persistent communication calls.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3INIT    Subr. W3INITMD Wave model initialization routine.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/MPI   MPI communication calls.
    !
    !       !/S     Enable subroutine tracing.
    !       !/MPIT  Enable test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
#ifdef W3_MPI
    USE w3servmd, ONLY: extcde
    !/
    USE w3gdatmd, ONLY: nx, ny, nspec, mapfs
    USE w3wdatmd, ONLY: va
    USE w3adatmd, ONLY: mpi_comm_wave, sppnt
    USE w3odatmd, ONLY: ndst, ndse, iaproc, naproc, nappnt, flout
    USE w3odatmd, ONLY: outpts, nrqpo, nrqpo2, irqpo1, irqpo2, &
         nopts, iptint, it0pnt, it0trk, o2irqi
    USE w3parall, ONLY: init_get_jsea_isproc
#endif
    !/
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_MPI
    INTEGER                 :: IH, IROOT, I, J, IT, IT0, JSEA, &
         IERR, ITARG, IX(4), IY(4),      &
         K, IS(4), IP(4)
#endif
    INTEGER                 :: itout
#ifdef W3_S
    INTEGER, SAVE           :: IENT
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3MPIP')
#endif
    !
#ifdef W3_MPI
    IF ( o2irqi ) THEN
      WRITE (ndse,1001)
      CALL extcde (1)
    END IF
    !
    ! 1.  Set-up for W3IOPE/O ( SENDs ) ---------------------------------- /
    !
    nrqpo  = 0
    nrqpo2 = 0
    ih     = 0
    it0    = it0pnt
    iroot  = nappnt - 1
    !
    ALLOCATE ( outpts(imod)%OUT2%IRQPO1(4*nopts),  &
         outpts(imod)%OUT2%IRQPO2(4*nopts) )
    irqpo1 => outpts(imod)%OUT2%IRQPO1
    irqpo2 => outpts(imod)%OUT2%IRQPO2
    o2irqi = .true.
#endif
    !
    ! 1.a Loop over output locations
    !
#ifdef W3_MPIT
    WRITE (ndst,9010) 'MPI_SEND_INIT'
#endif
    !
#ifdef W3_MPI
    DO i=1, nopts
      DO k=1,4
        ix(k)=iptint(1,k,i)
        iy(k)=iptint(2,k,i)
      END DO
      ! 1.b Loop over corner points
      !
      DO j=1, 4
        !
        it     = it0 + (i-1)*4 + j
        is(j)  = mapfs(iy(j),ix(j))
        IF ( is(j) .EQ. 0 ) THEN
          jsea   = 0
          ip(j)  = nappnt
        ELSE
          CALL init_get_jsea_isproc(is(j), jsea, ip(j))
        END IF
#endif
        !
        ! 1.c Send if point is stored here
        !
#ifdef W3_MPI
        IF ( ip(j) .EQ. iaproc ) THEN
          ih     = ih + 1
          CALL mpi_send_init ( va(1,jsea), nspec, mpi_real, iroot, it, mpi_comm_wave, &
               irqpo1(ih), ierr )
#endif
#ifdef W3_MPIT
          WRITE (ndst,9011) ih,i,j, iroot,it, irqpo1(ih), ierr
#endif
#ifdef W3_MPI
        END IF
        !
        ! ... End of loop 1.b
        !
      END DO
      !
      ! ... End of loop 1.a
      !
    END DO
    !
    nrqpo  = ih
#endif
    !
#ifdef W3_MPIT
    WRITE (ndst,9012)
    WRITE (ndst,9013) nrqpo
#endif
    !
    ! 1.d Set-up for W3IOPE/O ( RECVs ) ---------------------------------- /
    !
#ifdef W3_MPI
    IF ( iaproc .EQ. nappnt ) THEN
      !
      ih     = 0
#endif
      !
      ! 2.e Loop over output locations
      !
#ifdef W3_MPIT
      WRITE (ndst,9010) 'MPI_RECV_INIT'
#endif
      !
#ifdef W3_MPI
      DO i=1, nopts
        DO k=1,4
          ix(k)=iptint(1,k,i)
          iy(k)=iptint(2,k,i)
        END DO
        !
        DO j=1, 4
          !
          it     = it0 + (i-1)*4 + j
          is(j)  = mapfs(iy(j),ix(j))
          IF ( is(j) .EQ. 0 ) THEN
            jsea   = 0
            ip(j)  = nappnt
          ELSE
            CALL init_get_jsea_isproc(is(j), jsea, ip(j))
          END IF
#endif
          !
          ! 1.g Receive in correct array
          !
#ifdef W3_MPI
          ih     = ih + 1
          itarg  = ip(j) - 1
          CALL mpi_recv_init ( sppnt(1,1,j), nspec, mpi_real, itarg, it, mpi_comm_wave, &
               irqpo2(ih), ierr )
#endif
#ifdef W3_MPIT
          WRITE (ndst,9011) ih,i,j, itarg,it, irqpo2(ih), ierr
#endif
          !
          ! ... End of loop 1.f
          !
#ifdef W3_MPI
        END DO
        !
        ! ... End of loop 1.e
        !
      END DO
      !
      nrqpo2 = nopts*4
#endif
      !
#ifdef W3_MPIT
      WRITE (ndst,9012)
      WRITE (ndst,9014) nrqpo2
#endif
      !
#ifdef W3_MPI
    END IF
#endif
    !
    !
#ifdef W3_MPI
    it0    = it0 + 8*nopts
#endif
    !
    ! 1.h Base tag number for track output
    !
#ifdef W3_MPI
    it0trk = it0
#endif
    !
    RETURN
    !
    !     Formats :
    !
#ifdef W3_MPI
1001 FORMAT (/' *** ERROR W3MPIP : ARRAYS ALREADY ALLOCATED *** '/)
#endif
    !
#ifdef W3_MPIT
9010 FORMAT (/' TEST W3MPIP: ',a,' CALLS FOR W3IOPO'/         &
         ' +------+------+---+------+------+--------------+'/ &
         ' |  IH  | IPT  | J | TARG |  TAG |   handle err |'/ &
         ' +------+------+---+------+------+--------------+')
9011 FORMAT ( ' |',2(i5,' |'),i2,' |',2(i5,' |'),i9,i4,' |')
9012 FORMAT (                                                 &
         ' +------+------+---+------+------+--------------+')
9013 FORMAT ( ' TEST W3MPIP: NRQPO :',i10)
9014 FORMAT ( ' TEST W3MPIP: TOTAL :',i10)
#endif
    !/
    !/ End of W3MPIP ----------------------------------------------------- /
    !/
  END SUBROUTINE w3mpip
  !/
  !/ End of module W3INITMD -------------------------------------------- /
  !/
END MODULE w3initmd