<reponame>cbegeman/OceanNGD<gh_stars>1-10
!/ ------------------------------------------------------------------- /
      MODULE W3WAVEMD
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           <NAME>            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         29-May-2009 |
!/                  +-----------------------------------+
!/
!/    04-Feb-2000 : Origination.                        ( version 2.00 )
!/                  For upgrades see subroutines.
!/    14-Feb-2000 : Exact-NL added.                     ( version 2.01 )
!/    05-Jan-2001 : Bug fix to allow model to run       ( version 2.05 )
!/                  without output.
!/    24-Jan-2001 : Flat grid version.                  ( version 2.06 )
!/    09-Feb-2001 : Third propagation scheme added.     ( version 2.08 )
!/    23-Feb-2001 : Check for barrier after source
!/                  terms added ( W3NMIN ).     ( delayed version 2.07 )
!/    16-Mar-2001 : Fourth propagation scheme added.    ( version 2.09 )
!/    30-Mar-2001 : Sub-grid obstacles added.           ( version 2.10 )
!/    23-May-2001 : Clean up and bug fixes.             ( version 2.11 )
!/    10-Dec-2001 : Sub-grid obstacles for UQ schemes.  ( version 2.14 )
!/    11-Jan-2002 : Sub-grid ice.                       ( version 2.15 )
!/    24-Jan-2002 : Zero time step dor data ass.        ( version 2.17 )
!/    18-Feb-2002 : Point output diagnostics added.     ( version 2.18 )
!/    30-Apr-2002 : Add field output types 17-18.       ( version 2.20 )
!/    09-May-2002 : Switch clean up.                    ( version 2.21 )
!/    13-Nov-2002 : Add stress vector.                  ( version 3.00 )
!/    26-Dec-2002 : Moving grid version.                ( version 3.02 )
!/    01-Aug-2003 : Moving grid GSE correction.         ( version 3.03 )
!/    20-Aug-2003 : Output server options added.        ( version 3.04 )
!/    07-Oct-2003 : Output options for NN training.     ( version 3.05 )
!/    29-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/                  W3INIT, W3MPII-O and WWVER moved to w3initmd.ftn
!/    04-Feb-2005 : Add STAMP to par list of W3WAVE.    ( version 3.07 )
!/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
!/    28-Jun-2005 : Adding map recalc for W3ULEV call.  ( version 3.07 )
!/    07-Sep-2005 : Updated boundary conditions.        ( version 3.08 )
!/                  Fix NRQSG1/2 = 0 array bound issue.
!/    13-Jun-2006 : Split STORE in G/SSTORE             ( version 3.09 )
!/    26-Jun-2006 : Add output type 6.                  ( version 3.09 )
!/    04-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
!/    18-Oct-2006 : Partitioned spectral data output.   ( version 3.10 )
!/    02-Feb-2007 : Add FLAGST test.                    ( version 3.10 )
!/    02-Apr-2007 : Add partitioned field data.         ( version 3.11 )
!/    07-May-2007 : Bug fix SKIP_O treatment.           ( version 3.11 )
!/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
!/    08-Oct-2007 : Adding AS CX-Y to W3SRCE par. list. ( version 3.13 )
!/    22-Feb-2008 : Initialize VGX-Y properly.          ( version 3.13 )
!/    10-Apr-2008 : Bug fix writing log file (MPI).     ( version 3.13 )
!/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
!/
!/    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 :
!
!  2. Variables and types :
!
!  3. Subroutines and functions :
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      W3WAVE    Subr. Public   Actual wave model.
!      W3GATH    Subr. Public   Data transpose before propagation.
!      W3SCAT    Subr. Public   Data transpose after propagation.
!      W3NMIN    Subr. Public   Calculate minimum number of sea
!                               points per processor.
!     ----------------------------------------------------------------
!
!  4. Subroutines and functions used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3SETx    Subr. W3xDATMD Point to data structure.
!
!      W3UCUR    Subr. W3UPDTMD Interpolate current fields in time.
!      W3UWND    Subr. W3UPDTMD Interpolate wind fields in time.
!      W3UINI    Subr. W3UPDTMD Update initial conditions if init.
!                               with initial wind conditions.
!      W3UBPT    Subr. W3UPDTMD Update boundary points.
!      W3UICE    Subr. W3UPDTMD Update ice coverage.
!      W3ULEV    Subr. W3UPDTMD Transform the wavenumber grid.
!      W3DDXY    Subr. W3UPDTMD Calculate dirivatives of the depth.
!      W3DCXY    Subr. W3UPDTMD Calculate dirivatives of the current.
!
!      W3MAPn    Subr. W3PROnMD Preparation for  ropagation schemes.
!      W3XYPn    Subr. W3PROnMD Longitude-latitude ("XY") propagation.
!      W3KTPn    Subr. W3PROnMD Intra-spectral ("k-theta") propagation.
!
!      W3SRCE    Subr. W3SRCEMD Source term integration and calculation.
!
!      W3IOGR    Subr. W3IOGRMD Reading/writing model definition file.
!      W3OUTG    Subr. W3IOGOMD Generate gridded output fields.
!      W3IOGO    Subr. W3IOGOMD Read/write gridded output.
!      W3IOPE    Subr. W3IOPOMD Extract point output.
!      W3IOPO    Subr. W3IOPOMD Read/write point output.
!      W3IOTR    Subr. W3IOTRMD Process spectral output along tracks.
!      W3IORS    Subr. W3IORSMD Read/write restart files.
!      W3IOBC    Subr. W3IOBCMD Read/write boundary conditions.
!      W3CPRT    Subr. W3IOSFMD Partition spectra.
!      W3IOSF    Subr.   Id.    Write partitioned spectral data.
!
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!      WWTIME    Subr.   Id.    System time in readable format.
!      EXTCDE    Subr.   Id.    Program abort.
!
!      TICK21    Subr. W3TIMEMD Advance the clock.
!      DSEC21    Func.   Id.    Difference between times.
!      STME21    Subr.   Id.    Time in readable format.
!
!      MPI_BARRIER, MPI_STARTALL, MPI_WAITALL
!                Subr.          Basic MPI routines.
!     ----------------------------------------------------------------
!
!  5. Remarks :
!
!  6. Switches :
!
!       !/SHRD  Switch for shared / distributed memory architecture.
!       !/DIST  Id.
!       !/MPI   Id.
!
!       !/LLG   Spherical grid.
!       !/XYG   Cartesian grid.
!
!       !/PR1   First order propagation schemes.
!       !/PR2   ULTIMATE QUICKEST scheme.
!       !/PR3   Averaged ULTIMATE QUICKEST scheme.
!       !/PRX   User-defined scheme.
!
!       !/S     Enable subroutine tracing.
!       !/T     Test output.
!       !/MPIT  Test output for MPI specific code.
!
!  7. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3ADATMD, ONLY: MPIBUF
!
      PUBLIC
