wminiomd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!/ ------------------------------------------------------------------- /
MODULE wminiomd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         28-Sep-2016 |
  !/                  +-----------------------------------+
  !/
  !/    29-May-2006 : Origination.                        ( version 3.09 )
  !/    21-Dec-2006 : VTIME change in WMIOHx and WMIOEx.  ( version 3.10 )
  !/    22-Jan-2007 : Adding NAVMAX in WMIOEG.            ( version 3.10 )
  !/    30-Jan-2007 : Fix memory leak WMIOBS.             ( version 3.10 )
  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
  !/    28-Sep-2016 : Add error traps for MPI tags.       ( version 5.15 )
  !/    16-Dec-2020 : Modify WMIOES/G for SMC grid.  JGLi ( version 7.13 )
  !/
  !/    Copyright 2009 National Weather Service (NWS),
  !/       National Oceanic and Atmospheric Administration.  All rights
  !/       reserved.  WAVEWATCH III is a trademark of the NWS.
  !/       No unauthorized use without permission.
  !/
  !  1. Purpose :
  !
  !     Internal IO routines for the multi-grid model.
  !
  !  2. Variables and types :
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      WMIOBS    Subr. Public   Stage internal boundary data.
  !      WMIOBG    Subr. Public   Gather internal boundary data.
  !      WMIOBF    Subr. Public   Finalize WMIOBS.            ( !/MPI )
  !      WMIOHS    Subr. Public   Stage internal high to low data.
  !      WMIOHG    Subr. Public   Gather internal high to low data.
  !      WMIOHF    Subr. Public   Finalize WMIOHS.            ( !/MPI )
  !      WMIOES    Subr. Public   Stage internal same rank data.
  !      WMIOEG    Subr. Public   Gather internal same rank data.
  !      WMIOEF    Subr. Public   Finalize WMIOES.            ( !/MPI )
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3SETG, W3SETW, W3SETA, W3SETO, WMSETM
  !                Subr. WxxDATMD Manage data structures.
  !      W3UBPT    Subr. W3UBPTMD Update internal bounday spectra.
  !      W3IOBC    Subr  W3IOBCMD I/O of boundary data.
  !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
  !      STRACE    Sur.  W3SERVMD Subroutine tracing.
  !
  !      MPI_ISEND, MPI_IRECV, MPI_TESTALL, MPI_WAITALL
  !                Subr.  mpif.h  MPI routines.
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !       !/SHRD   Shared/distributed memory models.
  !       !/DIST
  !       !/MPI
  !
  !       !/S      Enable subroutine tracing.
  !       !/T      Enable test output
  !       !/MPIT
  !
  !  6. Switches :
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  PUBLIC
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmiobs ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         06-Jun-2018 !
    !/                  +-----------------------------------+
    !/
    !/    06-Oct-2005 : Origination.                        ( version 3.08 )
    !/    29-May-2006 : Adding buffering for MPI.           ( version 3.09 )
    !/    30-Jan-2007 : Fix memory leak.                    ( version 3.10 )
    !/    28-Sep-2016 : Add error traps for MPI tags.       ( version 5.15 )
    !/    06-Jun-2018 : Use W3PARALL/add DEBUGIOBC/PDLIB    ( version 6.04 )
    !/
    !  1. Purpose :
    !
    !     Stage internal boundary data in the data structure BPSTGE.
    !
    !  2. Method :
    !
    !     For the shared memory version, arrays are initialized and the
    !     data are copied. For the distributed memory version, the data
    !     are moved using a non-blocking send. in this case, the arrays
    !     are dimensioned on the recieving side.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data is to
    !                          be staged.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG, W3SETW, W3SETA, W3SETO, WMSETM
    !                Subr. WxxDATMD Manage data structures.
    !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !      EXTCDE    Sur.    Id.    Program abort.
    !
    !      MPI_ISEND
    !                Subr. mpif.h   MPI routines.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMINIT    Subr  WMINITMD Multi-grid model initialization.
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     See FORMAT label 1001.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Enable test output
    !       !/MPIT
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3gdatmd
    USE w3wdatmd
    USE w3adatmd
    USE w3odatmd
    USE wmmdatmd
    !
    USE w3cspcmd, ONLY: w3cspc
    USE w3servmd, ONLY: extcde
    USE w3parall, ONLY: init_get_jsea_isproc
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J, I, IOFF, ISEA, JSEA, IS
#ifdef W3_DIST
    INTEGER                 :: ISPROC
#endif
#ifdef W3_MPI
    INTEGER                 :: IP, IT0, ITAG, IERR_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:)
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    REAL, POINTER           :: SBPI(:,:), TSTORE(:,:)
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOBS')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
    WRITE (mdst,9001) nbi2g(:,imod)
#endif
    !
    IF ( sum(nbi2g(:,imod)) .EQ. 0 ) RETURN
    !
    CALL w3seto ( imod, mdse, mdst )
    CALL w3setg ( imod, mdse, mdst )
    CALL w3setw ( imod, mdse, mdst )
    CALL w3seta ( imod, mdse, mdst )
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over grids
    !
    DO j=1, nrgrd
      !
      IF ( nbi2g(j,imod) .EQ. 0 ) cycle
      !
      CALL wmsetm (   j , mdse, mdst )
      !
      IF ( imod .EQ. 1 ) THEN
        ioff   = 0
      ELSE
        ioff   = sum(nbi2g(j,1:imod-1))
      END IF
      !
#ifdef W3_T
      WRITE (mdst,9010) nbi2g(j,imod),imod,j,ioff+1,respec(j,imod)
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 2.  Allocate arrays
      !
#ifdef W3_SHRD
      IF ( bpstge(j,imod)%INIT ) THEN
        IF ( SIZE(bpstge(j,imod)%SBPI(:,1)) .NE. nspec .OR. &
             SIZE(bpstge(j,imod)%SBPI(1,:))                 &
             .NE. nbi2g(j,imod) ) THEN
          DEALLOCATE ( bpstge(j,imod)%SBPI )
          bpstge(j,imod)%INIT = .false.
        END IF
      END IF
#endif
      !
#ifdef W3_SHRD
      IF ( .NOT. bpstge(j,imod)%INIT ) THEN
        nspec  => sgrds(j)%NSPEC
        ALLOCATE ( bpstge(j,imod)%SBPI(nspec,nbi2g(j,imod)) )
        nspec  => sgrds(imod)%NSPEC
        bpstge(j,imod)%INIT  = .true.
      END IF
#endif
      !
#ifdef W3_SHRD
      IF ( respec(j,imod) ) THEN
        ALLOCATE ( tstore(nspec,nbi2g(j,imod)) )
        sbpi   => tstore
      ELSE
        sbpi   => bpstge(j,imod)%SBPI
      END IF
#endif
      !
#ifdef W3_MPI
      naproc => outpts(j)%NAPROC
      ALLOCATE ( irq(nbi2g(j,imod)*naproc+naproc) )
      ALLOCATE ( bpstge(j,imod)%TSTORE(nspec,nbi2g(j,imod)) )
      naproc => outpts(imod)%NAPROC
#endif
      !
#ifdef W3_MPI
      nrq    => bpstge(j,imod)%NRQBPS
      sbpi   => bpstge(j,imod)%TSTORE
#endif
      !
#ifdef W3_MPI
      nrq    = 0
      irq    = 0
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 3.  Set the time
      !     Note that with MPI the send needs to be posted to the local
      !     processor too to make time management possible.
      !
#ifdef W3_T
      WRITE (mdst,9030) time
#endif
#ifdef W3_MPIT
      WRITE (mdst,9080)
#endif
      !
#ifdef W3_SHRD
      bpstge(j,imod)%VTIME = time
#endif
      !
#ifdef W3_MPI
      IF ( iaproc .EQ. 1 ) THEN
        bpstge(j,imod)%STIME = time
        itag   = mtag0 + imod + (j-1)*nrgrd
        IF ( itag .GT. mtag1 ) THEN
          WRITE (mdse,1001)
          CALL extcde (1001)
        END IF
        DO ip=1, nmproc
          IF ( allprc(ip,j) .NE. 0 .AND.                 &
               allprc(ip,j) .LE. outpts(j)%NAPROC ) THEN
            nrq    = nrq + 1
            CALL mpi_isend ( bpstge(j,imod)%STIME, 2,  &
                 mpi_integer, ip-1, itag,  &
                 mpi_comm_mwave, irq(nrq), &
                 ierr_mpi )
#endif
#ifdef W3_MPIT
            WRITE (mdst,9081) nrq, ip, itag-mtag0,     &
                 irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
          END IF
        END DO
      END IF
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 4.  Stage the spectral data
      !
      DO i=1, nbi2g(j,imod)
        !
        isea   = nbi2s(ioff+i,2)
#ifdef W3_SHRD
        jsea   = isea
#endif
#ifdef W3_DIST
        CALL init_get_jsea_isproc(isea, jsea, isproc)
        IF ( isproc .NE. iaproc ) cycle
#endif
#ifdef W3_MPI
        it0    = mtag0 + nrgrd**2 + sum(nbi2g(1:j-1,:)) +      &
             sum(nbi2g(j,1:imod-1))
#endif
        !
        DO is=1, nspec
          sbpi(is,i) = va(is,jsea) * sig2(is) / cg(1+(is-1)/nth,isea)
        END DO
        !
#ifdef W3_MPI
        DO ip=1, nmproc
          IF ( allprc(ip,j) .NE. 0 .AND.                   &
               allprc(ip,j) .LE. outpts(j)%NAPROC ) THEN
            nrq    = nrq + 1
            itag   = it0 + i
            IF ( itag .GT. mtag1 ) THEN
              WRITE (mdse,1001)
              CALL extcde (1001)
            END IF
            CALL mpi_isend ( sbpi(1,i), nspec, mpi_real, &
                 ip-1, itag, mpi_comm_mwave, &
                 irq(nrq), ierr_mpi )
#endif
#ifdef W3_MPIT
            WRITE (mdst,9082) nrq, jsea, ip, itag-mtag0, &
                 irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
          END IF
        END DO
#endif
        !
      END DO
      !
#ifdef W3_MPIT
      WRITE (mdst,9083)
      WRITE (mdst,9084) nrq
#endif
      !
#ifdef W3_MPI
      IF ( nrq .GT. 0 ) THEN
        ALLOCATE ( bpstge(j,imod)%IRQBPS(nrq) )
        bpstge(j,imod)%IRQBPS = irq(:nrq)
      ELSE
        DEALLOCATE ( bpstge(j,imod)%TSTORE )
      END IF
#endif
      !
#ifdef W3_MPI
      DEALLOCATE ( irq )
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 5.  Convert spectra ( !/SHRD only )
      !
#ifdef W3_SHRD
      IF ( respec(j,imod) ) THEN
        sbpi   => bpstge(j,imod)%SBPI
        CALL w3cspc ( tstore, nk, nth, xfr, fr1, th(1),     &
             sbpi, sgrds(j)%NK, sgrds(j)%NTH, sgrds(j)%XFR, &
             sgrds(j)%FR1, sgrds(j)%TH(1), nbi2g(j,imod),   &
             mdst, mdse, sgrds(j)%FACHFE )
        DEALLOCATE ( tstore )
      END IF
