w3initmd Module Reference

Contains module W3INITMD. More...

Functions/Subroutines
subroutine	w3init (IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, FLG2, NPT, XPT, YPT, PNAMES, IPRT, PRTFRM, MPI_COMM, FLAGSTIDEIN)
	Initialize WAVEWATCH III. More...
subroutine	w3mpii (IMOD)
	Perform initializations for MPI version of model. More...
subroutine	w3mpio (IMOD)
	Prepare MPI persistent communication needed for WAVEWATCH I/O routines. More...
subroutine	w3mpip (IMOD)
	Prepare MPI persistent communication needed for WAVEWATCH I/O routines. More...

Variables
real, parameter	critos = 15.
character(len=10), parameter	wwver = '7.14 '
character(len=512), parameter	switches = __WW3_SWITCHES__

Detailed Description

Contains module W3INITMD.

Author

H. L. Tolman

Date

22-Mar-2021

Function/Subroutine Documentation

w3init()

subroutine w3initmd::w3init	(	integer, intent(in)	IMOD,
		logical, intent(in)	IsMulti,
		character, dimension(*), intent(in)	FEXT,
		integer, dimension(15), intent(in)	MDS,
		integer, dimension(2), intent(in)	MTRACE,
		integer, dimension(40), intent(in)	ODAT,
		logical, dimension(nogrp,ngrpp), intent(inout)	FLGRD,
		logical, dimension(nogrp,ngrpp), intent(inout)	FLGR2,
		logical, dimension(nogrp), intent(inout)	FLGD,
		logical, dimension(nogrp), intent(inout)	FLG2,
		integer, intent(in)	NPT,
		real, dimension(npt), intent(inout)	XPT,
		real, dimension(npt), intent(inout)	YPT,
		character(len=40), dimension(npt), intent(in)	PNAMES,
		integer, dimension(6), intent(in)	IPRT,
		logical, intent(inout)	PRTFRM,
		integer, intent(in)	MPI_COMM,
		logical, dimension(4), intent(in), optional	FLAGSTIDEIN
	)

Initialize WAVEWATCH III.

Initialize data structure and wave fields from data files. Initialize grid from local and instantaneous data.

Parameters

[in]	IMOD	Model number.
[in]	IsMulti
[in]	FEXT	Extension of data files.
[in]	MDS	Array with dataset numbers saved as NDS in W3ODATMD.
[in]	MTRACE	Array with subroutine tracing information.
[in]	ODAT	Output data, five parameters per output type.
[in,out]	FLGRD	Flags for gridded output.
[in,out]	FLGR2	Flags for coupling output.
[in,out]	FLGD
[in,out]	FLG2
[in]	NPT	Number of output points.
[in,out]	XPT	Coordinates of output points.
[in,out]	YPT	Coordinates of output points.
[in]	PNAMES	Output point names.
[in]	IPRT	Partitioning grid info.
[in,out]	PRTFRM	Partitioning format flag.
[in]	MPI_COMM	MPI communicator to be used for model.
[in]	FLAGSTIDEIN

Author

H. L. Tolman

Date

03-Sep-2012

Definition at line 164 of file w3initmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | 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 ----------------------------------------------------- /
    !/