!/
      CONTAINS
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3WAVE ( IMOD, TEND, STAMP, NO_OUT )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           <NAME>            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         10-Apr-2008 |
!/                  +-----------------------------------+
!/
!/    17-Mar-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
!/    04-Feb-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
!/                  Major changes to logistics.
!/    05-Jan-2001 : Bug fix to allow model to run       ( version 2.05 )
!/                  without output.
!/    24-Jan-2001 : Flat grid version.                  ( version 2.06 )
!/    09-Feb-2001 : Third propagation scheme added.     ( version 2.08 )
!/    23-Feb-2001 : Check for barrier after source
!/                  terms added ( W3NMIN ).     ( delayed version 2.07 )
!/    16-Mar-2001 : Fourth propagation scheme added.    ( version 2.09 )
!/    30-Mar-2001 : Sub-grid obstacles added.           ( version 2.10 )
!/    23-May-2001 : Barrier added for dry run, changed  ( version 2.10 )
!/                  declaration of FLIWND.
!/    10-Dec-2001 : Sub-grid obstacles for UQ schemes.  ( version 2.14 )
!/    11-Jan-2002 : Sub-grid ice.                       ( version 2.15 )
!/    24-Jan-2002 : Zero time step dor data ass.        ( version 2.17 )
!/    09-May-2002 : Switch clean up.                    ( version 2.21 )
!/    13-Nov-2002 : Add stress vector.                  ( version 3.00 )
!/    26-Dec-2002 : Moving grid version.                ( version 3.02 )
!/    01-Aug-2003 : Moving grid GSE correction.         ( version 3.03 )
!/    07-Oct-2003 : Output options for NN training.     ( version 3.05 )
!/    29-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/    04-Feb-2005 : Add STAMP to par list.              ( version 3.07 )
!/    04-May-2005 : Change to MPI_COMM_WAVE.            ( version 3.07 )
!/    28-Jun-2005 : Adding map recalc for W3ULEV call.  ( version 3.07 )
!/    07-Sep-2005 : Updated boundary conditions.        ( version 3.08 )
!/    26-Jun-2006 : Add output type 6.                  ( version 3.09 )
!/    04-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
!/    18-Oct-2006 : Partitioned spectral data output.   ( version 3.10 )
!/    02-Feb-2007 : Add FLAGST test.                    ( version 3.10 )
!/    02-Apr-2007 : Add partitioned field data.         ( version 3.11 )
!/                  Improve MPI_WAITALL call tests/allocations.
!/    07-May-2007 : Bug fix SKIP_O treatment.           ( version 3.11 )
!/    17-May-2007 : Adding NTPROC/NAPROC separation.    ( version 3.11 )
!/    08-Oct-2007 : Adding AS CX-Y to W3SRCE par. list. ( version 3.13 )
!/    22-Feb-2008 : Initialize VGX-Y properly.          ( version 3.13 )
!/    10-Apr-2008 : Bug fix writing log file (MPI).     ( version 3.13 )
!/
!  1. Purpose :
!
!     Run WAVEWATCH III for a given time interval.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number.
!       TEND    I.A.   I   Ending time of integration.
!       STAMP   Log.   I   Print time stamp (optional, defaults to T).
!       NO_OUT  Log.   I   Skip output (optional, defaults to F).
!                          Skip at ending time only!
!     ----------------------------------------------------------------
!
!     Local parameters : Flags
!     ----------------------------------------------------------------
!       FLOUTG  Log.  Flag for running W3OUTG.
!       FLPART  Log.  Flag for running W3CPRT.
!       FLZERO  Log.  Flag for zero time interval.
!       FLAG0   Log.  Flag for processors without tasks.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!     See module documentation.
!
!  5. Called by :
!
!     Any program shell or integrated model which uses WAVEWATCH III.
!
!  6. Error messages :
!
!  7. Remarks :
!
!     - Currents are updated before winds as currents are used in wind
!       and USTAR processing.
!     - Ice and water levels can be updated only once per call.
!     - If ice or water level time are undefined, the update
!       takes place asap, otherwise around the "half-way point"
!       betweem the old and new times.
!     - To increase accuracy, the calculation o fthe intra-sprectral
!       propagation is performed around the spatial propagation.
!
!  8. Structure :
!
!     -----------------------------------------------------------
!       0.  Initializations
!         a Point to data structures
!         b Subroutine tracing
!         c Local parameter initialization
!         d Test output
!       1.  Check the consistency of the input.
!         a Ending time versus initial time.
!         b Water level time.
!         c Current time interval.
!         d Wind time interval.
!         e Ice time.
!       2.  Determine next time from ending and output
!           time and get corresponding time step.
!       3.  Loop over time steps (see below).
!       4.  Perform output to file if requested.
!         a Check if time is output time.
!         b Processing and MPP preparations.  ( W3CPRT, W3OUTG )
!         c Reset next output time.
!        -------------- loop over output types ------------------
!         d Perform output.                           ( W3IOxx )
!         e Update next output time.
!        -------------------- end loop --------------------------
!       5.  Update log file.
!       6.  If time is not ending time, branch back to 2.
!     -----------------------------------------------------------
!
!      Section 3.
!     ----------------------------------------------------------
!       3.1  Interpolate winds and currents. ( W3UCUR, W3DCXY )
!                                                    ( W3UWND )
!                                                    ( W3UINI )
!       3.2  Update boundary conditions.     ( W3IOBC, W3UBPT )
!       3.3  Update ice coverage (if new ice map).   ( W3UICE )
!       3.4  Transform grid (if new water level).    ( W3ULEV )
!       3.5  Update maps and dirivatives.    ( W3MAPn, W3DDXY )
!                                            ( W3NMIN, W3UTRN )
!            Update grid advection vector.
!       3.6  Perform propagation
!          a Preparations.
!          b Intra spectral part 1.                  ( W3KTPn )
!          c Longitude-latitude       ( W3GATH, W3XYPn W3SCAT )
!          b Intra spectral part 2.                  ( W3KTPn )
!       3.7  Calculate and integrate source terms.   ( W3SRCE )
!       3.8  Update global time step.
!     ----------------------------------------------------------
!
!  9. Switches :
!
!     See module documentation.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3CONSTANTS
!/
      USE W3GDATMD
      USE W3WDATMD
      USE W3ADATMD
      USE W3IDATMD
      USE W3ODATMD
!/
      USE W3UPDTMD
      USE W3SRCEMD
      USE W3PRO3MD
!/
      USE W3IOGRMD
      USE W3IOGOMD
      USE W3IOPOMD
      USE W3IOTRMD
      USE W3IORSMD
      USE W3IOBCMD
      USE W3IOSFMD
!/
      USE W3SERVMD
      USE W3TIMEMD

      ! QL, 150823, flag for restart
      use w3cesmmd, only : rstwr, histwr
      use shr_sys_mod, only : shr_sys_flush
!
      IMPLICIT NONE