#endif
      !
      ! ... End of loop over grids
      !
    END DO
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_MPI
1001 FORMAT (/' *** ERROR WMIOBS : REQUESTED MPI TAG EXCEEDS', &
         ' UPPER BOUND (MTAG1) ***')
#endif
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOBS : STAGING DATA FROM GRID ',i3)
9001 FORMAT ( ' TEST WMIOBS : NR. OF SPECTRA PER GRID : '/        &
         '             ',25i4)
#endif
    !
#ifdef W3_T
9010 FORMAT ( ' TEST WMIOBS : STAGING',i4,' SPECTRA FROM GRID ',  &
         i3,' TO GRID ',i3/                                &
         '               STARTING WITH SPECTRUM ',i4,        &
         ', RESPEC =',l2)
#endif
    !
#ifdef W3_T
9030 FORMAT ( ' TEST WMIOBS : TIME :',i10.8,i7.6)
#endif
    !
#ifdef W3_MPIT
9080 FORMAT (/' MPIT WMIOBS: COMMUNICATION CALLS            '/ &
         ' +------+------+------+------+--------------+'/ &
         ' |  IH  |  ID  | TARG |  TAG |   handle err |'/ &
         ' +------+------+------+------+--------------+')
9081 FORMAT ( ' |',i5,' | TIME |',2(i5,' |'),i9,i4,' |')
9082 FORMAT ( ' |',i5,' |',i5,' |',2(i5,' |'),i9,i4,' |')
9083 FORMAT ( ' +------+------+------+------+--------------+')
9084 FORMAT ( ' MPIT WMIOBS: NRQBPT:',i10/)
#endif
    !/
    !/ End of WMIOBS ----------------------------------------------------- /
    !/
  END SUBROUTINE wmiobs
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmiobg ( IMOD, DONE )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         29-May-2006 !
    !/                  +-----------------------------------+
    !/
    !/    18-Oct-2005 : Origination.                        ( version 3.08 )
    !/    29-May-2006 : Adding buffering for MPI.           ( version 3.09 )
    !/
    !  1. Purpose :
    !
    !     Gather internal boundary data for a given model.
    !
    !  2. Method :
    !
    !     For the shared memory version, datat are gathered from the data
    !     structure BPSTGE. For the distributed memeory version, the
    !     gathering of thee data are finished first.
    !
    !     Gathering of data is triggered by the time stamp of the data
    !     that is presently in the storage arrays.
    !
    !     This routine preempts the data flow normally executed by
    !     W3IOBC and W3UBPT, and hence bypasses both routines in W3WAVE.
    !
    !  2. Method :
    !
    !     Using storage array BPSTAGE and time stamps.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data is to
    !                          be gathered.
    !       DONE    Log.   O   Flag for completion of operation (opt).
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG, W3SETW, W3SETA, W3SETO, WMSETM
    !                Subr. WxxDATMD Manage data structures.
    !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
    !      W3UBPT    Subr. W3UBPTMD Update internal bounday spectra.
    !      W3IOBC    Subr  W3IOBCMD I/O of boundary data.
    !      STRACE    Sur.  W3SERVMD Subroutine tracing.
    !      EXTCDE    Sur.    Id.    Program abort.
    !      DSEC21    Func. W3TIMEMD Difference between times.
    !
    !      MPI_IRECV, MPI_TESTALL, MPI_WAITALL
    !                Subr.  mpif.h  MPI routines.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMINIT    Subr  WMINITMD Multi-grid model initialization.
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     See FORMAT labels 1001-1002.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3gdatmd
    USE w3wdatmd
    USE w3adatmd
    USE w3odatmd
    USE wmmdatmd
    !
    USE w3cspcmd, ONLY: w3cspc
    USE w3timemd, ONLY: dsec21
    USE w3updtmd, ONLY: w3ubpt
    USE w3iobcmd, ONLY: w3iobc
    USE w3servmd, ONLY: extcde
    !      USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC_GLOB
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)            :: IMOD
    LOGICAL, INTENT(OUT), OPTIONAL :: DONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J, I, IOFF, TTEST(2), ITEST
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI, IT0, ITAG, IFROM,     &
         ISEA, JSEA, ISPROC
#endif
#ifdef W3_MPIT
    INTEGER                 :: ICOUNT
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER, POINTER        :: VTIME(:)
#ifdef W3_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:)
    INTEGER, ALLOCATABLE    :: STATUS(:,:)
#endif
    REAL                    :: DTTST, DT1, DT2, W1, W2
    REAL, POINTER           :: SBPI(:,:)
#ifdef W3_MPI
    REAL, ALLOCATABLE       :: TSTORE(:,:)
    LOGICAL                 :: FLAGOK
#endif
#ifdef W3_MPIT
    LOGICAL                 :: FLAG
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOBG')
#endif
 
 
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
    WRITE (mdst,9001) nbi2g(imod,:)
#endif
    !
    IF ( PRESENT(done) ) done = .false.
    !
    CALL w3seto ( imod, mdse, mdst )
    !
    IF ( iaproc .GT. naproc ) THEN
      IF ( PRESENT(done) ) done = .true.
#ifdef W3_T
      WRITE (mdst,9002)
#endif
      RETURN
    END IF
    !
    IF ( sum(nbi2g(imod,:)) .EQ. 0 ) THEN
      IF ( PRESENT(done) ) done = .true.
#ifdef W3_T
      WRITE (mdst,9003)
#endif
      RETURN
    END IF
    !
    CALL w3setg ( imod, mdse, mdst )
    CALL w3setw ( imod, mdse, mdst )
    CALL w3seta ( imod, mdse, mdst )
    !
    IF ( tbpin(1) .NE. -1 ) THEN
      IF ( dsec21(time,tbpin) .GT. 0. ) THEN
        IF ( PRESENT(done) ) done = .true.
#ifdef W3_T
        WRITE (mdst,9004)
#endif
        RETURN
      END IF
    END IF
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Testing / gathering data in staging arrays
    !
#ifdef W3_T
    WRITE (mdst,9010)
#endif
    !
    ! 1.a Shared memory version, test valid times. - - - - - - - - - - - - /
    !
#ifdef W3_SHRD
    DO j=1, nrgrd
#endif
      !
#ifdef W3_SHRD
      IF ( nbi2g(imod,j) .EQ. 0 ) cycle
      vtime  => bpstge(imod,j)%VTIME
#endif
      !
#ifdef W3_SHRD
      IF ( vtime(1) .EQ. -1 ) THEN
        IF ( nmproc .EQ. nmperr ) WRITE (mdse,1001)
        CALL extcde ( 1001 )
      END IF
#endif
      !
#ifdef W3_SHRD
      dttst  = dsec21( time, vtime )
      IF ( dttst.LE.0. .AND. tbpin(1).NE.-1 ) RETURN
#endif
      !
#ifdef W3_SHRD
    END DO
#endif
    !
    ! 1.b Distributed memory version - - - - - - - - - - - - - - - - - - - /
    !
#ifdef W3_MPIT
    WRITE (mdst,9011) nbista(imod)
#endif
    !
    ! 1.b.1 NBISTA = 0
    !       Check if staging arrays are initialized.
    !       Post the proper receives.
    !
#ifdef W3_MPI
    IF ( nbista(imod) .EQ. 0 ) THEN
#endif
      !
#ifdef W3_MPI
      nrq    => mdatas(imod)%NRQBPG
      nrq    = nrgrd + sum(nbi2g(imod,:))
      ALLOCATE ( mdatas(imod)%IRQBPG(nrq) )
      irq    => mdatas(imod)%IRQBPG
      irq    = 0
      nrq    = 0
#endif
      !
#ifdef W3_MPI
      DO j=1, nrgrd
        IF ( nbi2g(imod,j) .EQ. 0 ) cycle
#endif
        !
        ! ..... Staging arrays
        !
#ifdef W3_MPI
        IF ( bpstge(imod,j)%INIT ) THEN
          IF ( respec(imod,j) ) THEN
            DEALLOCATE ( bpstge(imod,j)%SBPI )
            bpstge(imod,j)%INIT  = .false.
#endif
#ifdef W3_MPIT
            WRITE (mdst,9012) j, 'RESET'
#endif
#ifdef W3_MPI
          ELSE
            IF ( SIZE(bpstge(imod,j)%SBPI(:,1)) .NE.     &
                 sgrds(j)%NSPEC .OR. &
                 SIZE(bpstge(imod,j)%SBPI(1,:)) .NE.     &
                 nbi2g(imod,j) ) THEN
              IF ( improc .EQ. nmperr ) WRITE (mdse,1003)
              CALL extcde (1003)
            END IF
#endif
#ifdef W3_MPIT
            WRITE (mdst,9012) j, 'TESTED'
#endif
#ifdef W3_MPI
          END IF
        END IF
#endif
        !
#ifdef W3_MPI
        IF ( .NOT. bpstge(imod,j)%INIT ) THEN
          nspec  => sgrds(j)%NSPEC
          ALLOCATE (bpstge(imod,j)%SBPI(nspec,nbi2g(imod,j)))
          nspec  => sgrds(imod)%NSPEC
          bpstge(imod,j)%INIT  = .true.
#endif
#ifdef W3_MPIT
          WRITE (mdst,9012) j, 'INITIALIZED'
#endif
#ifdef W3_MPI
        END IF
#endif
        !
        ! ..... Check valid time to determine staging.
        !
#ifdef W3_MPI
        vtime  => bpstge(imod,j)%VTIME
        IF ( vtime(1) .EQ. -1 ) THEN
          dttst  = 0.
        ELSE
          dttst  = dsec21( time, vtime )
        END IF
#endif
#ifdef W3_MPIT
        WRITE (mdst,9013) vtime, dttst
#endif
        !
        ! ..... Post receives for data gather
        !
#ifdef W3_MPI
        IF ( dttst .LE. 0. ) THEN
#endif
#ifdef W3_MPIT
          WRITE (mdst,9014) j
#endif
          !
          ! ..... Time
          !
#ifdef W3_MPI
          itag   = mtag0 + j + (imod-1)*nrgrd
          ifrom  = mdatas(j)%CROOT - 1
          nrq    = nrq + 1
          CALL mpi_irecv ( bpstge(imod,j)%VTIME, 2,        &
               mpi_integer, ifrom, itag,       &
               mpi_comm_mwave, irq(nrq),       &
               ierr_mpi )
#endif
#ifdef W3_MPIT
          WRITE (mdst,9015) nrq, ifrom+1, itag-mtag0,      &
               irq(nrq), ierr_mpi
#endif
          !
          ! ..... Spectra
          !
#ifdef W3_MPI
          IF ( j .EQ. 1 ) THEN
            ioff   = 0
          ELSE
            ioff   = sum(nbi2g(imod,1:j-1))
          END IF
#endif
          !
#ifdef W3_MPI
          it0 = mtag0 + nrgrd**2 + sum(nbi2g(1:imod-1,:))  &
               + sum(nbi2g(imod,1:j-1))
#endif
          !
#ifdef W3_MPI
          sbpi  => bpstge(imod,j)%SBPI
#endif
          !