References pdlib_w3profsmd::all_va_integral_print(), w3triamd::area_si(), w3adatmd::as, w3gdatmd::b_jgs_block_gauss_seidel, w3gdatmd::b_jgs_use_jacobi, pdlib_w3profsmd::block_solver_explicit_init(), pdlib_w3profsmd::block_solver_init(), w3adatmd::cg, w3triamd::coordmax(), critos, pdlib_w3profsmd::deallocate_pdlib_global(), w3gdatmd::dmin, w3gdatmd::do_change_wlv, w3timemd::dsec21(), w3gdatmd::dtcfl, w3gdatmd::dtmax, w3odatmd::dtout, w3adatmd::dw, w3servmd::extcde(), file(), w3gdatmd::flagll, w3odatmd::flbpi, w3odatmd::flbpo, w3gdatmd::flck, w3adatmd::flcold, w3gdatmd::flcth, w3idatmd::flcur, w3odatmd::flform, w3idatmd::flic1, w3idatmd::flic2, w3idatmd::flic3, w3idatmd::flic4, w3idatmd::flic5, w3idatmd::flice, w3adatmd::fliwnd, w3idatmd::fllev, w3idatmd::flmdn, w3idatmd::flmth, w3idatmd::flmvs, w3odatmd::flog2, w3odatmd::flogd, w3odatmd::flogr2, w3odatmd::flogrd, w3odatmd::flout, w3idatmd::flrhoa, w3idatmd::fltaua, w3idatmd::flwind, w3odatmd::fnmpre, w3gdatmd::fsfct, w3gdatmd::fsfreqshift, w3gdatmd::fsn, w3gdatmd::fsnimp, w3gdatmd::fspsi, w3gdatmd::fsrefraction, w3gdatmd::fstotalexp, w3gdatmd::fstotalimp, w3gdatmd::gname, w3gdatmd::gtype, w3adatmd::iappro, w3odatmd::iaproc, w3gdatmd::iclose, w3odatmd::idout, include(), w3parall::init_get_isea(), w3parall::init_get_jsea_isproc(), w3odatmd::iostyp, w3odatmd::iptint, w3parall::isea_to_jsea, yowdatapool::istatus, w3servmd::itrace(), w3odatmd::ix0, w3odatmd::ixn, w3odatmd::ixs, w3odatmd::iy0, w3odatmd::iyn, w3odatmd::iys, constants::lpdlib, w3gdatmd::mapfs, w3gdatmd::mapsf, w3gdatmd::mapst2, w3gdatmd::mapsta, w3adatmd::mpi_comm_wave, w3adatmd::mpi_comm_wcmp, w3odatmd::napbpt, w3odatmd::naperr, w3odatmd::napfld, w3odatmd::naplog, w3odatmd::napout, w3odatmd::nappnt, w3odatmd::napprt, w3odatmd::naproc, w3odatmd::naprst, w3odatmd::naptrk, w3odatmd::nds, w3odatmd::ndse, w3odatmd::ndso, w3odatmd::ndst, w3odatmd::ngrpp, w3gdatmd::nk, w3odatmd::nogrp, w3odatmd::nopts, w3odatmd::notype, yownodepool::npa, w3gdatmd::nsea, w3gdatmd::nseal, w3adatmd::nsealm, w3gdatmd::nspec, w3gdatmd::nth, w3odatmd::ntproc, w3triamd::nvectri(), w3gdatmd::nx, w3gdatmd::ny, w3odatmd::outpts, pdlib_w3profsmd::pdlib_init(), pdlib_w3profsmd::pdlib_iobp_init(), pdlib_w3profsmd::pdlib_mapsta_init(), w3wavset::preparation_fd_scheme(), w3servmd::print_memcheck(), w3parall::print_my_time(), pdlib_w3profsmd::print_wn_statistic(), w3arrymd::prtblk(), w3odatmd::ptifac, w3odatmd::ptloc, w3odatmd::ptnme, yowrankmodule::rank, w3gdatmd::rstype, w3odatmd::screen, pdlib_w3profsmd::set_iobdp_pdlib(), pdlib_w3profsmd::set_iobpa_pdlib(), w3parall::set_up_nseal_nsealm(), w3gdatmd::sig, w3triamd::spatial_grid(), w3timemd::stme21(), w3servmd::strace(), w3parall::synchronize_ipgl_etc_array(), pdlib_w3profsmd::test_mpi_status(), w3wdatmd::tice, w3timemd::tick21(), w3wdatmd::time, w3wdatmd::tlev, w3odatmd::tofrst, w3odatmd::tolast, w3odatmd::tonext, w3odatmd::tosnl5, constants::tpi, w3wdatmd::trho, w3gdatmd::trnx, w3gdatmd::trny, constants::tstout, w3adatmd::u10, w3adatmd::u10d, w3adatmd::ua, w3adatmd::ud, constants::undef, w3gdatmd::ungtype, w3odatmd::unipts, w3uostmd::uost_setgrid(), w3odatmd::upproc, w3wdatmd::ust, w3wdatmd::ustdir, w3wdatmd::va, w3adatmd::w3dima(), w3idatmd::w3dimi(), w3wdatmd::w3dimw(), w3odatmd::w3dmo5(), w3iogomd::w3flgrdupdt(), w3iogrmd::w3iogr(), w3iopomd::w3iopp(), w3iorsmd::w3iors(), w3mpii(), w3mpio(), w3mpip(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3idatmd::w3seti(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3dispmd::wavnu1(), w3dispmd::wavnu3(), w3wdatmd::wlv, w3adatmd::wn, w3servmd::wwdate(), w3servmd::wwtime(), wwver, w3gdatmd::xgrd, w3gdatmd::ygrd, w3gdatmd::zb, and w3wdatmd::zeta_setup.

Referenced by wminitmd::wminit(), and wminitmd::wminitnml().

w3mpii()

subroutine w3initmd::w3mpii

(

integer, intent(in)

IMOD

)

Perform initializations for MPI version of model.

Data transpose only.

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.

Parameters

[in]

IMOD

Model number.

Author

H. L. Tolman

Date

11-May-2007

Definition at line 1691 of file w3initmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | 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 ----------------------------------------------------- /
    !/

References w3adatmd::bispl, w3adatmd::bstat, w3adatmd::gstore, w3gdatmd::gtype, w3adatmd::iappro, w3odatmd::iaproc, w3adatmd::ibfloc, include(), w3adatmd::irqsg1, w3adatmd::irqsg2, w3adatmd::isploc, constants::lpdlib, w3adatmd::mpi_comm_wave, w3adatmd::mpibuf, w3odatmd::naproc, w3odatmd::ndst, w3adatmd::nrqsg1, w3adatmd::nrqsg2, w3gdatmd::nsea, w3adatmd::nsealm, w3gdatmd::nspec, w3adatmd::nsploc, w3adatmd::sstore, w3servmd::strace(), w3gdatmd::ungtype, w3wdatmd::va, w3adatmd::wadats, w3adatmd::ww3_field_vec, and w3adatmd::ww3_spec_vec.

Referenced by w3init().

w3mpio()

subroutine w3initmd::w3mpio

(

integer, intent(in)

IMOD

)

Prepare MPI persistent communication needed for WAVEWATCH I/O routines.

Create handles as needed. 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.

Parameters

[in]

IMOD

Model number.

Author

H. L. Tolman

Date

11-Nov-2015

Definition at line 2032 of file w3initmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | 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 ----------------------------------------------------- /
    !/

References w3adatmd::aba, w3adatmd::abd, w3odatmd::abpos, w3wdatmd::asf, w3adatmd::bedforms, w3adatmd::bhd, w3adatmd::cflkmax, w3adatmd::cflthmax, w3adatmd::cflxymax, w3adatmd::cge, w3adatmd::charn, w3adatmd::cx, w3adatmd::cy, w3adatmd::dtdyn, w3gdatmd::e3df, w3adatmd::ef, w3adatmd::embia1, w3adatmd::embia2, w3servmd::extcde(), w3adatmd::fcut, w3odatmd::flogr2, w3odatmd::flogrd, w3odatmd::flogrr, w3odatmd::flout, w3adatmd::fp0, w3wdatmd::fpis, w3gdatmd::gtype, w3adatmd::hcmaxd, w3adatmd::hcmaxe, w3adatmd::hmaxd, w3adatmd::hmaxe, w3adatmd::hs, w3adatmd::hsig, w3odatmd::iaproc, w3wdatmd::icef, include(), w3parall::init_get_jsea_isproc(), w3odatmd::iostyp, w3odatmd::iptint, w3odatmd::irqbp1, w3odatmd::irqbp2, w3odatmd::irqgo, w3odatmd::irqgo2, w3odatmd::irqpo1, w3odatmd::irqpo2, w3odatmd::irqrs, w3odatmd::irqrss, w3odatmd::irqtr, w3odatmd::isbpo, w3odatmd::it0pnt, w3odatmd::it0prt, w3odatmd::it0trk, constants::lpdlib, w3gdatmd::mapfs, w3adatmd::mpi_comm_wave, w3adatmd::mscd, w3adatmd::mscx, w3adatmd::mscy, w3adatmd::mssd, w3adatmd::mssx, w3adatmd::mssy, w3odatmd::napbpt, w3odatmd::napfld, w3odatmd::nappnt, w3odatmd::naproc, w3odatmd::naprst, w3odatmd::naptrk, w3odatmd::nblkrs, w3odatmd::nbo2, w3odatmd::ndse, w3odatmd::ndst, w3odatmd::nfbpo, w3odatmd::ngrpp, w3gdatmd::nk, w3odatmd::noextr, w3odatmd::noge, w3odatmd::nogrp, w3odatmd::nopts, w3odatmd::noswll, w3odatmd::nrqbp, w3odatmd::nrqbp2, w3odatmd::nrqgo, w3odatmd::nrqgo2, w3odatmd::nrqpo, w3odatmd::nrqpo2, w3odatmd::nrqrs, w3odatmd::nrqtr, w3gdatmd::nsea, w3adatmd::nsealm, w3gdatmd::nspec, w3odatmd::ntproc, w3gdatmd::nx, w3iorsmd::oarst, w3odatmd::outpts, w3gdatmd::p2msf, w3adatmd::p2sms, w3adatmd::pdir, w3adatmd::pep, w3adatmd::pgw, w3adatmd::phiaw, w3adatmd::phibbl, w3adatmd::phice, w3adatmd::phioc, w3adatmd::phs, w3adatmd::plp, w3adatmd::pnr, w3adatmd::ppe, w3adatmd::pqp, w3adatmd::prms, w3adatmd::psi, w3adatmd::psw, w3adatmd::pt1, w3adatmd::pt2, w3adatmd::pthp0, w3adatmd::ptm1, w3adatmd::ptp, w3adatmd::pws, w3adatmd::pwst, w3adatmd::qkk, w3adatmd::qp, w3odatmd::rsblks, w3adatmd::skew, w3adatmd::sppnt, w3adatmd::sth1m, w3adatmd::sth2m, w3adatmd::stmaxd, w3adatmd::stmaxe, w3servmd::strace(), w3adatmd::sxx, w3adatmd::sxy, w3adatmd::syy, w3adatmd::t01, w3adatmd::t02, w3adatmd::t0m1, w3adatmd::taubbl, w3adatmd::tauice, w3adatmd::tauocx, w3adatmd::tauocy, w3adatmd::tauox, w3adatmd::tauoy, w3adatmd::tauwix, w3adatmd::tauwiy, w3adatmd::tauwnx, w3adatmd::tauwny, w3adatmd::th1m, w3adatmd::th2m, w3adatmd::thm, w3adatmd::thp0, w3adatmd::ths, w3adatmd::tpms, w3adatmd::tusx, w3adatmd::tusy, w3adatmd::tws, w3adatmd::uba, w3adatmd::ubd, w3gdatmd::ungtype, w3adatmd::us3d, w3gdatmd::us3df, w3adatmd::usero, w3adatmd::ussp, w3gdatmd::usspf, w3adatmd::ussx, w3adatmd::ussy, w3wdatmd::ust, w3wdatmd::ustdir, w3wdatmd::va, w3odatmd::vaaux, w3adatmd::w3seta(), w3adatmd::w3xdma(), w3adatmd::w3xeta(), w3adatmd::wbt, w3adatmd::whitecap, w3adatmd::wlm, w3adatmd::wnmean, and w3adatmd::ww3_field_vec.

Referenced by w3init().

w3mpip()

subroutine w3initmd::w3mpip

(

integer, intent(in)

IMOD

)

Prepare MPI persistent communication needed for WAVEWATCH I/O routines.

Create handles as needed.

Parameters

[in]

IMOD

Model number.

Author

H. L. Tolman

Date

30-Oct-2009

Definition at line 5388 of file w3initmd.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | 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 ----------------------------------------------------- /
    !/

References w3servmd::extcde(), w3odatmd::flout, w3odatmd::iaproc, include(), w3parall::init_get_jsea_isproc(), w3odatmd::iptint, w3odatmd::irqpo1, w3odatmd::irqpo2, w3odatmd::it0pnt, w3odatmd::it0trk, w3gdatmd::mapfs, w3adatmd::mpi_comm_wave, w3odatmd::nappnt, w3odatmd::naproc, w3odatmd::ndse, w3odatmd::ndst, w3odatmd::nopts, w3odatmd::nrqpo, w3odatmd::nrqpo2, w3gdatmd::nspec, w3gdatmd::nx, w3gdatmd::ny, w3odatmd::o2irqi, w3odatmd::outpts, w3adatmd::sppnt, w3servmd::strace(), and w3wdatmd::va.

Referenced by w3init(), and wmiopomd::wmiopp().

Variable Documentation

critos

real, parameter w3initmd::critos = 15.

Definition at line 128 of file w3initmd.F90.

  REAL, PARAMETER                :: CRITOS = 15.

Referenced by w3init().

switches

character(len=512), parameter w3initmd::switches = __WW3_SWITCHES__

Definition at line 130 of file w3initmd.F90.

  CHARACTER(LEN=512), PARAMETER  :: SWITCHES  = &
       __ww3_switches__

Referenced by w3ounf().

wwver

character(len=10), parameter w3initmd::wwver = '7.14 '

Definition at line 129 of file w3initmd.F90.

  CHARACTER(LEN=10), PARAMETER   :: WWVER  = '7.14  '

Referenced by w3init(), w3ounf(), wminitmd::wminit(), and wminitmd::wminitnml().