!
      INCLUDE "mpif.h"
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)           :: IMOD, TEND(2)
      LOGICAL, INTENT(IN), OPTIONAL :: STAMP, NO_OUT
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters :
!/
      INTEGER                 :: TCALC(2), IT, IT0, NT, ITEST,        &
                                 ITLOC, ITLOCH, NTLOC, ISEA, JSEA,    &
                                 IX, IY, ISPEC, J, TOUT(2), TLST(2)
      INTEGER                 :: IERR_MPI, NRQMAX
      INTEGER, ALLOCATABLE    :: STATCO(:,:), STATIO(:,:)
      REAL                    :: DTTST, DTTST1, DTTST2, DTTST3,       &
                                 DTL0, DTI0, DTGA, DTG, DTRES,        &
                                 FAC, VGX, VGY, FACK, FACTH,          &
                                 FACX, FACY, SXM, SYM, XXX
      REAL, ALLOCATABLE       :: FIELD(:)
      LOGICAL                 :: FLACT, FLZERO, FLFRST, FLMAP, TSTAMP,&
                                 SKIP_O, FLAG_O, FLDDIR, READBC,      &
                                 FLAG0=.FALSE., FLOUTG, FLPFLD,       &
                                 FLPART, LOCAL
      LOGICAL                 :: FLGMPI(6)
      CHARACTER(LEN=8)        :: STTIME
      CHARACTER(LEN=11)       :: IDACT, OUTID
      CHARACTER(LEN=23)       :: IDTIME
!/
!/ ------------------------------------------------------------------- /
! 0.  Initializations
! 0.a Set pointers to data structure
!

      IF ( IOUTP  .NE. IMOD ) CALL W3SETO ( IMOD, NDSE, NDST )
      IF ( IGRID  .NE. IMOD ) CALL W3SETG ( IMOD, NDSE, NDST )
      IF ( IWDATA .NE. IMOD ) CALL W3SETW ( IMOD, NDSE, NDST )
      IF ( IADATA .NE. IMOD ) CALL W3SETA ( IMOD, NDSE, NDST )
      IF ( IIDATA .NE. IMOD ) CALL W3SETI ( IMOD, NDSE, NDST )
!
      IF ( PRESENT(STAMP) ) THEN
          TSTAMP = STAMP
        ELSE
          TSTAMP = .TRUE.
        END IF
!
      IF ( PRESENT(NO_OUT) ) THEN
          SKIP_O = NO_OUT
        ELSE
          SKIP_O = .FALSE.
        END IF
!
! 0.b Subroutine tracing
!
! 0.c Local parameter initialization
!
      IPASS  = IPASS + 1
      IDACT  = '           '
      OUTID  = '           '
      FLACT  = ITIME .EQ. 0
      FLMAP  = ITIME .EQ. 0
      FLDDIR = ITIME .EQ. 0 .AND. ( FLCTH .OR. FLCK )
!
      FLPFLD = .FALSE.
      DO J=15,20
        FLPFLD = FLPFLD .OR. FLOGRD(J)
        END DO
!
      IF ( IAPROC .EQ. NAPLOG ) BACKSPACE ( NDSO )
!
      IF ( FLCOLD ) THEN
          DTDYN = 0.
          FCUT  = SIG(NK) * TPIINV
        END IF
!
      ALLOCATE ( FIELD(1-NY:NY*(NX+2)) )
      FIELD = 0.
!
      LOCAL   = IAPROC .LE. NAPROC
!
! 0.c Test output
!
! 1.  Check the consistency of the input ----------------------------- /
! 1.a Ending time versus initial time
!
      DTTST  = DSEC21 ( TIME , TEND )
      FLZERO = DTTST .EQ. 0.
      IF ( DTTST .LT. 0. ) THEN
          IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000)
          CALL EXTCDE ( 1 )
        END IF
!
! 1.b Water level time
!
      IF ( FLLEV ) THEN
          IF ( TLEV(1) .GE. 0. ) THEN
              DTL0   = DSEC21 ( TLEV , TLN )
            ELSE
              DTL0   = 1.
            END IF
          IF ( DTL0 .LT. 0. ) THEN
              IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001)
              CALL EXTCDE ( 2 )
            END IF
        ELSE
          DTL0   = 0.
        END IF
!
! 1.c Current interval
!
      IF ( FLCUR ) THEN
          DTTST1 = DSEC21 ( TC0 , TCN )
          DTTST2 = DSEC21 ( TC0 , TIME )
          DTTST3 = DSEC21 ( TEND , TCN )
          IF ( DTTST1.LT.0. .OR. DTTST2.LT.0. .OR. DTTST3.LT.0. ) THEN
              IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002)
              CALL EXTCDE ( 3 )
            END IF
          IF ( DTTST2.EQ.0..AND. ITIME.EQ.0 ) THEN
              IDACT(7:7) = 'F'
              TOFRST = TIME
            END IF
        END IF
!
! 1.d Wind interval
!
      IF ( FLWIND ) THEN
          DTTST1 = DSEC21 ( TW0 , TWN )
          DTTST2 = DSEC21 ( TW0 , TIME )
          DTTST3 = DSEC21 ( TEND , TWN )
          IF ( DTTST1.LT.0. .OR. DTTST2.LT.0. .OR. DTTST3.LT.0. ) THEN
              IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003)
              CALL EXTCDE ( 4 )
            END IF
          IF ( DTTST2.EQ.0..AND. ITIME.EQ.0 ) THEN
              IDACT(3:3) = 'F'
              TOFRST = TIME
            END IF
        END IF
!
! 1.e Ice time
!
      IF ( FLICE ) THEN
          IF ( TICE(1) .GE. 0 ) THEN
              DTI0   = DSEC21 ( TICE , TIN )
            ELSE
              DTI0   = 1.
            END IF
          IF ( DTI0 .LT. 0. ) THEN
              IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1004)
              CALL EXTCDE ( 5 )
            END IF
        ELSE
          DTI0   = 0.
        END IF
!
! 2.  Determine next time from ending and output --------------------- /
!     time and get corresponding time step.
!
      FLFRST = .TRUE.
      DO
!
        IF ( TOFRST(1) .GT. 0 ) THEN
            DTTST  = DSEC21 ( TEND , TOFRST )
          ELSE
            DTTST  = 0.
          ENDIF
!
        IF ( DTTST.GE.0. ) THEN
            TCALC = TEND
          ELSE
            TCALC = TOFRST
          END IF
!
        DTTST  = DSEC21 ( TIME , TCALC )
        NT     = 1 + INT ( DTTST / DTMAX - 0.001 )
        DTGA   = DTTST / REAL(NT)
        IF ( DTTST .EQ. 0. ) THEN
            IT0    = 0
            IF ( .NOT.FLZERO ) ITIME  = ITIME - 1
            NT     = 0
          ELSE
            IT0    = 1
          END IF

! ==================================================================== /
! 3.  Loop over time steps
!
        DTRES  = 0.
!
        DO IT=IT0, NT
!
          ITIME  = ITIME + 1
          DTG    = REAL(NINT(DTGA+DTRES+0.0001))
          DTRES  = DTRES + DTGA - DTG
          IF ( ABS(DTRES) .LT. 0.001 ) DTRES  = 0.
          CALL TICK21 ( TIME , DTG )
!
          IF ( TSTAMP .AND. SCREEN.NE.NDSO .AND. IAPROC.EQ.NAPOUT ) THEN
              CALL WWTIME ( STTIME )
              CALL STME21 ( TIME , IDTIME )
              WRITE (SCREEN,950) IDTIME, STTIME
            END IF