#ifdef W3_MPI
          naproc => outpts(j)%NAPROC
          nspec  => sgrds(j)%NSPEC
          DO i=1, nbi2g(imod,j)
            isea   = nbi2s(ioff+i,2)
            CALL init_get_jsea_isproc_glob(isea, j, jsea, isproc)
            nrq    = nrq + 1
            itag   = it0 + i
            CALL mpi_irecv ( sbpi(1,i), nspec,             &
                 mpi_real, isproc-1,           &
                 itag, mpi_comm_mwave,         &
                 irq(nrq), ierr_mpi )
#endif
#ifdef W3_MPIT
            WRITE (mdst,9016) nrq, jsea, isproc,             &
                 itag-mtag0, irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
          END DO
          nspec  => sgrds(imod)%NSPEC
          naproc => outpts(imod)%NAPROC
#endif
          !
          ! ..... End IF for posting receives 1.b.1
          !
#ifdef W3_MPIT
          WRITE (mdst,9017)
#endif
#ifdef W3_MPI
        END IF
#endif
        !
        ! ..... End grid loop J in 1.b.1
        !
#ifdef W3_MPI
      END DO
#endif
#ifdef W3_MPIT
      WRITE (mdst,9018) nrq
#endif
      !
      ! ..... Reset status
      !       NOTE: if NBI.EQ.0 all times are already OK, skip to section 2
      !
#ifdef W3_MPI
      IF ( nbi .GT. 0 ) THEN
        nbista(imod) = 1
#endif
#ifdef W3_MPIT
        WRITE (mdst,9011) nbista(imod)
#endif
#ifdef W3_MPI
      END IF
#endif
      !
      ! ..... End IF in 1.b.1
      !
#ifdef W3_MPI
    END IF
#endif
    !
    ! 1.b.2 NBISTA = 1
    !       Wait for communication to finish.
    !       If DONE defined, check if done, otherwise wait.
    !
#ifdef W3_MPI
    IF ( nbista(imod) .EQ. 1 ) THEN
#endif
      !
#ifdef W3_MPI
      nrq    => mdatas(imod)%NRQBPG
      irq    => mdatas(imod)%IRQBPG
      ALLOCATE ( status(mpi_status_size,nrq) )
#endif
      !
      ! ..... Test communication if DONE is present, wait otherwise
      !
#ifdef W3_MPI
      IF ( PRESENT(done) ) THEN
#endif
        !
#ifdef W3_MPI
        CALL mpi_testall ( nrq, irq, flagok, status,       &
             ierr_mpi )
#endif
        !
#ifdef W3_MPIT
        icount = 0
        DO i=1, nrq
          CALL mpi_test ( irq(i), flag, status(1,1),      &
               ierr_mpi )
          flagok = flagok .AND. flag
          IF ( flag ) icount = icount + 1
        END DO
        WRITE (mdst,9019) 100. * real(icount) / real(nrq)
#endif
        !
#ifdef W3_MPI
      ELSE
#endif
        !
#ifdef W3_MPI
        CALL mpi_waitall ( nrq, irq, status, ierr_mpi )
        flagok = .true.
#endif
        !
#ifdef W3_MPI
      END IF
#endif
      !
#ifdef W3_MPI
      DEALLOCATE ( status )
#endif
      !
      ! ..... Go on based on FLAGOK
      !
#ifdef W3_MPI
      IF ( flagok ) THEN
        DEALLOCATE ( mdatas(imod)%IRQBPG )
        nrq    = 0
      ELSE
        RETURN
      END IF
#endif
      !
#ifdef W3_MPI
      nbista(imod) = 2
#endif
#ifdef W3_MPIT
      WRITE (mdst,9011) nbista(imod)
#endif
      !
      ! 1.b.3 Convert spectra if needed
      !
#ifdef W3_MPI
      DO j=1, nrgrd
#endif
        !
#ifdef W3_MPI
        IF ( respec(imod,j) .AND. nbi2g(imod,j).NE.0 ) THEN
#endif
          !
#ifdef W3_MPIT
          WRITE (mdst,9100) j
#endif
#ifdef W3_MPI
          nspec  => sgrds(j)%NSPEC
          ALLOCATE ( tstore(nspec,nbi2g(imod,j)))
          nspec  => sgrds(imod)%NSPEC
          tstore = bpstge(imod,j)%SBPI
          DEALLOCATE ( bpstge(imod,j)%SBPI )
          ALLOCATE (bpstge(imod,j)%SBPI(nspec,nbi2g(imod,j)))
#endif
          !
#ifdef W3_MPI
          sbpi   => bpstge(imod,j)%SBPI
          CALL w3cspc ( tstore, sgrds(j)%NK, sgrds(j)%NTH, &
               sgrds(j)%XFR, sgrds(j)%FR1, sgrds(j)%TH(1), &
               sbpi, nk, nth, xfr, fr1, th(1),             &
               nbi2g(imod,j), mdst, mdse, sgrds(imod)%FACHFE)
#endif
          !
#ifdef W3_MPI
          DEALLOCATE ( tstore )
#endif
          !
#ifdef W3_MPI
        END IF
#endif
        !
#ifdef W3_MPI
      END DO
#endif
      !
#ifdef W3_MPI
      nbista(imod) = 0
#endif
#ifdef W3_MPIT
      WRITE (mdst,9011) nbista(imod)
#endif
      !
#ifdef W3_MPI
    END IF
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Update arrays ABPI0/N and data times
    !
#ifdef W3_T
    WRITE (mdst,9020)
#endif
    !
    ! 2.a Determine next valid time
    !
    ttest  = -1
    DO j=1, nrgrd
      IF ( nbi2g(imod,j) .EQ. 0 ) cycle
      vtime  => bpstge(imod,j)%VTIME
      IF ( ttest(1) .EQ. -1 ) THEN
        ttest  = vtime
      ELSE
        dttst  = dsec21(vtime,ttest)
        IF ( dttst .GT. 0. ) ttest  = vtime
      END IF
    END DO
    !
#ifdef W3_T
    WRITE (mdst,9021) ttest
#endif
    !
    ! 2.b Shift data
    !
    IF ( tbpin(1) .EQ. -1 ) THEN
      dttst  = dsec21(ttest,time)
      IF ( dttst .NE. 0. ) THEN
        IF ( nmproc .EQ. nmperr ) WRITE (mdse,1002)
        CALL extcde(1002)
      END IF
      abpi0  = 0.
    ELSE
      tbpi0  = tbpin
      abpi0  = abpin
    END IF
    !
    ! 2.c Loop over grids for new spectra
    !
    DO j=1, nrgrd
      !
      IF ( nbi2g(imod,j) .EQ. 0 ) cycle
      vtime  => bpstge(imod,j)%VTIME
      sbpi   => bpstge(imod,j)%SBPI
      !
      IF ( j .EQ. 1 ) THEN
        ioff   = 0
      ELSE
        ioff   = sum(nbi2g(imod,1:j-1))
      END IF
      !
      IF ( tbpin(1) .EQ. -1 ) THEN
        w1     = 0.
        w2     = 1.
      ELSE
        dt1    = dsec21(tbpi0,vtime)
        dt2    = dsec21(tbpi0,ttest)
        w2     = dt2 / dt1
        w1     = 1. - w2
      END IF
#ifdef W3_T
      WRITE (mdst,9022) nbi2g(imod,j), j, ioff+1, w1, w2
#endif
      !
      abpin(:,ioff+1:ioff+nbi2g(imod,j)) =                          &
           w1 * abpi0(:,ioff+1:ioff+nbi2g(imod,j)) +         &
           w2 * sbpi(:,1:nbi2g(imod,j))
      !
    END DO
    !
    ! 2.d New time
    !
    tbpin  = ttest
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Dump data to file if requested
    !
    IF ( iaproc.EQ.napbpt .AND. bcdump(imod) ) THEN
#ifdef W3_T
      WRITE (mdst,9030)
#endif
      CALL w3iobc ( 'DUMP', nds(9), tbpin, tbpin, itest, imod )
    END IF
    !
    ! -------------------------------------------------------------------- /
    ! 4.  Update arrays BBPI0/N
    !
#ifdef W3_T
    WRITE (mdst,9040)
#endif
    !
    CALL w3ubpt
    !
    ! -------------------------------------------------------------------- /
    ! 5.  Successful update
    !
    IF ( PRESENT(done) ) done = .true.
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_SHRD
1001 FORMAT (/' *** ERROR WMIOBG : NO DATA IN STAGING ARRAY ***'/    &
         '                    CALL WMIOBS FIRST '/)
#endif
1002 FORMAT (/' *** ERROR WMIOBG : INITIAL DATA NOT AT INITAL ',     &
         'MODEL TIME ***'/)
#ifdef W3_MPI
1003 FORMAT (/' *** ERROR WMIOBG : UNEXPECTED SIZE OF STAGING', &
         ' ARRAY ***')
#endif
    !
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOBG : GATHERING DATA FOR GRID ',i3)
9001 FORMAT ( ' TEST WMIOBG : NR. OF SPECTRA PER SOURCE GRID : '/ &
         '             ',25i4)
9002 FORMAT ( ' TEST WMIOBG : NO DATA NEEDED ON PROCESSOR')
9003 FORMAT ( ' TEST WMIOBG : NO DATA TO BE GATHERED')
9004 FORMAT ( ' TEST WMIOBG : DATA UP TO DATE')
#endif
    !
#ifdef W3_T
9010 FORMAT ( ' TEST WMIOBG : TEST DATA AVAILABILITY')
#endif
#ifdef W3_MPIT
9011 FORMAT ( ' MPIT WMIOBG : NBISTA =',i2)
9012 FORMAT ( '               STAGING ARRAY FROM',i4,1x,a)
9013 FORMAT ( '               VTIME, DTTST :',i9.8,i7.6,1x,f8.1)
9014 FORMAT (/' MPIT WMIOBG : RECEIVE FROM GRID',i4/           &
         ' +------+------+------+------+--------------+'/ &
         ' |  IH  |  ID  | FROM |  TAG |   handle err |'/ &
         ' +------+------+------+------+--------------+')
9015 FORMAT ( ' |',i5,' | TIME |',2(i5,' |'),i9,i4,' |')
9016 FORMAT ( ' |',i5,' |',i5,' |',2(i5,' |'),i9,i4,' |')
9017 FORMAT ( ' +------+------+------+------+--------------+'/)
9018 FORMAT ( ' MPIT WMIOBG : NRQHGH:',i10/)
9019 FORMAT ( ' MPIT WMIOBG : RECEIVES FINISHED :',f6.1,'%')
9100 FORMAT ( ' MPIT WMIOBG : CONVERTING SPECTRA FROM GRID',i3)
#endif
    !
#ifdef W3_T
9020 FORMAT ( ' TEST WMIOBG : FILLING ABPI0/N AND TIMES')
9021 FORMAT ( ' TEST WMIOBG : NEXT VALID TIME FOR ABPIN:',i9.8,i7.6)
9022 FORMAT ( ' TEST WMIOBG : GETTING',i4,' SPECTRA FROM GRID ',  &
         i3,' STORING AT ',i3/               &
         '               WEIGHTS : ',2f6.3)
#endif
    !
#ifdef W3_T
9030 FORMAT ( ' TEST WMIOBG : DUMP DATA TO FILE')
#endif
    !
#ifdef W3_T
9040 FORMAT ( ' TEST WMIOBG : FILLING BBPI0/N')
#endif
    !/
    !/ End of WMIOBG ----------------------------------------------------- /
    !/
  END SUBROUTINE wmiobg
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmiobf ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         29-May-2006 !
    !/                  +-----------------------------------+
    !/
    !/    18-Oct-2005 : Origination.                        ( version 3.08 )
    !/    29-May-2006 : Adding buffering for MPI.           ( version 3.09 )
    !/
    !  1. Purpose :
    !
    !     Finalize staging of  internal boundary data in the data
    !     structure BPSTGE (MPI only).
    !
    !  2. Method :
    !
    !     Post appropriate 'wait' functions to assure that the
    !     communication has finished.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data has
    !                          been staged.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !
    !      MPI_WAITALL
    !                Subr. mpif.h   MPI routines.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMINIT    Subr  WMINITMD Multi-grid model initialization.
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE wmmdatmd
    !
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:)
    INTEGER, ALLOCATABLE    :: STATUS(:,:)
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOBF')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over grids
    !
    DO j=1, nrgrd
      !
#ifdef W3_MPI
      nrq    => bpstge(j,imod)%NRQBPS
#endif
      !
      ! 1.a Nothing to finalize
      !
#ifdef W3_MPI
      IF ( nrq .EQ. 0 ) cycle
      irq    => bpstge(j,imod)%IRQBPS
#endif
      !
      ! 1.b Wait for communication to end
      !
#ifdef W3_MPI
      ALLOCATE ( status(mpi_status_size,nrq) )
      CALL mpi_waitall ( nrq, irq, status, ierr_mpi )
      DEALLOCATE ( status )
#endif
      !
      ! 1.c Reset arrays and counter
      !
#ifdef W3_MPI
      nrq    = 0
      DEALLOCATE ( bpstge(j,imod)%IRQBPS ,                     &
           bpstge(j,imod)%TSTORE )
#endif
      !
#ifdef W3_T
      WRITE (mdst,9010) j
#endif
      !
    END DO
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOBF : FINALIZE STAGING DATA FROM GRID ',i3)
9010 FORMAT ( ' TEST WMIOBF : FINISHED WITH TARGET ',i3)
#endif
    !/
    !/ End of WMIOBF ----------------------------------------------------- /
    !/
  END SUBROUTINE wmiobf
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmiohs ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         28-Sep-2016 !
    !/                  +-----------------------------------+
    !/
    !/    27-Jan-2006 : Origination.                        ( version 3.08 )
    !/    20-Dec-2006 : Remove VTIME from MPI comm.         ( version 3.10 )
    !/    28-Sep-2016 : Add error traps for MPI tags.       ( version 5.15 )
    !/
    !  1. Purpose :
    !
    !     Stage internal high-to-low data in the data structure HGSTGE.
    !
    !  2. Method :
    !
    !     Directly fill staging arrays in shared memory version, or post
    !     the corresponding sends in distributed memory version.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data is to
    !                          be staged.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG, W3SETW, W3SETA, W3SETO, WMSETM
    !                Subr. WxxDATMD Manage data structures.
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !      EXTCDE    Sur.    Id.    Program abort.
    !      DSEC21    Func. W3TIMEMD Difference between times.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     See FORMAT label 1001.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Enable test output
    !       !/MPIT
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3gdatmd
    USE w3wdatmd
    USE w3adatmd
    USE w3odatmd
    USE wmmdatmd
    !
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    USE w3timemd, ONLY: dsec21
    USE w3parall, ONLY: init_get_isea
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J, NR, I, JSEA, ISEA, IS
#ifdef W3_MPI
    INTEGER                 :: ITAG, IP, IT0, IERR_MPI
#endif
    INTEGER                 :: I1, I2
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:), NRQOUT, OUTDAT(:,:)
#endif
    REAL                    :: DTOUTP
#ifdef W3_SHRD
    REAL, POINTER           :: SHGH(:,:,:)
#endif
#ifdef W3_MPI
    REAL, POINTER           :: SHGH(:,:)
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOHS')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod, flghg1
#endif
    !
    IF ( .NOT. flghg1 ) THEN
#ifdef W3_T
      WRITE (mdst,9001) hgstge(:,imod)%NSND
#endif
      IF ( sum(hgstge(:,imod)%NSND) .EQ. 0 ) RETURN
    ELSE
#ifdef W3_T
      WRITE (mdst,9001) hgstge(:,imod)%NSN1
#endif
      IF ( sum(hgstge(:,imod)%NSN1) .EQ. 0 ) RETURN
    END IF
    !
    CALL w3seto ( imod, mdse, mdst )
    CALL w3setg ( imod, mdse, mdst )
    CALL w3setw ( imod, mdse, mdst )
    CALL w3seta ( imod, mdse, mdst )
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over grids
    !
    DO j=1, nrgrd
      !
      IF ( j .EQ. imod ) cycle
      !
      IF ( .NOT. flghg1 ) THEN
        nr     = hgstge(j,imod)%NSND
      ELSE IF ( flghg2 ) THEN
        nr     = hgstge(j,imod)%NSN1
      ELSE
        IF ( toutp(1,j) .EQ. -1 ) THEN
          dtoutp = 1.
        ELSE
          dtoutp = dsec21(time,toutp(:,j))
        END IF
        IF ( dtoutp .EQ. 0. ) THEN
          nr     = hgstge(j,imod)%NSND
        ELSE
          nr     = hgstge(j,imod)%NSN1
        END IF
      END IF
      !
#ifdef W3_T
      IF ( nr .EQ. 0 ) THEN
        WRITE (mdst,9010) j, nr
      ELSE
        WRITE (mdst,9011) j, nr, dsec21(time,tsync(:,j)), dtoutp
      END IF
#endif
      !
      IF ( nr .EQ. 0 ) cycle
      IF ( dsec21(time,tsync(:,j)) .NE. 0. ) cycle
      !
      ! -------------------------------------------------------------------- /
      ! 2.  Allocate arrays and/or point pointers
      !
#ifdef W3_SHRD
      shgh   => hgstge(j,imod)%SHGH
#endif
#ifdef W3_MPI
      ALLOCATE ( hgstge(j,imod)%TSTORE(nspec,nr) )
      shgh   => hgstge(j,imod)%TSTORE
#endif
      !
#ifdef W3_MPI
      ALLOCATE ( hgstge(j,imod)%IRQHGS(nr) )
      ALLOCATE ( hgstge(j,imod)%OUTDAT(nr,3) )
#endif
      !
#ifdef W3_MPI
      nrq    => hgstge(j,imod)%NRQHGS
      nrqout => hgstge(j,imod)%NRQOUT
      irq    => hgstge(j,imod)%IRQHGS
      outdat => hgstge(j,imod)%OUTDAT
      nrq    = 0
      nrqout = 0
      irq    = 0
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 3.  Set the time
      !     !/SHRD only.
      !
#ifdef W3_T
      WRITE (mdst,9030) time
#endif
      !
#ifdef W3_SHRD
      hgstge(j,imod)%VTIME = time
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 4.  Stage the spectral data
      !
#ifdef W3_MPIT
      WRITE (mdst,9080)
#endif
#ifdef W3_MPI
      it0    = mtag1 + 1
#endif
      !
      DO i=1, nr
        !
        jsea   = hgstge(j,imod)%ISEND(i,1)
        CALL init_get_isea(isea, jsea)
#ifdef W3_DIST
        ip     = hgstge(j,imod)%ISEND(i,2)
#endif
        i1     = hgstge(j,imod)%ISEND(i,3)
        i2     = hgstge(j,imod)%ISEND(i,4)
#ifdef W3_MPI
        itag   = hgstge(j,imod)%ISEND(i,5) + it0
        IF ( itag .GT. mtag2 ) THEN
          WRITE (mdse,1001)
          CALL extcde (1001)
        END IF
#endif
        !
        DO is=1, nspec
#ifdef W3_SHRD
          shgh(is,i2,i1) = va(is,jsea) * sig2(is)             &
               / cg(1+(is-1)/nth,isea)
#endif
#ifdef W3_MPI
          shgh(  is,i  ) = va(is,jsea) * sig2(is)             &
               / cg(1+(is-1)/nth,isea)
#endif
        END DO
        !
#ifdef W3_MPI
        IF ( ip .NE. improc ) THEN
          nrq    = nrq + 1
          CALL mpi_isend ( shgh(1,i), nspec, mpi_real, ip-1, &
               itag, mpi_comm_mwave, irq(nrq), ierr_mpi )
#endif
#ifdef W3_MPIT
          WRITE (mdst,9082) nrq, jsea, ip, itag-mtag1,       &
               irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
        ELSE
          nrqout = nrqout + 1
          outdat(nrqout,1) = i
          outdat(nrqout,2) = i2
          outdat(nrqout,3) = i1
        END IF
#endif
        !
      END DO
      !
#ifdef W3_MPIT
      WRITE (mdst,9083)
      WRITE (mdst,9084) nrq
#endif
      !
    END DO
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_MPI
1001 FORMAT (/' *** ERROR WMIOHS : REQUESTED MPI TAG EXCEEDS', &
         ' UPPER BOUND (MTAG2) ***')
#endif
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOHS : STAGING DATA FROM GRID ',i3,        &
         '   FLGHG1 = ',l1)
9001 FORMAT ( ' TEST WMIOHS : NR. OF SPECTRA PER GRID : '/        &
         '             ',15i6)
#endif
    !
#ifdef W3_T
9010 FORMAT ( ' TEST WMIOHS : POSTING DATA TO GRID ',i3,          &
         '   NR = ',i6)
9011 FORMAT ( ' TEST WMIOHS : POSTING DATA TO GRID ',i3,          &
         '   NR = ',i6,'   TIME GAP = ',2f8.1)
#endif
    !
#ifdef W3_T
9030 FORMAT ( ' TEST WMIOHS : TIME :',i10.8,i7.6)
#endif
    !
#ifdef W3_MPIT
9080 FORMAT (/' MPIT WMIOHS: COMMUNICATION CALLS            '/ &
         ' +------+------+------+------+--------------+'/ &
         ' |  IH  |  ID  | TARG |  TAG |   handle err |'/ &
         ' +------+------+------+------+--------------+')
9082 FORMAT ( ' |',i5,' |',i5,' |',2(i5,' |'),i9,i4,' |')
9083 FORMAT ( ' +------+------+------+------+--------------+')
9084 FORMAT ( ' MPIT WMIOHS: NRQHGS:',i10/)
#endif
    !/
    !/ End of WMIOHS ----------------------------------------------------- /
    !/
  END SUBROUTINE wmiohs
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmiohg ( IMOD, DONE )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         20-Dec-2006 !
    !/                  +-----------------------------------+
    !/
    !/    27-Jan-2006 : Origination.                        ( version 3.08 )
    !/    20-Dec-2006 : Remove VTIME from MPI comm.         ( version 3.10 )
    !/
    !  1. Purpose :
    !
    !     Gather internal high-to-low data for a given model.
    !
    !  2. Method :
    !
    !     For distributed memory version first receive all staged data.
    !     After staged data is present, average, convert as necessary,
    !     and store in basic spectral arrays.
    !
    !  2. Method :
    !
    !     Using storage array HGSTAGE and time stamps.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data is to
    !                          be gathered.
    !       DONE    Log.   O   Flag for completion of operation (opt).
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG, W3SETW, W3SETA, W3SETO
    !                Subr. WxxDATMD Manage data structures.
    !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
    !      STRACE    Sur.  W3SERVMD Subroutine tracing.
    !      DSEC21    Func. W3TIMEMD Difference between times.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     See FORMAT labels 1001-1002.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Enable test output
    !       !/MPIT
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3gdatmd
    USE w3wdatmd
    USE w3adatmd
    USE w3odatmd
    USE wmmdatmd
    !
    USE w3cspcmd, ONLY: w3cspc
    USE w3timemd, ONLY: dsec21
    !     USE W3SERVMD, ONLY: EXTCDE