!
          VGX = 0.
          VGY = 0.
          IF(FLAGS(8)) THEN
              DTTST1 = DSEC21 ( TIME, TGN )
              DTTST2 = DSEC21 ( TG0, TGN )
              FAC    = DTTST1 / MAX ( 1. , DTTST2 )
              VGX    = (FAC*GA0+(1.-FAC)*GAN) *                       &
                            COS(FAC*GD0+(1.-FAC)*GDN)
              VGY    = (FAC*GA0+(1.-FAC)*GAN) *                       &
                            SIN(FAC*GD0+(1.-FAC)*GDN)
            END IF
!
! 3.1 Interpolate winds and currents.
!     (Initialize wave fields with winds)
!
          IF ( FLCUR  ) THEN
               CALL W3UCUR ( FLFRST )
               CALL W3DCXY
            ELSE IF ( FLFRST ) THEN
              CX = 0.
              CY = 0.
            END IF
!
          IF ( FLWIND ) THEN
               IF ( FLFRST ) ASF = 1.
               CALL W3UWND ( FLFRST, VGX, VGY )
            ELSE IF ( FLFRST ) THEN
               U10    = 0.01
               U10D   = 0.
               UST    = 0.05
               USTDIR = 0.05
            END IF
!
          IF ( FLIWND .AND. LOCAL ) CALL W3UINI ( VA )
!
! 3.2 Update boundary conditions.
!
          IF ( FLBPI .AND. LOCAL ) THEN
!
              DO
                IF ( TBPIN(1) .EQ. -1 ) THEN
                    READBC = .TRUE.
                    IDACT(1:1) = 'F'
                  ELSE
                    READBC = DSEC21(TIME,TBPIN).LT.0.
                    IF (READBC.AND.IDACT(1:1).EQ.' ') IDACT(1:1) = 'X'
                  END IF
                FLACT  = READBC .OR. FLACT
                IF ( READBC ) THEN
                    CALL W3IOBC ( 'READ', NDS(9), TBPI0, TBPIN,       &
                                  ITEST, IMOD )
                    IF ( ITEST .NE. 1 ) CALL W3UBPT
                  END IF
                IF ( ITEST .LT. 0 ) IDACT(1:1) = 'L'
                IF ( ITEST .GT. 0 ) IDACT(1:1) = ' '
                IF ( .NOT. (READBC.AND.FLBPI) ) EXIT
                END DO
!
            END IF
!
! 3.3 Update ice coverage (if new ice map).
!     Need to be run on output nodes too, to update MAPSTx
!
          IF ( FLICE .AND. DTI0.NE.0. ) THEN
!
              IF ( TICE(1).GE.0 ) THEN
                  IF ( DTI0 .LT. 0. ) THEN
                      IDACT(9:9) = 'B'
                    ELSE
                      DTTST  = DSEC21 ( TIME, TIN )
                      IF ( DTTST .LE. 0.5*DTI0 ) IDACT(9:9) = 'U'
                    END IF
                ELSE
                  IDACT(9:9) = 'I'
                END IF
!
              IF ( IDACT(9:9).NE.' ' ) THEN
                  CALL W3UICE ( VA, VA )
                  DTI0   = 0.
                  FLACT  = .TRUE.
                  FLMAP  = .TRUE.
                END IF
!
            END IF
!
! 3.4 Transform grid (if new water level).
!
          IF ( FLLEV .AND. DTL0.NE.0. ) THEN
!
              IF ( TLEV(1).GE.0 ) THEN
                  IF ( DTL0 .LT. 0. ) THEN
                      IDACT(5:5) = 'B'
                    ELSE
                      DTTST  = DSEC21 ( TIME, TLN )
                      IF ( DTTST .LE. 0.5*DTL0 ) IDACT(5:5) = 'U'
                    END IF
                ELSE
                  IDACT(5:5) = 'I'
                END IF
!
              IF ( IDACT(5:5).NE.' ' ) THEN
                  CALL W3ULEV ( VA, VA )
                  DTL0   = 0.
                  FLACT  = .TRUE.
                  FLMAP  = .TRUE.
                  FLDDIR = FLDDIR .OR. FLCTH .OR. FLCK
                END IF
!
            END IF
!
! 3.5 Update maps and dirivatives.
!
          IF ( FLMAP ) THEN
              CALL W3MAP3
              CALL W3UTRN ( TRNX, TRNY )
              CALL W3MAPT
              CALL W3NMIN ( MAPSTA, FLAG0 )
              IF ( FLAG0 .AND. IAPROC.EQ.NAPERR ) WRITE (NDSE,1030) IMOD
              FLMAP  = .FALSE.
            END IF
!
          IF ( FLDDIR ) THEN
              CALL W3DDXY
              FLDDIR = .FALSE.
            END IF
!
          FLIWND = .FALSE.
          FLFRST = .FALSE.
!
          IF ( FLZERO ) THEN
              GOTO 400
            END IF
          IF ( FLDRY .OR. IT.EQ.0 .OR. IAPROC.GT.NAPROC ) THEN
              GOTO 380
            END IF
!
! 3.6 Perform Propagation = = = = = = = = = = = = = = = = = = = = = = =
! 3.6.1 Preparations
!
          NTLOC  = 1 + INT( DTG/DTCFLI - 0.001 )
          ITLOCH = ( NTLOC + 1 - MOD(ITIME,2) ) / 2
!
          FACTH  = DTG / DTH / REAL(NTLOC)
          FACK   = DTG / REAL(NTLOC)
!
! 3.6.2 Intra-spectral part 1
!
          IF ( FLCTH .OR. FLCK ) THEN
              DO ITLOC=1, ITLOCH
                DO JSEA=1, NSEAL
                  ISEA   = IAPROC + (JSEA-1)*NAPROC
                  IX     = MAPSF(ISEA,1)
                  IY     = MAPSF(ISEA,2)
                  IF ( MAPSTA(IY,IX) .EQ. 1 ) THEN
                      CALL W3KTP3 ( ISEA, FACTH, FACK, CTHG0(IY), &
                           CG(:,ISEA), WN(:,ISEA), DW(ISEA),      &
                           DDDX(IY,IX), DDDY(IY,IX), CX(ISEA),    &
                           CY(ISEA), DCXDX(IY,IX), DCXDY(IY,IX),  &
                           DCYDX(IY,IX), DCYDY(IY,IX), VA(:,JSEA) )
                    END IF
                  END DO
                END DO
            END IF
!
! 3.6.3 Longitude-latitude
!       (time step correction in routine)
!
          IF ( FLCX .OR. FLCY ) THEN
!
              IF ( FLCX ) THEN
                  FACX   = DTG / ( SX * DERA * RADIUS )
                  SXM    = SX * DERA * RADIUS
                ELSE
                  FACX   = 0.
                END IF
              IF ( FLCY ) THEN
                  FACY   = DTG / ( SY * DERA * RADIUS )
                  SYM    = SY * DERA * RADIUS
                ELSE
                  FACY   = 0.
                END IF