#ifdef W3_PDLIB
    use yownodepool, only: npa
    USE yowexchangemodule, only : pdlib_exchange2dreal_zero
#endif
    USE w3parall, ONLY : init_get_isea
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)            :: IMOD
    LOGICAL, INTENT(OUT), OPTIONAL :: DONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: NTOT, J, IS, NA, IA, JSEA, ISEA, I
#ifdef W3_MPI
    INTEGER                 :: ITAG, IT0, IFROM, ILOC, NLOC,   &
         ISPROC, IERR_MPI, ICOUNT,       &
         I0, I1, I2
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER, POINTER        :: VTIME(:)
#ifdef W3_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:), STATUS(:,:)
#endif
    REAL                    :: DTTST, WGTH
    REAL, POINTER           :: SPEC1(:,:), SPEC2(:,:), SPEC(:,:)
#ifdef W3_MPI
    REAL, POINTER           :: SHGH(:,:,:)
#endif
    LOGICAL                 :: FLGALL
#ifdef W3_MPI
    LOGICAL                 :: FLAGOK
#endif
#ifdef W3_MPIT
    LOGICAL                 :: FLAG
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOHG')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
    IF ( toutp(1,imod) .EQ. -1 ) THEN
      dttst  = 1.
    ELSE
      dttst  = dsec21( wdatas(imod)%TIME , toutp(:,imod) )
    END IF
    !
    IF ( .NOT. flghg1 ) THEN
      flgall = .true.
    ELSE IF ( flghg2 ) THEN
      flgall = .false.
    ELSE IF ( dttst .EQ. 0. ) THEN
      flgall = .true.
    ELSE
      flgall = .false.
    END IF
    !
#ifdef W3_T
    WRITE (mdst,9000) imod, dttst, flgall
#endif
    !
    IF ( flgall ) THEN
#ifdef W3_T
      WRITE (mdst,9001) hgstge(imod,:)%NREC
#endif
      ntot   = sum(hgstge(imod,:)%NREC)
    ELSE
#ifdef W3_T
      WRITE (mdst,9001) hgstge(imod,:)%NRC1
#endif
      ntot   = sum(hgstge(imod,:)%NRC1)
    END IF
    !
    IF ( PRESENT(done) ) done = .false.
    !
    IF ( ntot .EQ. 0 ) THEN
      IF ( PRESENT(done) ) done = .true.
#ifdef W3_T
      WRITE (mdst,9003)
#endif
      RETURN
    END IF
    !
    CALL w3seto ( imod, mdse, mdst )
    CALL w3setg ( imod, mdse, mdst )
    CALL w3setw ( imod, mdse, mdst )
    CALL w3seta ( imod, mdse, mdst )
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Testing / gathering data in staging arrays
    !
#ifdef W3_T
    WRITE (mdst,9010) time
#endif
    !
    ! 1.a Shared memory version, test valid times. - - - - - - - - - - - - /
    !
#ifdef W3_SHRD
    DO j=1, nrgrd
#endif
      !
#ifdef W3_SHRD
      IF ( flgall ) THEN
        ntot   = hgstge(imod,j)%NREC
      ELSE
        ntot   = hgstge(imod,j)%NRC1
      END IF
      IF ( ntot .EQ. 0 ) cycle
#endif
      !
#ifdef W3_SHRD
      vtime  => hgstge(imod,j)%VTIME
      IF ( vtime(1) .EQ. -1 ) RETURN
      dttst  = dsec21( time, vtime )
      IF ( dttst .NE. 0. ) RETURN
#endif
      !
#ifdef W3_SHRD
    END DO
#endif
    !
    ! 1.b Distributed memory version - - - - - - - - - - - - - - - - - - - /
    !
#ifdef W3_MPIT
    WRITE (mdst,9011) hghsta(imod)
#endif
    !
    ! 1.b.1 HGHSTA = 0
    !       Check if staging arrays are initialized.
    !       Post the proper receives.
    !
#ifdef W3_MPI
    IF ( hghsta(imod) .EQ. 0 ) THEN
#endif
      !
#ifdef W3_MPI
      nrq    => mdatas(imod)%NRQHGG
      nrq    = 0
      DO j=1, nrgrd
        IF ( flgall ) THEN
          nrq    = nrq + hgstge(imod,j)%NREC *             &
               hgstge(imod,j)%NSMX
        ELSE
          nrq    = nrq + hgstge(imod,j)%NRC1 *             &
               hgstge(imod,j)%NSMX
        END IF
      END DO
      nrq    = max(1,nrq)
      ALLOCATE ( irq(nrq) )
      irq    = 0
      nrq    = 0
#endif
      !
#ifdef W3_MPI
      DO j=1, nrgrd
        IF ( hgstge(imod,j)%NTOT .EQ. 0 ) cycle
#endif
        !
        ! ..... Check valid time to determine staging.
        !
#ifdef W3_MPI
        vtime  => hgstge(imod,j)%VTIME
        IF ( vtime(1) .EQ. -1 ) THEN
          dttst  = 1.
        ELSE
          dttst  = dsec21( time, vtime )
        END IF
#endif
#ifdef W3_MPIT
        WRITE (mdst,9013) vtime, dttst
#endif
        !
        ! ..... Post receives for data gather
        !
#ifdef W3_MPI
        IF ( dttst .NE. 0. ) THEN
#endif
#ifdef W3_MPIT
          WRITE (mdst,9014) j
#endif
          !
          ! ..... Spectra
          !
#ifdef W3_MPI
          it0 = mtag1 + 1
          shgh  => hgstge(imod,j)%SHGH
#endif
          !
#ifdef W3_MPI
          IF ( flgall ) THEN
            ntot   = hgstge(imod,j)%NREC
          ELSE
            ntot   = hgstge(imod,j)%NRC1
          END IF
#endif
          !
#ifdef W3_MPI
          DO i=1, ntot
#endif
#ifdef W3_MPIT
            jsea   = hgstge(imod,j)%LJSEA(i)
#endif
#ifdef W3_MPI
            nloc   = hgstge(imod,j)%NRAVG(i)
            DO iloc=1, nloc
              isproc = hgstge(imod,j)%IMPSRC(i,iloc)
              itag   = hgstge(imod,j)%ITAG(i,iloc) + it0
              IF ( isproc .NE. improc ) THEN
                nrq    = nrq + 1
                CALL mpi_irecv ( shgh(1,iloc,i),         &
                     sgrds(j)%NSPEC, mpi_real,           &
                     isproc-1, itag, mpi_comm_mwave,     &
                     irq(nrq), ierr_mpi )
#endif
#ifdef W3_MPIT
                WRITE (mdst,9016) nrq, jsea, isproc,     &
                     itag-mtag1, irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
              END IF
            END DO
          END DO
#endif
          !
          ! ..... End IF for posting receives 1.b.1
          !
#ifdef W3_MPIT
          WRITE (mdst,9017)
#endif
#ifdef W3_MPI
        END IF
#endif
        !
        ! ..... End grid loop J in 1.b.1
        !
#ifdef W3_MPI
      END DO
#endif
#ifdef W3_MPIT
      WRITE (mdst,9018) nrq
#endif
      !
#ifdef W3_MPI
      ALLOCATE ( mdatas(imod)%IRQHGG(nrq) )
      mdatas(imod)%IRQHGG = irq(1:nrq)
      DEALLOCATE ( irq )
#endif
      !
      ! ..... Reset status
      !
#ifdef W3_MPI
      IF ( nrq .GT. 0 ) THEN
        hghsta(imod) = 1
#endif
#ifdef W3_MPIT
        WRITE (mdst,9011) hghsta(imod)
#endif
#ifdef W3_MPI
      END IF
#endif
      !
      ! ..... End IF in 1.b.1
      !
#ifdef W3_MPI
    END IF
#endif
    !
    ! 1.b.2 HGHSTA = 1
    !       Wait for communication to finish.
    !       If DONE defined, check if done, otherwise wait.
    !
#ifdef W3_MPI
    IF ( hghsta(imod) .EQ. 1 ) THEN
#endif
      !
#ifdef W3_MPI
      nrq    => mdatas(imod)%NRQHGG
      irq    => mdatas(imod)%IRQHGG
      ALLOCATE ( status(mpi_status_size,nrq) )
#endif
      !
      ! ..... Test communication if DONE is present, wait otherwise
      !
#ifdef W3_MPI
      IF ( PRESENT(done) ) THEN
#endif
        !
#ifdef W3_MPI
        CALL mpi_testall ( nrq, irq, flagok, status,       &
             ierr_mpi )
#endif
        !
#ifdef W3_MPIT
        icount = 0
        DO i=1, nrq
          CALL mpi_test ( irq(i), flag, status(1,1),      &
               ierr_mpi )
          flagok = flagok .AND. flag
          IF ( flag ) icount = icount + 1
        END DO
        WRITE (mdst,9019) 100. * real(icount) / real(nrq)
#endif
        !
#ifdef W3_MPI
      ELSE
#endif
        !
#ifdef W3_MPI
        CALL mpi_waitall ( nrq, irq, status, ierr_mpi )
        flagok = .true.
#endif
#ifdef W3_MPIT
        WRITE (mdst,9019) 100.
#endif
        !
#ifdef W3_MPI
      END IF
#endif
      !
#ifdef W3_MPI
      DEALLOCATE ( status )
#endif
      !
      ! ..... Go on based on FLAGOK
      !
#ifdef W3_MPI
      IF ( flagok ) THEN
        nrq    = 0
        DEALLOCATE ( mdatas(imod)%IRQHGG )
      ELSE
        RETURN
      END IF
#endif
      !
#ifdef W3_MPI
      hghsta(imod) = 0
#endif
#ifdef W3_MPIT
      WRITE (mdst,9011) hghsta(imod)
#endif
      !
#ifdef W3_MPI
    END IF
#endif
    !
    ! ..... process locally stored data
    !
#ifdef W3_MPI
    DO j=1, nrgrd
      hgstge(imod,j)%VTIME = time
      IF ( j .EQ. imod ) cycle
      DO is=1, hgstge(imod,j)%NRQOUT
        i0     = hgstge(imod,j)%OUTDAT(is,1)
        i2     = hgstge(imod,j)%OUTDAT(is,2)
        i1     = hgstge(imod,j)%OUTDAT(is,3)
        hgstge(imod,j)%SHGH(:,i2,i1) = hgstge(imod,j)%TSTORE(:,i0)
      END DO
    END DO
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Data available, process grid by grid
    !
#ifdef W3_T
    WRITE (mdst,9020)
#endif
    !
    ! 2.a Loop over grids
    !
    DO j=1, nrgrd
      !
      IF ( flgall ) THEN
        ntot   = hgstge(imod,j)%NREC
      ELSE
        ntot   = hgstge(imod,j)%NRC1
      END IF
      IF ( ntot .EQ. 0 ) cycle
      !
#ifdef W3_T
      WRITE (mdst,9021) j, ntot
#endif
      !
      ! 2.b Set up temp data structures
      !
      IF ( respec(imod,j) ) THEN
        ALLOCATE ( spec1(sgrds(j)%NSPEC,ntot), spec2(nspec,ntot) )
        spec   => spec1
      ELSE
        ALLOCATE ( spec2(nspec,ntot) )
        spec   => spec2
      END IF
      !
      ! 2.c Average spectra to temp storage
      !
#ifdef W3_T
      WRITE (mdst,9022)
#endif
      !
      DO is=1, ntot
        na     = hgstge(imod,j)%NRAVG(is)
        wgth   = hgstge(imod,j)%WGTH(is,1)
        spec(:,is) = wgth * hgstge(imod,j)%SHGH(:,1,is)
        DO ia=2, na
          wgth   = hgstge(imod,j)%WGTH(is,ia)
          spec(:,is) = spec(:,is) + wgth*hgstge(imod,j)%SHGH(:,ia,is)
        END DO
      END DO
      !
      ! 2.d Convert spectral grid as needed
      !
      IF ( respec(imod,j) ) THEN
        !
#ifdef W3_T
        WRITE (mdst,9023)
#endif
        !
        CALL w3cspc ( spec1, sgrds(j)%NK, sgrds(j)%NTH,           &
             sgrds(j)%XFR, sgrds(j)%FR1, sgrds(j)%TH(1), &
             spec2 , nk, nth, xfr, fr1, th(1),           &
             ntot, mdst, mdse, fachfe)
        DEALLOCATE ( spec1 )
        !
      END IF
      !
      ! 2.e Move spectra to model
      !
#ifdef W3_T
      WRITE (mdst,9024)
#endif
      !
      DO is=1, ntot
        jsea   = hgstge(imod,j)%LJSEA(is)
        CALL init_get_isea(isea, jsea)
        DO i=1, nspec
          va(i,jsea) = spec2(i,is) / sig2(i) * cg(1+(i-1)/nth,isea)
        END DO
      END DO
      !
      DEALLOCATE ( spec2 )
      !
    END DO
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Set flag if reqeusted
    !
    IF ( PRESENT(done) ) done = .true.
    !
#ifdef W3_PDLIB
    CALL pdlib_exchange2dreal_zero(va)
#endif
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOHG : GATHERING DATA FOR GRID ',i3/       &
         '               DTOUTP, FLGALL :',f8.1,l4)
9001 FORMAT ( ' TEST WMIOHG : NR. OF SPECTRA PER SOURCE GRID : '/ &
         '             ',25i4)
9003 FORMAT ( ' TEST WMIOHG : NO DATA TO BE GATHERED')
#endif
    !
#ifdef W3_T
9010 FORMAT ( ' TEST WMIOHG : TEST DATA AVAILABILITY FOR',i9.8,i7.6)
#endif
#ifdef W3_MPIT
9011 FORMAT ( ' MPIT WMIOHG : HGHSTA =',i2)
9013 FORMAT ( '               VTIME, DTTST :',i9.8,i7.6,1x,f8.1)
9014 FORMAT (/' MPIT WMIOHG : RECEIVE FROM GRID',i4/           &
         ' +------+------+------+------+--------------+'/ &
         ' |  IH  |  ID  | FROM |  TAG |   handle err |'/ &
         ' +------+------+------+------+--------------+')
9016 FORMAT ( ' |',i5,' |',i5,' |',2(i5,' |'),i9,i4,' |')
9017 FORMAT ( ' +------+------+------+------+--------------+'/)
9018 FORMAT ( ' MPIT WMIOHG : NRQBPT:',i10/)
9019 FORMAT ( ' MPIT WMIOHG : RECEIVES FINISHED :',f6.1,'%')
#endif
    !
#ifdef W3_T
9020 FORMAT ( ' TEST WMIOHG : PROCESSING DATA GRID BY GRID')
9021 FORMAT ( '               FROM GRID ',i3,'   NR OF SPECTRA :',i6)
9022 FORMAT ( '               AVERAGE SPECTRA TO TEMP STORAGE')
9023 FORMAT ( '               CONVERT SPECTRAL GRID')
9024 FORMAT ( '               MOVE SPECTRA TO PERMANENT STORAGE')
#endif
    !/
    !/ End of WMIOHG ----------------------------------------------------- /
    !/
  END SUBROUTINE wmiohg
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmiohf ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         16-Jan-2006 !
    !/                  +-----------------------------------+
    !/
    !/    16-Jan-2006 : Origination.                        ( version 3.08 )
    !/
    !  1. Purpose :
    !
    !     Finalize staging of internal high-to-low data in the data
    !     structure HGSTGE (MPI only).
    !
    !  2. Method :
    !
    !     Post appropriate 'wait' functions to assure that the
    !     communication has finished.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data has
    !                          been staged.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE wmmdatmd
    !
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:)
    INTEGER, ALLOCATABLE    :: STATUS(:,:)
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOHF')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over grids
    !
    DO j=1, nrgrd
      !
#ifdef W3_MPI
      nrq    => hgstge(j,imod)%NRQHGS
#endif
      !
      ! 1.a Nothing to finalize
      !
#ifdef W3_MPI
      IF ( nrq .EQ. 0 ) cycle
      irq    => hgstge(j,imod)%IRQHGS
#endif
      !
      ! 1.b Wait for communication to end
      !
#ifdef W3_MPI
      ALLOCATE ( status(mpi_status_size,nrq) )
      CALL mpi_waitall ( nrq, irq, status, ierr_mpi )
      DEALLOCATE ( status )
#endif
      !
      ! 1.c Reset arrays and counter
      !
#ifdef W3_MPI
      nrq    = 0
      DEALLOCATE ( hgstge(j,imod)%IRQHGS,                      &
           hgstge(j,imod)%TSTORE,                      &
           hgstge(j,imod)%OUTDAT )
#endif
      !
#ifdef W3_T
      WRITE (mdst,9010) j
#endif
      !
    END DO
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOHF : FINALIZE STAGING DATA FROM GRID ',i3)
9010 FORMAT ( ' TEST WMIOHF : FINISHED WITH TARGET ',i3)
#endif
    !/
    !/ End of WMIOHF ----------------------------------------------------- /
    !/
  END SUBROUTINE wmiohf
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmioes ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         28-Sep-2016 !
    !/                  +-----------------------------------+
    !/
    !/    25-May-2006 : Origination.                        ( version 3.09 )
    !/    21-Dec-2006 : Remove VTIME from MPI comm.         ( version 3.10 )
    !/    28-Sep-2016 : Add error traps for MPI tags.       ( version 5.15 )
    !/    16-Dec-2020 : SMC grid use 1-1 spectral exchanges.( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Stage internal same-rank data in the data structure EQSTGE.
    !
    !  2. Method :
    !
    !     Directly fill staging arrays in shared memory version, or post
    !     the corresponding sends in distributed memory version.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data is to
    !                          be staged.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG, W3SETW, W3SETA, W3SETO, WMSETM
    !                Subr. WxxDATMD Manage data structures.
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !      EXTCDE    Sur.    Id.    Program abort.
    !      DSEC21    Func. W3TIMEMD Difference between times.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     See FORMAT label 1001.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Enable test output
    !       !/MPIT
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3gdatmd
    USE w3wdatmd
    USE w3adatmd
    USE w3odatmd
    USE wmmdatmd
    !
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    USE w3timemd, ONLY: dsec21
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J, NR, I, ISEA, JSEA, IS, I1, I2
#ifdef W3_MPI
    INTEGER                 :: IT0, ITAG, IP, IERR_MPI
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:), NRQOUT, OUTDAT(:,:)
#endif
#ifdef W3_SHRD
    REAL, POINTER           :: SEQL(:,:,:)
#endif
#ifdef W3_MPI
    REAL, POINTER           :: SEQL(:,:)
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOES')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
    WRITE (mdst,9001) eqstge(:,imod)%NSND
#endif
    !
    CALL w3seto ( imod, mdse, mdst )
    CALL w3setg ( imod, mdse, mdst )
    CALL w3setw ( imod, mdse, mdst )
    CALL w3seta ( imod, mdse, mdst )
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over grids
    !
    DO j=1, nrgrd
      !
      IF ( j .EQ. imod ) cycle
      nr     = eqstge(j,imod)%NSND
      !
#ifdef W3_T
      IF ( nr .EQ. 0 ) THEN
        WRITE (mdst,9010) j, nr
      ELSE
        WRITE (mdst,9011) j, nr, dsec21(time,tsync(:,j))
      END IF
#endif
      !
      IF ( nr .EQ. 0 ) cycle
      IF ( dsec21(time,tsync(:,j)) .NE. 0. ) stop
      !
      !!Li  Report sending for test.  JGLi22Dec2020
      !       WRITE (MDSE,*) ' ***WMIOES: Send to GRID', J,           &
      !                      ' from', IMOD, ' NS=', NR, ' on IP', IMPROC
      ! -------------------------------------------------------------------- /
      ! 2.  Allocate arrays and/or point pointers
      !
#ifdef W3_SHRD
      seql   => eqstge(j,imod)%SEQL
#endif
#ifdef W3_MPI
      ALLOCATE ( eqstge(j,imod)%TSTORE(nspec,nr) )
      seql   => eqstge(j,imod)%TSTORE
#endif
      !
#ifdef W3_MPI
      ALLOCATE ( eqstge(j,imod)%IRQEQS(nr)   ,                 &
           eqstge(j,imod)%OUTDAT(nr,3) )
#endif
      !
#ifdef W3_MPI
      nrq    => eqstge(j,imod)%NRQEQS
      nrqout => eqstge(j,imod)%NRQOUT
      irq    => eqstge(j,imod)%IRQEQS
      outdat => eqstge(j,imod)%OUTDAT
      nrq    = 0
      nrqout = 0
      irq    = 0
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 3.  Set the time
      !     Note that with MPI the send needs to be posted to the local
      !     processor too to make time management possible.
      !
#ifdef W3_T
      WRITE (mdst,9030) time
#endif
      !
#ifdef W3_SHRD
      eqstge(j,imod)%VTIME = time
#endif
      !
      ! -------------------------------------------------------------------- /
      ! 4.  Stage the spectral data
      !
#ifdef W3_MPIT
      WRITE (mdst,9080)
#endif
#ifdef W3_MPI
      it0 = mtag2 + 1
#endif
      !
      DO i=1, nr
        !
        isea   = eqstge(j,imod)%SIS(i)
        jsea   = eqstge(j,imod)%SJS(i)
        i1     = eqstge(j,imod)%SI1(i)
        i2     = eqstge(j,imod)%SI2(i)
#ifdef W3_MPI
        ip     = eqstge(j,imod)%SIP(i)
        itag   = eqstge(j,imod)%STG(i) + it0
        IF ( itag .GT. mtag_ub ) THEN
          WRITE (mdse,1001)
          CALL extcde (1001)
        END IF