!
              IF ( NRQSG1 .GT. 0 ) THEN
                  CALL MPI_STARTALL (NRQSG1, IRQSG1(1,1), IERR_MPI)
                  CALL MPI_STARTALL (NRQSG1, IRQSG1(1,2), IERR_MPI)
                END IF
!
              DO ISPEC=1, NSPEC
                IF ( IAPPRO(ISPEC) .EQ. IAPROC ) THEN
                    CALL W3GATH ( ISPEC, FIELD )
                    CALL W3XYP3 ( ISPEC, FACX, FACY, DTG, MAPSTA, &
                                  MAPFS,  FIELD, VGX, VGY )
                    CALL W3SCAT ( ISPEC, MAPSTA, FIELD )
                  END IF
                END DO
!
              IF ( NRQSG1 .GT. 0 ) THEN
                  ALLOCATE ( STATCO(MPI_STATUS_SIZE,NRQSG1) )
                  CALL MPI_WAITALL (NRQSG1, IRQSG1(1,1), STATCO, &
                                    IERR_MPI)
                  CALL MPI_WAITALL (NRQSG1, IRQSG1(1,2), STATCO, &
                                    IERR_MPI)
                  DEALLOCATE ( STATCO )
                END IF
!
            END IF
!
! 3.6.4 Intra-spectral part 2
!
          IF ( FLCTH .OR. FLCK ) THEN
              DO ITLOC=ITLOCH+1, NTLOC
                DO JSEA=1, NSEAL
                  ISEA   = IAPROC + (JSEA-1)*NAPROC
                  IX     = MAPSF(ISEA,1)
                  IY     = MAPSF(ISEA,2)
                  IF ( MAPSTA(IY,IX) .EQ. 1 ) THEN
                      CALL W3KTP3 ( ISEA, FACTH, FACK, CTHG0(IY), &
                           CG(:,ISEA), WN(:,ISEA), DW(ISEA),      &
                           DDDX(IY,IX), DDDY(IY,IX), CX(ISEA),    &
                           CY(ISEA), DCXDX(IY,IX), DCXDY(IY,IX),  &
                           DCYDX(IY,IX), DCYDY(IY,IX), VA(:,JSEA) )
                    END IF
                  END DO
                END DO
            END IF
!
! 3.6 End propapgation  = = = = = = = = = = = = = = = = = = = = = = = =
!
! 3.7 Calculate and integrate source terms.
!
          IF ( FLSOU ) THEN
!
              DO JSEA=1, NSEAL
                ISEA   = IAPROC + (JSEA-1)*NAPROC
                IX     = MAPSF(ISEA,1)
                IY     = MAPSF(ISEA,2)
                IF ( MAPSTA(IY,IX).EQ.1 .AND. FLAGST(ISEA) ) THEN
                     CALL W3SRCE ( IX, IY, IMOD, VA(:,JSEA),          &
                          ALPHA(1:NK,JSEA), WN(1:NK,ISEA),            &
                          CG(1:NK,ISEA), DW(ISEA), U10(ISEA),         &
                          U10D(ISEA), AS(ISEA), UST(ISEA),            &
                          USTDIR(ISEA), CX(ISEA), CY(ISEA),           &
                          EMN(ISEA), FMN(ISEA), WNM(ISEA), AMX(ISEA), &
                          FPIS(ISEA), CDS(ISEA), Z0S(ISEA),           &
                          DTDYN(ISEA), FCUT(ISEA), DTG )
                  ELSE
                    UST   (ISEA) = UNDEF
                    USTDIR(ISEA) = UNDEF
                    DTDYN (ISEA) = UNDEF
                    FCUT  (ISEA) = UNDEF
                  END IF
                END DO
!
! This barrier is from older code versions. It has been removed in 3.11
! to optimize IO2/3 settings. May be needed on some systems still
!
!!/MPI              IF (FLAG0) CALL MPI_BARRIER (MPI_COMM_WCMP,IERR_MPI)
!!/MPI            ELSE
!!/MPI              CALL MPI_BARRIER (MPI_COMM_WCMP,IERR_MPI)
!
            END IF
!
! 3.8 Update global time step.
!     (Branch point FLDRY, IT=0)
!
  380     CONTINUE
!
          IF (IT.NE.NT) THEN
              DTTST  = DSEC21 ( TIME , TCALC )
              DTG    = DTTST / REAL(NT-IT)
            END IF
!
          IF ( FLACT .AND. IT.NE.NT .AND. IAPROC.EQ.NAPLOG ) THEN
              CALL STME21 ( TIME , IDTIME )
              IF ( IDLAST .NE. TIME(1) ) THEN
                  WRITE (NDSO,900) ITIME, IPASS, IDTIME(01:19),       &
                                   IDACT, OUTID
                  IDLAST = TIME(1)
                ELSE
                  WRITE (NDSO,901) ITIME, IPASS, IDTIME(12:19),       &
                                   IDACT, OUTID
                END IF
              FLACT  = .FALSE.
              IDACT  = '         '
            END IF
!
          END DO
!
!     End of loop over time steps
! ==================================================================== /
!
  400 CONTINUE

!
! 4.  Perform output to file if requested ---------------------------- /
! 4.a Check if time is output time
!     Delay if data assimilation time.
!
        IF ( TOFRST(1)  .EQ. -1 ) THEN
            DTTST  = 1.
          ELSE
            DTTST   = DSEC21 ( TIME, TOFRST )
          END IF
!
        IF ( TDN(1)  .EQ. -1 ) THEN
            DTTST1 = 1.
          ELSE
            DTTST1  = DSEC21 ( TIME, TDN )
          END IF
!
        DTTST2 = DSEC21 ( TIME, TEND )
        FLAG_O = .NOT.SKIP_O .OR. ( SKIP_O .AND. DTTST2.NE.0. )
!
        IF ( DTTST.LE.0. .AND. DTTST1.NE.0. .AND. FLAG_O ) THEN
!
! 4.b Processing and MPP preparations
!
            IF ( FLOUT(1) ) THEN
                FLOUTG = DSEC21(TIME,TONEXT(:,1)).EQ.0.
              ELSE
                FLOUTG = .FALSE.
              END IF
!
            FLPART = .FALSE.
            IF ( FLOUT(1) .AND. FLPFLD )                               &
                 FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,1)).EQ.0.
            IF ( FLOUT(6) )                                            &
                 FLPART = FLPART .OR. DSEC21(TIME,TONEXT(:,6)).EQ.0.
!
            IF ( LOCAL .AND. FLPART ) CALL W3CPRT ( IMOD )
            IF ( LOCAL .AND. FLOUTG ) CALL W3OUTG ( VA, FLPFLD )
!
            FLGMPI = .FALSE.
            NRQMAX = 0
!
            IF ( FLOUT(1) .AND. NRQGO.NE.0 ) THEN
                IF ( DSEC21(TIME,TONEXT(:,1)).EQ.0. ) THEN
                    CALL MPI_STARTALL ( NRQGO, IRQGO , IERR_MPI )
                    FLGMPI(1) = .TRUE.
                    NRQMAX    = MAX ( NRQMAX , NRQGO )
                  END IF
              END IF