#endif
        !
#ifdef W3_SMC
        !!  Equal ranked SMC grids simply pass the wave action.  JGLi16Dec2020
#endif
#ifdef W3_MPI
#ifdef W3_SMC
        IF( gtype .EQ. smctype ) THEN
          seql(:, i) = va(:, jsea)
        ELSE
#endif
#endif
          DO is=1, nspec
#ifdef W3_SHRD
            seql(is,i1,i2) = va(is,jsea) * sig2(is)             &
                 / cg(1+(is-1)/nth,isea)
#endif
#ifdef W3_MPI
            seql(  is,i  ) = va(is,jsea) * sig2(is)             &
                 / cg(1+(is-1)/nth,isea)
#endif
          END DO
#ifdef W3_MPI
#ifdef W3_SMC
        ENDIF
#endif
#endif
        !
#ifdef W3_MPI
        IF ( ip .NE. improc ) THEN
          nrq    = nrq + 1
          CALL mpi_isend ( seql(1,i), nspec, mpi_real, ip-1, &
               itag, mpi_comm_mwave, irq(nrq), ierr_mpi )
#endif
#ifdef W3_MPIT
          WRITE (mdst,9082) nrq, jsea, ip, itag-mtag2,      &
               irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
        ELSE
          nrqout = nrqout + 1
          outdat(nrqout,1) = i
          outdat(nrqout,2) = i1
          outdat(nrqout,3) = i2
        END IF
#endif
        !
      END DO
      !
#ifdef W3_MPIT
      WRITE (mdst,9083)
      WRITE (mdst,9084) nrq
#endif
      !
    END DO
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_MPI
1001 FORMAT (/' *** ERROR WMIOES : REQUESTED MPI TAG EXCEEDS', &
         ' UPPER BOUND (MTAG_UB) ***')
#endif
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOES : STAGING DATA FROM GRID ',i3)
9001 FORMAT ( ' TEST WMIOES : NR. OF SPECTRA PER GRID : '/        &
         '             ',15i6)
#endif
    !
#ifdef W3_T
9010 FORMAT ( ' TEST WMIOES : POSTING DATA TO GRID ',i3,          &
         '   NR = ',i6)
9011 FORMAT ( ' TEST WMIOES : POSTING DATA TO GRID ',i3,          &
         '   NR = ',i6,'   TIME GAP = ',f8.1)
#endif
    !
#ifdef W3_T
9030 FORMAT ( ' TEST WMIOES : TIME :',i10.8,i7.6)
#endif
    !/
#ifdef W3_MPIT
9080 FORMAT (/' MPIT WMIOES: COMMUNICATION CALLS            '/ &
         ' +------+------+------+------+--------------+'/ &
         ' |  IH  |  ID  | TARG |  TAG |   handle err |'/ &
         ' +------+------+------+------+--------------+')
9082 FORMAT ( ' |',i5,' |',i5,' |',2(i5,' |'),i9,i4,' |')
9083 FORMAT ( ' +------+------+------+------+--------------+')
9084 FORMAT ( ' MPIT WMIOES: NRQEQS:',i10/)
#endif
    !/
    !/ End of WMIOES ----------------------------------------------------- /
    !/
  END SUBROUTINE wmioes
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmioeg ( IMOD, DONE )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Jan-2007 !
    !/                  +-----------------------------------+
    !/
    !/    25-May-2006 : Origination.                        ( version 3.09 )
    !/    21-Dec-2006 : Remove VTIME from MPI comm.         ( version 3.10 )
    !/    22-Jan-2007 : Adding NAVMAX.                      ( version 3.10 )
    !/
    !  1. Purpose :
    !
    !     Gather internal same-rank data for a given model.
    !
    !  2. Method :
    !
    !     For distributed memory version first receive all staged data.
    !     After staged data is present, average, convert as necessary,
    !     and store in basic spectral arrays.
    !
    !  2. Method :
    !
    !     Using storage array EQSTGE and time stamps.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data is to
    !                          be gathered.
    !       DONE    Log.   O   Flag for completion of operation (opt).
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SETG, W3SETW, W3SETA, W3SETO
    !                Subr. WxxDATMD Manage data structures.
    !      W3CSPC    Subr. W3CSPCMD Spectral grid conversion.
    !      STRACE    Sur.  W3SERVMD Subroutine tracing.
    !      DSEC21    Func. W3TIMEMD Difference between times.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     See FORMAT labels 1001-1002.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Enable test output
    !       !/MPIT
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3gdatmd
    USE w3wdatmd
    USE w3adatmd
    USE w3odatmd
    USE wmmdatmd
    !
    USE w3cspcmd, ONLY: w3cspc
    USE w3timemd, ONLY: dsec21
    USE w3servmd, ONLY: extcde
#ifdef W3_PDLIB
    use yownodepool, only: npa
    USE yowexchangemodule, only : pdlib_exchange2dreal_zero
#endif
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)            :: IMOD
    LOGICAL, INTENT(OUT), OPTIONAL :: DONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J, I, ISEA, JSEA, IA, IS
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_MPI
    INTEGER                 :: IT0, ITAG, IFROM, IERR_MPI,     &
         NA, IP, I1, I2
#endif
#ifdef W3_MPIT
    INTEGER                 :: ICOUNT
#endif
    INTEGER, POINTER        :: VTIME(:)
#ifdef W3_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:), STATUS(:,:)
#endif
    REAL                    :: DTTST, WGHT
    REAL, POINTER           :: SPEC1(:,:), SPEC2(:,:), SPEC(:,:)
#ifdef W3_MPI
    REAL, POINTER           :: SEQL(:,:,:)
    LOGICAL                 :: FLAGOK
    LOGICAL                 :: FLAG
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOEG')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
    WRITE (mdst,9001) 'NREC', eqstge(imod,:)%NREC
#endif
    !
    IF ( PRESENT(done) ) done = .false.
    !
    IF ( eqstge(imod,imod)%NREC .EQ. 0 ) THEN
      IF ( PRESENT(done) ) done = .true.
#ifdef W3_T
      WRITE (mdst,9002)
#endif
      RETURN
    END IF
    !
    CALL w3seto ( imod, mdse, mdst )
    CALL w3setg ( imod, mdse, mdst )
    CALL w3setw ( imod, mdse, mdst )
    CALL w3seta ( imod, mdse, mdst )
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Testing / gathering data in staging arrays
    !
#ifdef W3_T
    WRITE (mdst,9010) time
#endif
    !
    ! 1.a Shared memory version, test valid times. - - - - - - - - - - - - /
    !
#ifdef W3_SHRD
    DO j=1, nrgrd
#endif
      !
#ifdef W3_SHRD
      IF ( imod .EQ. j ) cycle
      IF ( eqstge(imod,j)%NREC .EQ. 0 ) cycle
#endif
      !
#ifdef W3_SHRD
      vtime  => eqstge(imod,j)%VTIME
      IF ( vtime(1) .EQ. -1 ) RETURN
      dttst  = dsec21( time, vtime )
      IF ( dttst .NE. 0. ) RETURN
#endif
      !
#ifdef W3_SHRD
    END DO
#endif
    !
    ! 1.b Distributed memory version - - - - - - - - - - - - - - - - - - - /
    !
#ifdef W3_MPIT
    WRITE (mdst,9011) eqlsta(imod)
#endif
    !
    ! 1.b.1 EQLSTA = 0
    !       Check if staging arrays are initialized.
    !       Post the proper receives.
    !
#ifdef W3_MPI
    IF ( eqlsta(imod) .EQ. 0 ) THEN
#endif
      !
#ifdef W3_MPI
      nrq    => mdatas(imod)%NRQEQG
      nrq    = 0
      DO j=1, nrgrd
        IF ( j .EQ. imod ) cycle
        nrq    = nrq + eqstge(imod,j)%NREC *                 &
             eqstge(imod,j)%NAVMAX
      END DO
      ALLOCATE ( irq(nrq) )
      irq    = 0
      nrq    = 0
#endif
      !
#ifdef W3_MPI
      DO j=1, nrgrd
        IF ( imod .EQ. j ) cycle
        IF ( eqstge(imod,j)%NREC .EQ. 0 ) cycle
#endif
        !
        ! ..... Check valid time to determine staging.
        !
#ifdef W3_MPI
        vtime  => eqstge(imod,j)%VTIME
        IF ( vtime(1) .EQ. -1 ) THEN
          dttst  = 1.
        ELSE
          dttst  = dsec21( time, vtime )
        END IF
#endif
#ifdef W3_MPIT
        WRITE (mdst,9013) vtime, dttst
#endif
        !
        ! ..... Post receives for data gather
        !
#ifdef W3_MPI
        IF ( dttst .NE. 0. ) THEN
#endif
#ifdef W3_MPIT
          WRITE (mdst,9014) j
#endif
          !
          ! ..... Spectra
          !
#ifdef W3_MPI
          it0 = mtag2 + 1
          seql  => eqstge(imod,j)%SEQL
#endif
          !
#ifdef W3_MPI
          DO i=1, eqstge(imod,j)%NREC
            jsea   = eqstge(imod,j)%JSEA(i)
            na     = eqstge(imod,j)%NAVG(i)
            DO ia=1, na
              ip     = eqstge(imod,j)%RIP(i,ia)
              itag   = eqstge(imod,j)%RTG(i,ia) + it0
              IF ( ip .NE. improc ) THEN
                nrq    = nrq + 1
                CALL mpi_irecv ( seql(1,i,ia),           &
                     sgrds(j)%NSPEC, mpi_real,           &
                     ip-1, itag, mpi_comm_mwave,         &
                     irq(nrq), ierr_mpi )
#endif
#ifdef W3_MPIT
                WRITE (mdst,9016) nrq, jsea, ip,         &
                     itag-mtag2, irq(nrq), ierr_mpi
#endif
#ifdef W3_MPI
              END IF
            END DO
          END DO
#endif
          !
          ! ..... End IF for posting receives 1.b.1
          !
#ifdef W3_MPIT
          WRITE (mdst,9017)
#endif
#ifdef W3_MPI
        END IF
#endif
        !
        ! ..... End grid loop J in 1.b.1
        !
#ifdef W3_MPI
      END DO
#endif
#ifdef W3_MPIT
      WRITE (mdst,9018) nrq
#endif
      !
#ifdef W3_MPI
      IF ( nrq .NE. 0 ) THEN
        ALLOCATE ( mdatas(imod)%IRQEQG(nrq) )
        mdatas(imod)%IRQEQG = irq(1:nrq)
      END IF
#endif
      !
#ifdef W3_MPI
      DEALLOCATE ( irq )
#endif
      !
      ! ..... Reset status
      !
#ifdef W3_MPI
      IF ( nrq .GT. 0 ) THEN
        eqlsta(imod) = 1
#endif
#ifdef W3_MPIT
        WRITE (mdst,9011) eqlsta(imod)
#endif
#ifdef W3_MPI
      END IF
#endif
      !
      ! ..... End IF in 1.b.1
      !
#ifdef W3_MPI
    END IF
#endif
    !
    ! 1.b.2 EQLSTA = 1
    !       Wait for communication to finish.
    !       If DONE defined, check if done, otherwise wait.
    !
#ifdef W3_MPI
    IF ( eqlsta(imod) .EQ. 1 ) THEN