!
            IF ( FLOUT(2) .AND. NRQPO.NE.0 ) THEN
                IF ( DSEC21(TIME,TONEXT(:,2)).EQ.0. ) THEN
                    CALL MPI_STARTALL ( NRQPO, IRQPO1, IERR_MPI )
                    FLGMPI(2) = .TRUE.
                    NRQMAX    = MAX ( NRQMAX , NRQPO )
                  END IF
              END IF
!
            IF ( FLOUT(4) .AND. NRQRS.NE.0 ) THEN
                IF ( DSEC21(TIME,TONEXT(:,4)).EQ.0. ) THEN
                    CALL MPI_STARTALL ( NRQRS, IRQRS , IERR_MPI )
                    FLGMPI(4) = .TRUE.
                    NRQMAX    = MAX ( NRQMAX , NRQRS )
                  END IF
              END IF
!
            IF ( FLOUT(5) .AND. NRQBP.NE.0 ) THEN
                IF ( DSEC21(TIME,TONEXT(:,5)).EQ.0. ) THEN
                    CALL MPI_STARTALL ( NRQBP , IRQBP1, IERR_MPI )
                    FLGMPI(5) = .TRUE.
                    NRQMAX    = MAX ( NRQMAX , NRQBP )
                  END IF
              END IF
!
            IF ( FLOUT(5) .AND. NRQBP2.NE.0 .AND.                &
                 IAPROC.EQ.NAPBPT) THEN
                IF ( DSEC21(TIME,TONEXT(:,5)).EQ.0. ) THEN
                    CALL MPI_STARTALL (NRQBP2,IRQBP2,IERR_MPI)
                    NRQMAX    = MAX ( NRQMAX , NRQBP2 )
                  END IF
              END IF
!
           IF ( NRQMAX .NE. 0 ) ALLOCATE                         &
                                 ( STATIO(MPI_STATUS_SIZE,NRQMAX) )
!
! 4.c Reset next output time
!
            TOFRST(1) = -1
            TOFRST(2) =  0
!
            DO J=1, 6
              IF ( FLOUT(J) ) THEN
!
! 4.d Perform output
!
                  TOUT(:) = TONEXT(:,J)
                  DTTST   = DSEC21 ( TIME, TOUT )
!
                  IF ( DTTST .EQ. 0. ) THEN
                      ! QL, 160601, add history file flag
                      IF ( J .EQ. 1 .AND. HISTWR) THEN
!MV BUG                  IF ( IAPROC .EQ. NAPFLD ) THEN
                         IF ( FLGMPI(1) ) CALL MPI_WAITALL  &
                              ( NRQGO, IRQGO, STATIO, IERR_MPI )
                         IF ( IAPROC .EQ. NAPFLD ) THEN
                            FLGMPI(1) = .FALSE.
                            CALL W3IOGO                             &
                                 ( 'WRITE', NDS(7), ITEST, IMOD )
                            END IF
                        ELSE IF ( J .EQ. 2 ) THEN
                          IF ( IAPROC .EQ. NAPPNT ) THEN
                              CALL W3IOPE ( VA )
                              CALL W3IOPO                             &
                                 ( 'WRITE', NDS(8), ITEST, IMOD )
                            END IF
                        ELSE IF ( J .EQ. 3 ) THEN
                          CALL W3IOTR ( NDS(11), NDS(12), VA, IMOD )
                        ! QL, 150823, add restart flag
                        ELSE IF ( J .EQ. 4 .AND. RSTWR) THEN
                          CALL W3IORS ('HOT', NDS(6), XXX, ITEST, IMOD )
                        ELSE IF ( J .EQ. 5 ) THEN
                          IF ( IAPROC .EQ. NAPBPT ) THEN
                              IF (NRQBP2.NE.0) CALL MPI_WAITALL  &
                                ( NRQBP2, IRQBP2,STATIO, IERR_MPI )
                              CALL W3IOBC ( 'WRITE', NDS(10),         &
                                            TIME, TIME, ITEST, IMOD )
                            END IF
                        ELSE IF ( J .EQ. 6 ) THEN
                          CALL W3IOSF ( NDS(13), IMOD )
                        END IF
!
                      CALL TICK21 ( TOUT, DTOUT(J) )
                      TONEXT(:,J) = TOUT
                      TLST        = TOLAST(:,J)
                      DTTST       = DSEC21 ( TOUT , TLST )
                      FLOUT(J)    = DTTST.GE.0.
                      IF ( FLOUT(J) ) THEN
                          OUTID(2*J-1:2*J-1) = 'X'
                        ELSE
                          OUTID(2*J-1:2*J-1) = 'L'
                        END IF
                    END IF
!
! 4.e Update next output time
!
                  IF ( FLOUT(J) ) THEN
                      IF ( TOFRST(1).EQ.-1 ) THEN
                          TOFRST = TOUT
                        ELSE
                          DTTST  = DSEC21 ( TOUT , TOFRST )
                          IF ( DTTST.GT.0.) THEN
                              TOFRST = TOUT
                            END IF
                        END IF
                    END IF
!
                END IF
!
              END DO
!
            IF ( FLGMPI(1) ) CALL MPI_WAITALL                    &
                             ( NRQGO, IRQGO , STATIO, IERR_MPI )
            IF ( FLGMPI(2) ) CALL MPI_WAITALL                    &
                             ( NRQPO, IRQPO1, STATIO, IERR_MPI )
            IF ( FLGMPI(4) ) CALL MPI_WAITALL                    &
                             ( NRQRS, IRQRS , STATIO, IERR_MPI )
            IF ( FLGMPI(5) ) CALL MPI_WAITALL                    &
                             ( NRQBP, IRQBP1, STATIO, IERR_MPI )
            IF ( NRQMAX .NE. 0 ) DEALLOCATE ( STATIO )
!
! This barrier is from older code versions. It has been removed in 3.11
! to optimize IO2/3 settings. May be needed on some systems still
!
!!/MPI            IF (FLDRY) CALL MPI_BARRIER (MPI_COMM_WAVE,IERR_MPI)
!
          END IF
!
! 5.  Update log file ------------------------------------------------ /
!
        IF ( IAPROC.EQ.NAPLOG ) THEN
!
            CALL STME21 ( TIME , IDTIME )
            IF ( FLCUR ) THEN
                DTTST  = DSEC21 ( TIME , TCN )
                IF ( DTTST .EQ. 0. ) IDACT(7:7) = 'X'
              END IF
            IF ( FLWIND ) THEN
                DTTST  = DSEC21 ( TIME , TWN )
                IF ( DTTST .EQ. 0. ) IDACT(3:3) = 'X'
              END IF
            IF ( TDN(1) .GT. 0  ) THEN
                DTTST  = DSEC21 ( TIME , TDN )
                IF ( DTTST .EQ. 0. ) IDACT(11:11) = 'X'
              END IF