#endif
      !
#ifdef W3_MPI
      nrq    => mdatas(imod)%NRQEQG
      irq    => mdatas(imod)%IRQEQG
      ALLOCATE ( status(mpi_status_size,nrq) )
#endif
      !
      ! ..... Test communication if DONE is present, wait otherwise
      !
#ifdef W3_MPI
      IF ( PRESENT(done) ) THEN
#endif
        !
#ifdef W3_MPI
        CALL mpi_testall ( nrq, irq, flagok, status,       &
             ierr_mpi )
#endif
        !
#ifdef W3_MPIT
        icount = 0
        DO i=1, nrq
          CALL mpi_test ( irq(i), flag, status(1,1),      &
               ierr_mpi )
          flagok = flagok .AND. flag
          IF ( flag ) icount = icount + 1
        END DO
        WRITE (mdst,9019) 100. * real(icount) / real(nrq)
#endif
        !
#ifdef W3_MPI
      ELSE
#endif
        !
#ifdef W3_MPI
        CALL mpi_waitall ( nrq, irq, status, ierr_mpi )
        flagok = .true.
#endif
#ifdef W3_MPIT
        WRITE (mdst,9019) 100.
#endif
        !
#ifdef W3_MPI
      END IF
#endif
      !
#ifdef W3_MPI
      DEALLOCATE ( status )
#endif
      !
      ! ..... Go on based on FLAGOK
      !
#ifdef W3_MPI
      IF ( flagok ) THEN
        IF ( nrq.NE.0 ) DEALLOCATE ( mdatas(imod)%IRQEQG )
        nrq    = 0
      ELSE
        RETURN
      END IF
#endif
      !
#ifdef W3_MPI
      eqlsta(imod) = 0
#endif
#ifdef W3_MPIT
      WRITE (mdst,9011) eqlsta(imod)
#endif
      !
#ifdef W3_MPI
    END IF
#endif
    !
    ! ..... process locally stored data
    !
#ifdef W3_MPI
    DO j=1, nrgrd
      eqstge(imod,j)%VTIME = time
      IF ( j .EQ. imod ) cycle
      DO is=1, eqstge(imod,j)%NRQOUT
        i      = eqstge(imod,j)%OUTDAT(is,1)
        i1     = eqstge(imod,j)%OUTDAT(is,2)
        i2     = eqstge(imod,j)%OUTDAT(is,3)
        eqstge(imod,j)%SEQL(:,i1,i2) = eqstge(imod,j)%TSTORE(:,i)
      END DO
    END DO
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Data available, process grid by grid
    !
#ifdef W3_T
    WRITE (mdst,9020)
#endif
    !
    ! 2.a Do 'native' grid IMOD
    !
#ifdef W3_T
    WRITE (mdst,9021) imod, eqstge(imod,imod)%NREC
#endif
    !
    DO i=1, eqstge(imod,imod)%NREC
      jsea   = eqstge(imod,imod)%JSEA(i)
      wght   = eqstge(imod,imod)%WGHT(i)
      va(:,jsea) = wght * va(:,jsea)
    END DO
    !
    ! 2.b Loop over other grids
    !
    DO j=1, nrgrd
      IF ( imod.EQ.j .OR. eqstge(imod,j)%NREC.EQ.0 ) cycle
      !
#ifdef W3_T
      WRITE (mdst,9022) j, eqstge(imod,j)%NREC
#endif
      !
#ifdef W3_SMC
      !! Use 1-1 full boundary spectra without modification. JGLi16Dec2020
      IF( gtype .EQ. smctype ) THEN
        DO i=1, eqstge(imod,j)%NREC
          jsea   = eqstge(imod,j)%JSEA(i)
          va(:,jsea) = eqstge(imod,j)%SEQL(:,i,1)
        END DO
      ELSE
        !! Other grid boundary spectra may need conversion.   JGLi12Apr2021
#endif
        !
        ! 2.c Average spectra
        !
#ifdef W3_T
        WRITE (mdst,9023)
#endif
        ALLOCATE ( spec1(sgrds(j)%NSPEC,eqstge(imod,j)%NREC) )
        spec1  = 0.
        !
        DO i=1, eqstge(imod,j)%NREC
          DO ia=1, eqstge(imod,j)%NAVG(i)
            spec1(:,i) = spec1(:,i) + eqstge(imod,j)%SEQL(:,i,ia) *   &
                 eqstge(imod,j)%WAVG(i,ia)
          END DO
        END DO
        !
        ! 2.d Convert spectra
        !
        IF ( respec(imod,j) ) THEN
#ifdef W3_T
          WRITE (mdst,9024)
#endif
          ALLOCATE ( spec2(nspec,eqstge(imod,j)%NREC) )
          !
          CALL w3cspc ( spec1, sgrds(j)%NK, sgrds(j)%NTH,           &
               sgrds(j)%XFR, sgrds(j)%FR1, sgrds(j)%TH(1), &
               spec2 , nk, nth, xfr, fr1, th(1),           &
               eqstge(imod,j)%NREC, mdst, mdse, fachfe)
          !
          spec   => spec2
        ELSE
          spec   => spec1
        END IF
        !
        ! 2.e Apply to native grid
        !
        DO i=1, eqstge(imod,j)%NREC
          isea   = eqstge(imod,j)%ISEA(i)
          jsea   = eqstge(imod,j)%JSEA(i)
          wght   = eqstge(imod,j)%WGHT(i)
#ifdef W3_SMC
          !!  Regular grid in same ranked SMC group uses 1-1 mapping. JGLi12Apr2021
          IF( ngrpsmc .GT. 0 ) THEN
            va(:,jsea) = spec(:,i)
          ELSE
#endif
            DO is=1, nspec
              va(is,jsea) = va(is,jsea) + wght *                        &
                   spec(is,i) / sig2(is) * cg(1+(is-1)/nth,isea)
            END DO
#ifdef W3_SMC
          ENDIF !! NGRPSMC .GT. 0
#endif
        END DO
        !
        ! 2.f Final clean up
        !
        DEALLOCATE ( spec1 )
        IF ( respec(imod,j) ) DEALLOCATE ( spec2 )
 
#ifdef W3_SMC
        !!  End GTYPE .EQ. SMCTYPE
      ENDIF
#endif
 
      !!  End 2.b J grid loop.
    END DO
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Set flag if requested
    !
    IF ( PRESENT(done) ) done = .true.
    !
#ifdef W3_PDLIB
    CALL pdlib_exchange2dreal_zero(va)
#endif
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOEG : GATHERING DATA FOR GRID ',i4)
9001 FORMAT ( ' TEST WMIOEG : ',a,' PER SOURCE GRID : '/13x,20i5)
9002 FORMAT ( ' TEST WMIOEG : NO DATA TO BE GATHERED')
#endif
    !
#ifdef W3_T
9010 FORMAT ( ' TEST WMIOEG : TEST DATA AVAILABILITY FOR',i9.8,i7.6)
#endif
#ifdef W3_MPIT
9011 FORMAT ( ' MPIT WMIOEG : EQLSTA =',i2)
9012 FORMAT ( '               STAGING ARRAY FROM',i4,1x,a)
9013 FORMAT ( '               VTIME, DTTST :',i9.8,i7.6,1x,f8.1)
9014 FORMAT (/' MPIT WMIOEG : RECEIVE FROM GRID',i4/           &
         ' +------+------+------+------+--------------+'/ &
         ' |  IH  |  ID  | FROM |  TAG |   handle err |'/ &
         ' +------+------+------+------+--------------+')
9016 FORMAT ( ' |',i5,' |',i5,' |',2(i5,' |'),i9,i4,' |')
9017 FORMAT ( ' +------+------+------+------+--------------+'/)
9018 FORMAT ( ' MPIT WMIOEG : NRQBPT:',i10/)
9019 FORMAT ( ' MPIT WMIOEG : RECEIVES FINISHED :',f6.1,'%')
#endif
    !
#ifdef W3_T
9020 FORMAT ( ' TEST WMIOEG : PROCESSING DATA GRID BY GRID')
9021 FORMAT ( '               NATIVE    GRID ',i3,'   DATA :',i6)
9022 FORMAT ( '               RECEIVING GRID ',i3,'   DATA :',i6)
9023 FORMAT ( '                  AVERAGE SPECTRA')
9024 FORMAT ( '                  CONVERTING SPECTRA')
#endif
    !/
    !/ End of WMIOEG ----------------------------------------------------- /
    !/
  END SUBROUTINE wmioeg
  !/ ------------------------------------------------------------------- /
  SUBROUTINE wmioef ( IMOD )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         25-May-2006 !
    !/                  +-----------------------------------+
    !/
    !/    25-May-2006 : Origination.                        ( version 3.09 )
    !/
    !  1. Purpose :
    !
    !     Finalize staging of internal same-rank data in the data
    !     structure EQSTGE (MPI only).
    !
    !  2. Method :
    !
    !     Post appropriate 'wait' functions to assure that the
    !     communication has finished.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number of grid from which data has
    !                          been staged.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      WMWAVE    Subr  WMWAVEMD Multi-grid wave model.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !       !/SHRD   Shared/distributed memory models.
    !       !/DIST
    !       !/MPI
    !
    !       !/S      Enable subroutine tracing.
    !       !/T      Test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE wmmdatmd
    !
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !
#ifdef W3_MPI
    include "mpif.h"
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J
#ifdef W3_MPI
    INTEGER                 :: IERR_MPI
    INTEGER, POINTER        :: NRQ, IRQ(:)
    INTEGER, ALLOCATABLE    :: STATUS(:,:)
#endif
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    !/
#ifdef W3_S
    CALL strace (ient, 'WMIOEF')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 0.  Initializations
    !
#ifdef W3_T
    WRITE (mdst,9000) imod
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Loop over grids
    !
    DO j=1, nrgrd
      !
#ifdef W3_MPI
      nrq    => eqstge(j,imod)%NRQEQS
#endif
      !
      ! 1.a Nothing to finalize
      !
#ifdef W3_MPI
      IF ( nrq .EQ. 0 ) cycle
      irq    => eqstge(j,imod)%IRQEQS
#endif
      !
      ! 1.b Wait for communication to end
      !
#ifdef W3_MPI
      ALLOCATE ( status(mpi_status_size,nrq) )
      CALL mpi_waitall ( nrq, irq, status, ierr_mpi )
      DEALLOCATE ( status )
#endif
      !
      ! 1.c Reset arrays and counter
      !
#ifdef W3_MPI
      DEALLOCATE ( eqstge(j,imod)%IRQEQS,                      &
           eqstge(j,imod)%TSTORE,                      &
           eqstge(j,imod)%OUTDAT )
      nrq    = 0
#endif
      !
#ifdef W3_T
      WRITE (mdst,9010) j
#endif
      !
    END DO
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT ( ' TEST WMIOEF : FINALIZE STAGING DATA FROM GRID ',i3)
9010 FORMAT ( ' TEST WMIOEF : FINISHED WITH TARGET ',i3)
#endif
    !/
    !/ End of WMIOEF ----------------------------------------------------- /
    !/
  END SUBROUTINE wmioef
  !/
  !/ End of module WMINIOMD -------------------------------------------- /
  !/
END MODULE wminiomd