!
            IF ( IDLAST.NE.TIME(1) ) THEN
                WRITE (NDSO,900) ITIME, IPASS, IDTIME(1:19),          &
                                 IDACT, OUTID
                IDLAST = TIME(1)
              ELSE
                WRITE (NDSO,901) ITIME, IPASS, IDTIME(12:19),         &
                                 IDACT, OUTID
              END IF
!
          END IF
!
        IDACT  = '         '
        OUTID  = '           '
        FLACT  = .FALSE.
!
! 6.  If time is not ending time, branch back to 2 ------------------- /
!
        DTTST  = DSEC21 ( TIME, TEND )
        IF ( DTTST .EQ. 0. ) EXIT
        END DO
!
      IF ( IAPROC .EQ. NAPLOG ) WRITE (NDSO,902)
!
      DEALLOCATE ( FIELD )
!
      RETURN
!
! Formats
!
  900 FORMAT (8X,I6,'  |',I4,'  | ', A19  ,' | ',A,' | ',A,' |')
  901 FORMAT (8X,I6,'  |',I4,'  | ',11X,A8,' | ',A,' | ',A,' |')
  902 FORMAT (8X,'--------+------+---------------------+'             &
                ,'-------------+-------------+')
!
  950 FORMAT ('  WAVEWATCH III calculating for ',A,' at ',A)
!
 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3WAVE :'/                &
               '     ENDING TIME BEFORE STARTING TIME '/)
 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3WAVE :'/                &
               '     NEW WATER LEVEL BEFORE OLD WATER LEVEL '/)
 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3WAVE :'/                &
               '     ILLEGAL CURRENT INTERVAL '/)
 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3WAVE :'/                &
               '     ILLEGAL WIND INTERVAL '/)
 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3WAVE :'/                &
               '     NEW ICE FIELD BEFORE OLD ICE FIELD '/)
 1030 FORMAT (/' *** WAVEWATCH III WARING IN W3WAVE :'/               &
               '     AT LEAST ONE PROCESSOR HAS 0 ACTIVE POINTS',     &
                   ' IN GRID',I3)
!
!/
!/ End of W3WAVE ----------------------------------------------------- /
!/
      END SUBROUTINE W3WAVE
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3GATH ( ISPEC, FIELD )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           <NAME>            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         13-Jun-2006 |
!/                  +-----------------------------------+
!/
!/    04-Jan-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
!/    13-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
!/                  Major changes to logistics.
!/    29-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/    13-Jun-2006 : Split STORE in G/SSTORE             ( version 3.09 )
!/
!  1. Purpose :
!
!     Gather spectral bin information into a propagation field array.
!
!  2. Method :
!
!     Direct copy or communication calls (MPP version).
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       ISPEC   Int.   I   Spectral bin considered.
!       FIELD   R.A.   O   Full field to be propagated.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!
!      MPI_STARTALL, MPI_WAITALL
!                Subr. mpif.h   MPI persistent comm. routines (!/MPI).
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!       None.
!
!  7. Remarks :
!
!     - The field is extracted but not converted.
!     - Array FIELD is not initialized.
!     - MPI version requires posing of send and receive calls in
!       W3WAVE to match local calls.
!     - MPI version does not require an MPI_TESTALL call for the
!       posted gather operation as MPI_WAITALL is mandatory to
!       reset persistent communication for next time step.
!     - MPI version allows only two new pre-fetch postings per
!       call to minimize chances to be slowed down by gathers that
!       are not yet needed, while maximizing the pre-loading
!       during the early (low-frequency) calls to the routine
!       where the amount of calculation needed for proagation is
!       the largest.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/SHRD  Switch for message passing method.
!     !/MPI   Id.
!
!     !/S     Enable subroutine tracing.
!     !/MPIT  MPI test output.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3GDATMD, ONLY: NSPEC, NX, NY, NSEA, NSEAL, MAPSF
      USE W3WDATMD, ONLY: A => VA
      USE W3ADATMD, ONLY: MPIBUF, BSTAT, IBFLOC, ISPLOC, BISPL, &
                          NSPLOC, NRQSG2, IRQSG2, GSTORE
      USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC
!/
      IMPLICIT NONE
!
      INCLUDE "mpif.h"
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: ISPEC
      REAL, INTENT(OUT)       :: FIELD(1-NY:NY*(NX+2))
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: STATUS(MPI_STATUS_SIZE,NSPEC),  &
                                 IOFF, IERR_MPI, JSEA, ISEA,     &
                                 IXY, IS0, IB0, NPST, J
!/
!/ ------------------------------------------------------------------- /
!/
!
!      FIELD  = 0.
!
! 1.  Shared memory version ------------------------------------------ /
!
! 2.  Distributed memory version ( MPI ) ----------------------------- /
! 2.a Update counters
!
      ISPLOC = ISPLOC + 1
      IBFLOC = IBFLOC + 1
      IF ( IBFLOC .GT. MPIBUF ) IBFLOC = 1
!
! 2.b Check status of present buffer
! 2.b.1 Scatter (send) still in progress, wait to end
!
      IF ( BSTAT(IBFLOC) .EQ. 2 ) THEN
          IOFF =  1 + (BISPL(IBFLOC)-1)*NRQSG2
          IF ( NRQSG2 .GT. 0 ) CALL                              &
               MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2),             &
                             STATUS, IERR_MPI )
          BSTAT(IBFLOC) = 0
        END IF
!
! 2.b.2 Gather (recv) not yet posted, post now
!
      IF ( BSTAT(IBFLOC) .EQ. 0 ) THEN
          BSTAT(IBFLOC) = 1
          BISPL(IBFLOC) = ISPLOC
          IOFF =  1 + (ISPLOC-1)*NRQSG2
          IF ( NRQSG2 .GT. 0 ) CALL                              &
               MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI )
        END IF
!
! 2.c Put local spectral densities in store
!
      DO JSEA=1, NSEAL
        GSTORE(IAPROC+(JSEA-1)*NAPROC,IBFLOC) = A(ISPEC,JSEA)
        END DO
!
! 2.d Wait for remote spectral densities
!
      IOFF =  1 + (BISPL(IBFLOC)-1)*NRQSG2
      IF ( NRQSG2 .GT. 0 ) CALL                                  &
           MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,1), STATUS, IERR_MPI )
!
! 2.e Convert storage array to field.
!
      DO ISEA=1, NSEA
        IXY        = MAPSF(ISEA,3)
        FIELD(IXY) = GSTORE(ISEA,IBFLOC)
        END DO
!
! 2.f Pre-fetch data in available buffers
!
      IS0    = ISPLOC
      IB0    = IBFLOC
      NPST   = 0
!
      DO J=1, MPIBUF-1
        IS0    = IS0 + 1
        IF ( IS0 .GT. NSPLOC ) EXIT
        IB0    = 1 + MOD(IB0,MPIBUF)
        IF ( BSTAT(IB0) .EQ. 0 ) THEN
            BSTAT(IB0) = 1
            BISPL(IB0) = IS0
            IOFF       = 1 + (IS0-1)*NRQSG2
            IF ( NRQSG2 .GT. 0 ) CALL                            &
                 MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI )
            NPST       = NPST + 1
          END IF
        IF ( NPST .GE. 2 ) EXIT
        END DO
!
! 2.g Test output
!
      RETURN
!
! Formats
!
!/
!/ End of W3GATH ----------------------------------------------------- /
!/
      END SUBROUTINE W3GATH
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           <NAME>            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         13-Jun-2006 |
!/                  +-----------------------------------+
!/
!/    04-Jan-1999 : Distributed FORTRAN 77 version.     ( version 1.18 )
!/    13-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
!/                  Major changes to logistics.
!/    28-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/    07-Sep-2005 : Updated boundary conditions.        ( version 3.08 )
!/    13-Jun-2006 : Split STORE in G/SSTORE             ( version 3.09 )
!/
!  1. Purpose :
!
!     'Scatter' data back to spectral storage after propagation.
!
!  2. Method :
!
!     Direct copy or communication calls (MPP version).
!     See also W3GATH.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       ISPEC   Int.   I   Spectral bin considered.
!       MAPSTA  I.A.   I   Status map for spatial grid.
!       FIELD   R.A.   I   Full field to be propagated.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!
!      MPI_STARTALL, MPI_WAITALL, MPI_TESTALL
!                Subr. mpif.h   MPI persistent comm. routines (!/MPI).
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!     None.
!
!  7. Remarks :
!
!     - The field is put back but not converted !
!     - MPI persistent communication calls initialize in W3MPII.
!     - See W3GATH and W3MPII for additional comments on data
!       buffering.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/SHRD  Switch for message passing method.
!     !/MPI   Id.
!
!     !/S     Enable subroutine tracing.
!     !/MPIT  MPI test output.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3GDATMD, ONLY: NSPEC, NX, NY, NSEA, NSEAL, MAPSF
      USE W3WDATMD, ONLY: A => VA
      USE W3ADATMD, ONLY: MPIBUF, BSTAT, IBFLOC, ISPLOC, BISPL, &
                          NSPLOC, NRQSG2, IRQSG2, SSTORE
      USE W3ODATMD, ONLY: NDST
      USE W3ODATMD, ONLY: IAPROC, NAPROC
!/
      IMPLICIT NONE
!
      INCLUDE "mpif.h"
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: ISPEC, MAPSTA(NY*NX)
      REAL, INTENT(IN)        :: FIELD(1-NY:NY*(NX+2))
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: ISEA, IXY, IOFF, IERR_MPI, J,   &
                                 STATUS(MPI_STATUS_SIZE,NSPEC),  &
                                 JSEA, IB0
      LOGICAL                 :: DONE
!/
!/ ------------------------------------------------------------------- /
!/
!
! 1.  Shared memory version ------------------------------------------ *
!
! 2.  Distributed memory version ( MPI ) ----------------------------- *
! 2.a Initializations
!
! 2.b Convert full grid to sea grid, active points only
!
      DO ISEA=1, NSEA
        IXY    = MAPSF(ISEA,3)
        IF ( MAPSTA(IXY) .GE. 1 ) SSTORE(ISEA,IBFLOC) = FIELD(IXY)
        END DO
!
! 2.c Send spectral densities to appropriate remote
!
      IOFF   = 1 + (ISPLOC-1)*NRQSG2
      IF ( NRQSG2 .GT. 0 ) CALL                                  &
           MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,2), IERR_MPI )
      BSTAT(IBFLOC) = 2
!
! 2.d Save locally stored results
!
      DO JSEA=1, NSEAL
        ISEA   = IAPROC+(JSEA-1)*NAPROC
        IXY    = MAPSF(ISEA,3)
        IF (MAPSTA(IXY) .GE. 1) A(ISPEC,JSEA) = SSTORE(ISEA,IBFLOC)
        END DO
!
! 2.e Check if any sends have finished
!
      IB0    = IBFLOC
!
      DO J=1, MPIBUF
        IB0    = 1 + MOD(IB0,MPIBUF)
        IF ( BSTAT(IB0) .EQ. 2 ) THEN
            IOFF   = 1 + (BISPL(IB0)-1)*NRQSG2
            IF ( NRQSG2 .GT. 0 ) THEN
               CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF,2), DONE,  &
                                 STATUS, IERR_MPI )
              ELSE
                DONE   = .TRUE.
              END IF
            IF ( DONE .AND. NRQSG2.GT.0 ) CALL                   &
                     MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2),       &
                                   STATUS, IERR_MPI )
            IF ( DONE ) THEN
                BSTAT(IB0) = 0
              END IF
          END IF
        END DO
!
! 2.f Last component, finish message passing, reset buffer control
!
      IF ( ISPLOC .EQ. NSPLOC ) THEN
!
          DO IB0=1, MPIBUF
            IF ( BSTAT(IB0) .EQ. 2 ) THEN
                IOFF   = 1 + (BISPL(IB0)-1)*NRQSG2
                IF ( NRQSG2 .GT. 0 ) CALL                        &
                     MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2),       &
                                   STATUS, IERR_MPI )
                BSTAT(IB0) = 0
              END IF
            END DO
!
          ISPLOC = 0
          IBFLOC = 0
!
        END IF
!
! 2.g Test output
!
      RETURN
!
! Formats
!
!/
!/ End of W3SCAT ----------------------------------------------------- /
!/
      END SUBROUTINE W3SCAT
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3NMIN ( MAPSTA, FLAG0 )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           <NAME>            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         28-Dec-2004 |
!/                  +-----------------------------------+
!/
!/    23-Feb-2001 : Origination.                        ( version 2.07 )
!/    28-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/
!  1. Purpose :
!
!     Check minimum number of active sea points at given processor to
!     evaluate the need for a MPI_BARRIER call.
!
!  2. Method :
!
!     Evaluate mapsta.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       MAPSTA  I.A.   I   Status map for spatial grid.
!       FLAG0   log.   O   Flag to identify 0 as minimum.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3SERVMD Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3WAVE    Subr. W3WAVEMD Actual wave model routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!     None.
!
!  7. Remarks :
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/S     Enable subroutine tracing.
!     !/T     Test output.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF
      USE W3ODATMD, ONLY: NDST, NAPROC
!/
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: MAPSTA(NY*NX)
      LOGICAL, INTENT(OUT)    :: FLAG0
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: NMIN, IPROC, NLOC, ISEA, IXY
!/
!/ ------------------------------------------------------------------- /
!/
!
      NMIN   = NSEA
!
      DO IPROC=1, NAPROC
        NLOC   = 0
        DO ISEA=IPROC, NSEA, NAPROC
          IXY    = MAPSF(ISEA,3)
          IF ( MAPSTA(IXY) .EQ. 1 ) NLOC = NLOC + 1
          END DO
        NMIN   = MIN ( NMIN , NLOC )
        END DO
!
      FLAG0  = NMIN .EQ. 0
!
      RETURN
!
! Formats
!
!/
!/ End of W3NMIN ----------------------------------------------------- /
!/
      END SUBROUTINE W3NMIN
!/
!/ End of module W3WAVEMD -------------------------------------------- /
!/
      END MODULE W3WAVEMD
