#include "w3macros.h"
!/ ------------------------------------------------------------------- /
      MODULE WMUPDTMD
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         20-Jan-2017 |
!/                  +-----------------------------------+
!/
!/    22-Feb-2005 : Origination.                        ( version 3.07 )
!/    14-Oct-2006 : Adding separate input grids.        ( version 3.10 )
!/    10-Dec-2006 : Bug fix WMUPD2 initial fields.      ( version 3.10 )
!/    12-Jan-2007 : General clean-up and bug fixes.     ( version 3.10 )
!/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
!/                  specify index closure for a grid.   ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    20-Jan-2017 : Enable using input from coupler     ( version 6.02 )
!/                  (T. J. Campbell, NRL)
!/
!/    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 :
!
!     Update model input at the driver level of the multi-grid
!     version of WAVEWATCH III.
!
!  2. Variables and types :
!
!  3. Subroutines and functions :
!
!      Name      Type  Scope    Description
!     ----------------------------------------------------------------
!      WMUPDT    Subr. Public   Updating of all model inputs.
!      WMUPD1    Subr. Public   Native inputs.
!      WMUPD2    Subr. Public   From input grids.
!      WMUPDV    Subr. Public   For WMUPD2 vector fields.
!      WMUPDS    Subr. Public   For WMUPD2 scalar fields.
!     ----------------------------------------------------------------
!
!  4. Subroutines and functions used :
!
!     See subroutine documentation.
!
!  5. Remarks :
!
!  6. Switches :
!
!       !/CRX0   Current vector component conservation.
!       !/CRX1   Current speed conservation.
!       !/CRX2   Current exenrgy conservation.
!
!       !/WNX0   Wind vector component conservation.
!       !/WNX1   Wind speed conservation.
!       !/WNX2   Wind exenrgy conservation.
!
!       !/S     Enable subroutine tracing.
!       !/T     Enable test output
!       !/T1    Test output interpolation data.
!
!  7. Source code :
!
!/ ------------------------------------------------------------------- /
      PUBLIC
!/
      INTEGER, PARAMETER      :: SWPMAX = 5
!/
      CONTAINS
!/ ------------------------------------------------------------------- /
      SUBROUTINE WMUPDT ( IMOD ,TDATA )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         20-Jan-2017 |
!/                  +-----------------------------------+
!/
!/    22-Feb-2005 : Origination.                        ( version 3.07 )
!/    14-Oct-2006 : Adding separate input grids.        ( version 3.10 )
!/    12-Jan-2007 : General clean-up and bug fixes.     ( version 3.10 )
!/    20-Jan-2017 : Enable using input from coupler     ( version 6.02 )
!/                  (T. J. Campbell, NRL)
!/
!  1. Purpose :
!
!     Update inputs for seleceted wave model grid.
!
!  2. Method :
!
!     Reading from native grid files if update is needed based on
!     time of data.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number,
!       TDATA   I.A.   I   Time for which all is data available.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3SETG    Subr. W3GDATMD Point to grid/model.
!      W3SETW    Subr. W3WDATMD Point to grid/model.
!      W3SETI    Subr. W3IDATMD Point to grid/model.
!      WMSETM    Subr. WMMDATMD Point to grid/model.
!      STRACE    Subr. W3ERVMD  Subroutine tracing.
!      EXTCDE    Subr.   Id.    Program abort.
!      DSEC21    Func. W3TIMEMD Time difference.
!      STME21    Subr.   Id.    Write time string.
!      TICK21    Subr.   Id.    Advancing time.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WMWAVE    Subr. WMWAVEMD Multi-grid model main routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!  7. Remarks :
!
!     - IDFLDS dimensioning is hardwired as IDFLDS(-7:7) where  
!       lowest possible value of JFIRST is JFIRST=-7
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/S     Enable subroutine tracing.
!       !/T     Enable test output
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3GDATMD, ONLY: W3SETG
      USE W3WDATMD, ONLY: W3SETW
      USE W3IDATMD, ONLY: W3SETI
      USE WMMDATMD, ONLY: WMSETM
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
      USE W3TIMEMD, ONLY: DSEC21, STME21, TICK21
!/
      USE W3GDATMD, ONLY: NX, NY, FILEXT
      USE W3WDATMD, ONLY: TIME

      USE W3IDATMD, ONLY: INFLAGS1, TLN, TC0, TCN, TW0, TWN, TIN, T0N,   &
                          T1N, T2N, TG0, TGN, TFN, TDN, TTN, TVN,     &
                          TZN, TI1, TI2, TI3, TI4, TI5, JFIRST

      USE WMMDATMD, ONLY: IMPROC, MDSO, MDSS, MDST, MDSE, NMPSCR,     &
                          NMPERR, ETIME, FLLSTL, FLLSTI, INPMAP,      &
                          IDINP, IFLSTI, IFLSTL
!/
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD
      INTEGER, INTENT(INOUT)  :: TDATA(2)
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: MDSEN, J, DTIME(2), IERR, NDTNEW, JJ
!/S      INTEGER, SAVE           :: IENT = 0
      REAL                    :: DTTST
      LOGICAL                 :: FIRST
      CHARACTER(LEN=13)       :: IDFLDS(-7:8)
      CHARACTER(LEN=23)       :: DTME21
!
      DATA IDFLDS / 'ice param. 1 ' , 'ice param. 2 ' ,               &
                    'ice param. 3 ' , 'ice param. 4 ' ,               &
                    'ice param. 5 ' ,                                 &
                    'mud density  ' , 'mud thkness  ' ,               &
                    'mud viscos.  ' ,                                 &
                    'water levels ' , 'currents     ' ,               &
                    'winds        ' , 'ice fields   ' ,               &
                    'mean param.  ' , '1D spectra   ' ,               &
                    '2D spectra   ' , 'grid speed   ' /
!/
!/ ------------------------------------------------------------------- /
! 0.  Initialization
! 0.a Subroutine tracing and echo of input
!
!/S      CALL STRACE (IENT, 'WMUPDT')
!/T      WRITE (MDST,9000) IMOD, TDATA
!
      IF ( IMPROC .EQ. NMPERR ) THEN
          MDSEN  = MDSE
        ELSE
          MDSEN  = -1
        END IF
!
! 0.b Point to proper grids and initialize
!
      CALL W3SETG ( IMOD, MDSE, MDST )
      CALL W3SETW ( IMOD, MDSE, MDST )
      CALL W3SETI ( IMOD, MDSE, MDST )
      CALL WMSETM ( IMOD, MDSE, MDST )
!
      FLLSTL = .FALSE.
      FLLSTI = .FALSE.
      IERR   = 0
!
! 0.c Output
!
      IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN
          CALL STME21 ( TIME , DTME21 )
          WRITE (MDSS,900) IMOD, DTME21
        END IF
!
!/T      WRITE (MDST,9001) ' J', '0-N', TIME, ETIME
!/T      IF (LBOUND(IDINP,2).LE.-7) WRITE (MDST,9002) -7, IDINP(IMOD,-7), INFLAGS1(-7), TI1
!/T      IF (LBOUND(IDINP,2).LE.-6) WRITE (MDST,9002) -6, IDINP(IMOD,-6), INFLAGS1(-6), TI2
!/T      IF (LBOUND(IDINP,2).LE.-5) WRITE (MDST,9002) -5, IDINP(IMOD,-5), INFLAGS1(-5), TI3
!/T      IF (LBOUND(IDINP,2).LE.-4) WRITE (MDST,9002) -4, IDINP(IMOD,-4), INFLAGS1(-4), TI4
!/T      IF (LBOUND(IDINP,2).LE.-3) WRITE (MDST,9002) -3, IDINP(IMOD,-3), INFLAGS1(-3), TI5
!/T      IF (LBOUND(IDINP,2).LE.-2) WRITE (MDST,9002) -2, IDINP(IMOD,-2), INFLAGS1(-2), TZN
!/T      IF (LBOUND(IDINP,2).LE.-1) WRITE (MDST,9002) -1, IDINP(IMOD,-1), INFLAGS1(-1), TTN
!/T      IF (LBOUND(IDINP,2).LE. 0) WRITE (MDST,9002)  0, IDINP(IMOD, 0), INFLAGS1( 0), TVN
!/T      WRITE (MDST,9002) 1, IDINP(IMOD,1), INFLAGS1(1), TLN
!/T      WRITE (MDST,9003) 2, IDINP(IMOD,2), INFLAGS1(2), TC0, TCN
!/T      WRITE (MDST,9003) 3, IDINP(IMOD,3), INFLAGS1(3), TW0, TWN
!/T      WRITE (MDST,9002) 4, IDINP(IMOD,4), INFLAGS1(4), TIN
!/T      WRITE (MDST,9002) 5, IDINP(IMOD,5), INFLAGS1(5), T0N
!/T      WRITE (MDST,9002) 6, IDINP(IMOD,6), INFLAGS1(6), T1N
!/T      WRITE (MDST,9002) 7, IDINP(IMOD,7), INFLAGS1(7), T2N
!/T      WRITE (MDST,9003) 8, 'MOV'        , INFLAGS1(8), TG0, TGN
!/T      WRITE (MDST,9004)    'GRD', NX, NY
!
! 1.  Loop over input types ------------------------------------------ /
!
      DO J=JFIRST, 8
!
! 1.a Check if update needed
!
        IF ( .NOT. INFLAGS1(J) ) CYCLE
!
!/T        WRITE (MDST,9010) J, INFLAGS1(J), INPMAP(IMOD,J)
!
! 1.b Test time
!
        IF ( TFN(1,J) .EQ. -1 ) THEN
            FIRST  = .TRUE.
            DTTST  = 0.
          ELSE
            FIRST  = .FALSE.
            DTTST  = DSEC21 ( TIME , TFN(:,J) )
          END IF
!
!/T        WRITE (MDST,9011) IDINP(IMOD,J), DTTST, TFN(:,J)
!
        IF ( DTTST .GT. 0. ) CYCLE
        IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC )                    &
             WRITE (MDSS,901) IDFLDS(J)
!
! 2.  Forcing input from file & defined on the native grid ----------- /
!
        IF ( INPMAP(IMOD,J) .EQ. 0 ) THEN
!
!/T            WRITE (MDST,9020)
!
            CALL WMUPD1 ( IMOD, IDINP(IMOD,J), J, IERR )
!
! 3.  Forcing input from file & defined on an input grid ------------- /
!
          ELSE IF ( INPMAP(IMOD,J) .GT. 0 ) THEN
!
!/T            WRITE (MDST,9030) INPMAP(IMOD,J)
!
! 3.a Check if input grid is available
!
            JJ     = -INPMAP(IMOD,J)
            CALL W3SETG ( JJ, MDSE, MDST )
            CALL W3SETI ( JJ, MDSE, MDST )
!
            IF ( TFN(1,J) .EQ. -1 ) THEN
                DTTST  = 0.
              ELSE
                IF ( FIRST .OR. ( J.EQ.1 .AND. IFLSTL(-JJ) )          &
                           .OR. ( J.EQ.4 .AND. IFLSTI(-JJ) ) ) THEN
                    DTTST  = 1.
                  ELSE
                    DTTST  = DSEC21 ( TIME , TFN(:,J) )
                  END IF
              END IF
!
            IF ( J .EQ. 1 ) FLLSTL = IFLSTL(-JJ)
            IF ( J .EQ. 4 ) FLLSTI = IFLSTI(-JJ)
!
!/T            WRITE (MDST,9031) J, IDINP(JJ,J), DTTST, TFN(:,J)
!
! 3.b If needed, update input grid
!     Note: flags in WMMDATMD set for grid IMOD !
!
            IF ( DTTST .LE. 0. ) THEN
!
                IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC )            &
                     WRITE (MDSS,930) FILEXT
!
                CALL WMUPD1 ( JJ, IDINP(JJ,J), J, IERR )
!
                IF ( J .EQ. 1 ) IFLSTL(-JJ) = FLLSTL
                IF ( J .EQ. 4 ) IFLSTI(-JJ) = FLLSTI
!
              END IF
!
! 3.c Set up for update, and call updating routine
!
            CALL W3SETG ( IMOD, MDSE, MDST )
            CALL W3SETI ( IMOD, MDSE, MDST )
!
            CALL WMUPD2 ( IMOD, J, JJ, IERR )
!
! 4.  Forcing input from CPL ----------------------------------------- /
!
          ELSE ! INPMAP(IMOD,J) .LT. 0
          ! Data input and time stamp settings for forcing input from
          ! CPL are handled in wmesmfmd.ftn:GetImport
!
!/T            IF ( INPMAP(IMOD,J) .EQ. -999 ) THEN
!/T              ! *** Forcing input from CPL & defined on native grid ***
!/T                WRITE (MDST,9040)
!/T              ELSE
!/T              ! *** Forcing input from CPL & defined on an input grid ***
!/T                WRITE (MDST,9050) -INPMAP(IMOD,J)
!/T              END IF
!
          END IF
!
! 5.  Finalize for each type ----------------------------------------- /
! 5.a Process IERR output
!
        IF ( IERR.GT.0 ) GOTO 2000
        IF ( IERR.LT.0 .AND. MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC )    &
             WRITE (MDSS,950) IDFLDS(J)
!
! 5.b End of master loop
!
        END DO
!
! 6.  Compute TDATA -------------------------------------------------- /
!
      TDATA  = ETIME
!
      DO J=JFIRST, 8
        IF ( .NOT. INFLAGS1(J) ) CYCLE
        DTTST  = DSEC21 ( TFN(:,J) , TDATA )
        IF ( DTTST.GT.0. .AND. .NOT.  ( (FLLSTL .AND. J.EQ.1) .OR.    &
                                        (FLLSTI .AND. J.EQ.4) ) ) THEN
            TDATA  = TFN(:,J)
          END IF
        END DO
!
! 6.  Compute TDN ---------------------------------------------------- /
!
      TDN    = TDATA
      CALL TICK21 ( TDN, 1. )
      DO J=5, 7
        IF ( INFLAGS1(J) ) THEN
            DTTST  = DSEC21 ( TFN(:,J) , TDN )
            IF ( DTTST.GT.0. ) TDN = TFN(:,J)
          END IF
        END DO
!
! 7.  Final test output ---------------------------------------------- /
!
!/T      WRITE (MDST,9070) ' J', '0-N', TIME, ETIME, TDATA
!/T      IF (LBOUND(IDINP,2).LE.-7) WRITE (MDST,9071) -7, IDINP(IMOD,-7), INFLAGS1(-7), TI1
!/T      IF (LBOUND(IDINP,2).LE.-6) WRITE (MDST,9071) -6, IDINP(IMOD,-6), INFLAGS1(-6), TI2
!/T      IF (LBOUND(IDINP,2).LE.-5) WRITE (MDST,9071) -5, IDINP(IMOD,-5), INFLAGS1(-5), TI3
!/T      IF (LBOUND(IDINP,2).LE.-4) WRITE (MDST,9071) -4, IDINP(IMOD,-4), INFLAGS1(-4), TI4
!/T      IF (LBOUND(IDINP,2).LE.-3) WRITE (MDST,9071) -3, IDINP(IMOD,-3), INFLAGS1(-3), TI5
!/T      IF (LBOUND(IDINP,2).LE.-2) WRITE (MDST,9071) -2, IDINP(IMOD,-2), INFLAGS1(-2), TZN
!/T      IF (LBOUND(IDINP,2).LE.-1) WRITE (MDST,9071) -1, IDINP(IMOD,-1), INFLAGS1(-1), TTN
!/T      IF (LBOUND(IDINP,2).LE. 0) WRITE (MDST,9071)  0, IDINP(IMOD, 0), INFLAGS1( 0), TVN
!/T      WRITE (MDST,9071) 1, IDINP(IMOD,1), INFLAGS1(1), TLN
!/T      WRITE (MDST,9072) 2, IDINP(IMOD,2), INFLAGS1(2), TC0, TCN
!/T      WRITE (MDST,9072) 3, IDINP(IMOD,3), INFLAGS1(3), TW0, TWN
!/T      WRITE (MDST,9071) 4, IDINP(IMOD,4), INFLAGS1(4), TIN
!/T      WRITE (MDST,9071) 5, IDINP(IMOD,5), INFLAGS1(5), T0N
!/T      WRITE (MDST,9071) 6, IDINP(IMOD,6), INFLAGS1(6), T1N
!/T      WRITE (MDST,9073) 7, IDINP(IMOD,7), INFLAGS1(7), T2N, TDN
!/T      WRITE (MDST,9072) 8, 'MOV'        , INFLAGS1(8), TG0, TGN
!
      RETURN
!       
! Error escape locations
!
 2000 CONTINUE
      CALL EXTCDE ( 2000 )
      RETURN
!
! Formats
!
  900 FORMAT ( '  Updating input for grid',I3,' at ',A)
  901 FORMAT ( '     Updating ',A)
  930 FORMAT ( '        First updating ',A)
  950 FORMAT ( '        Past last ',A)
!
!/T 9000 FORMAT ( ' TEST WMUPDT : INPUT : ',I4,I10.8,I7.6,            &
!/T               '  <============================')
!/T 9001 FORMAT ( ' TEST WMUPDT : ',A2,1X,A3,3X,    2(I10.8,I7.6))
!/T 9002 FORMAT ( '               ',I2,1X,A3,L3,17X,1(I10.8,I7.6))
!/T 9003 FORMAT ( '               ',I2,1X,A3,L3,    2(I10.8,I7.6))
!/T 9004 FORMAT ( '               ',2X,1X,A3,3X,2I10             )
!/T 9010 FORMAT ( ' TEST WMUPDT : J, FLAG, INPMAP : ',I2,L2,I4)
!/T 9011 FORMAT ( ' TEST WMUPDT : ',A,', DTTST = ',E10.3,2X,I9.8,I7.6)
!/T 9020 FORMAT ( ' TEST WMUPDT : FORCING INPUT FROM FILE & DEFINED ON THE NATIVE GRID')
!/T 9030 FORMAT ( ' TEST WMUPDT : FORCING INPUT FROM FILE & DEFINED ON INPUT GRID',I4)
!/T 9031 FORMAT ( ' TEST WMUPDT : J =',I4,3XA,', DTTST = ',           &
!/T                               E10.3,2X,I9.8,I7.6)
!/T 9040 FORMAT ( ' TEST WMUPDT : FORCING INPUT FROM CPL & DEFINED ON THE NATIVE GRID')
!/T 9050 FORMAT ( ' TEST WMUPDT : FORCING INPUT FROM CPL & DEFINED ON INPUT GRID',I4)
!/T 9070 FORMAT ( ' TEST WMUPDT : ',A2,1X,A3,3X,    3(I10.8,I7.6))
!/T 9071 FORMAT ( '               ',I2,1X,A3,L3,17X,1(I10.8,I7.6))
!/T 9072 FORMAT ( '               ',I2,1X,A3,L3,    2(I10.8,I7.6))
!/T 9073 FORMAT ( '               ',I2,1X,A3,L3,17X,2(I10.8,I7.6))
!/
!/ End of WMUPDT ----------------------------------------------------- /
!/
      END SUBROUTINE WMUPDT
!/ ------------------------------------------------------------------- /
      SUBROUTINE WMUPD1 ( IMOD, IDSTR, J, IERR )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         07-Oct-2006 |
!/                  +-----------------------------------+
!/
!/    07-Oct-2006 : Origination.                        ( version 3.10 )
!/
!  1. Purpose :
!
!     Update selected input using native input files.
!
!  2. Method :
!
!     Reading from native grid files.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number,
!       IDSTR   C*3    I   ID string corresponding to J.
!       J       Int.   I   Input type.
!       IERR    Int.   O   Error indicator.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WMDIMD    Subr. WMMDATMD Set dimension of data grids.
!      W3FLDG    Subr. W3FLDSMD Get input field.
!      W3FLDD    Subr.   Id.    Get input data.
!      W3FLDM    Subr.   Id.    Get grid speed data.
!      STRACE    Subr. W3ERVMD  Subroutine tracing.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WMUPDT    Subr. WMUPDTMD Master inpu update routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!  7. Remarks :
!
!     - Pointers set in calling routine.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/S     Enable subroutine tracing.
!       !/T     Enable test output
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE WMMDATMD, ONLY: WMDIMD
      USE W3FLDSMD, ONLY: W3FLDG, W3FLDD, W3FLDM
!/S      USE W3SERVMD, ONLY: STRACE
!/
      USE W3GDATMD, ONLY: NX, NY
      USE W3WDATMD, ONLY: TIME
      USE W3IDATMD, ONLY: TLN, WLEV, TC0, TCN, CX0, CXN, CY0, CYN,    &
                          TW0, TWN, WX0, WXN, WY0, WYN, DT0, DTN,     &
                          TIN, ICEI, T0N, T1N, T2N, TDN, INFLAGS1,       &
                          TG0, TGN, GA0, GD0, GAN, GDN, BERGI,        &
                          TTN, MUDT, TVN, MUDV, TZN, MUDD,            &
                          TI1, TI2, TI3, TI4, TI5,                    &
                          ICEP1, ICEP2,ICEP3, ICEP4, ICEP5
      USE WMMDATMD, ONLY: IMPROC, NMPERR, MDST, MDSE, MDSF, ETIME,    &
                          FLLSTL, FLLSTI, RCLD, NDT, DATA0, DATA1,    &
                          DATA2, NMV, NMVMAX, TMV, AMV, DMV
!/
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)          :: IMOD, J
      INTEGER, INTENT(OUT)         :: IERR
      CHARACTER(LEN=3), INTENT(IN) :: IDSTR
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: MDSEN, DTIME(2), NDTNEW
      REAL                    :: XXX(NY,NX)
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
! 0.  Initialization
! 0.a Subroutine tracing and echo of input
!
!/S      CALL STRACE (IENT, 'WMUPD1')
!/T      WRITE (MDST,9000) IMOD, J
!
      IF ( IMPROC .EQ. NMPERR ) THEN
          MDSEN  = MDSE
        ELSE
          MDSEN  = -1
        END IF
!
! 0.b Start case selection
!
      SELECT CASE (J)
!
! -7.  Ice parameter 1 ---------------------------------------------- /
!
        CASE (-7)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, IERR)
!
! -6.  Ice parameter 2 ---------------------------------------------- /
!
        CASE (-6)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TI2, XXX, XXX, ICEP2, IERR)
!
! -5.  Ice parameter 3 ---------------------------------------------- /
!
        CASE (-5)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TI3, XXX, XXX, ICEP3, IERR)
!
! -4.  Ice parameter 4 ---------------------------------------------- /
!
        CASE (-4)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TI4, XXX, XXX, ICEP4, IERR)
!
! -3.  Ice parameter 5 ---------------------------------------------- /
!
        CASE (-3)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, IERR)
!
! -2.  Mud Density -------------------------------------------------- /
!
        CASE (-2)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TZN, XXX, XXX, MUDD, IERR)
!
! -1.  Mud Thickness -------------------------------------------------- /
!
        CASE (-1)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TTN, XXX, XXX, MUDT, IERR)
!
! 0.  Mud Viscosity -------------------------------------------------- /
!
        CASE (0)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TVN, XXX, XXX, MUDV, IERR)
!
! 1.  Water levels --------------------------------------------------- /
!
        CASE (1)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TLN, XXX, XXX, WLEV, IERR)
          IF ( IERR .LT. 0 ) FLLSTL = .TRUE.
!
! 2.  Currents ------------------------------------------------------- /
!
        CASE (2)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, TC0,              &
                       CX0, CY0, XXX, TCN, CXN, CYN, XXX, IERR)
!
! 3.  Winds ---------------------------------------------------------- /
!
        CASE (3)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, TW0,              &
                       WX0, WY0, DT0, TWN, WXN, WYN, DTN, IERR)
!
! 4.  Ice ------------------------------------------------------------ /
!
        CASE (4)
          CALL W3FLDG ('READ', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                       NX, NY, NX, NY, TIME, ETIME, DTIME,            &
                       XXX, XXX, XXX, TIN, XXX , BERGI, ICEI, IERR)
          IF ( IERR .LT. 0 ) FLLSTI = .TRUE.
!
! 5.  Data type 0 ---------------------------------------------------- /
!
        CASE (5)
          CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                        TIME, T0N, RCLD(1), NDT(1), NDTNEW,           &
                        DATA0, IERR )
          IF ( IERR .LT. 0 ) THEN
              INFLAGS1(J) = .FALSE.
              RCLD(1)  = 1
              NDT(1)   = 1
              CALL WMDIMD ( IMOD, MDSE, MDST, 1 )
            ELSE
              NDT(J) = NDTNEW
              CALL WMDIMD ( IMOD, MDSE, MDST, 1 )
              CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST,         &
                            MDSEN, TIME, T0N, RCLD(1), NDT(1),        &
                            NDTNEW, DATA0, IERR )
            END IF
!
! 6.  Data type 1 ---------------------------------------------------- /
!
        CASE ( 6 )
          CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                        TIME, T1N, RCLD(2), NDT(2), NDTNEW,           &
                        DATA1, IERR )
          IF ( IERR .LT. 0 ) THEN
              INFLAGS1(J) = .FALSE.
              RCLD(2)  = 1
              NDT(2)   = 1
              CALL WMDIMD ( IMOD, MDSE, MDST, 2 )
            ELSE
              NDT(J) = NDTNEW
              CALL WMDIMD ( IMOD, MDSE, MDST, 2 )
              CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST,         &
                           MDSEN, TIME, T1N, RCLD(2), NDT(2),         &
                           NDTNEW, DATA1, IERR )
            END IF
!
! 7.  Data type 2 ---------------------------------------------------- /
!
        CASE ( 7 )
          CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST, MDSEN,      &
                        TIME, T2N, RCLD(3), NDT(3), NDTNEW,           &
                        DATA2, IERR )
          IF ( IERR .LT. 0 ) THEN
              INFLAGS1(J) = .FALSE.
              RCLD(3)  = 1
              NDT(3)   = 1
              CALL WMDIMD ( IMOD, MDSE, MDST, 3 )
            ELSE
              NDT(J) = NDTNEW
              CALL WMDIMD ( IMOD, MDSE, MDST, 3 )
              CALL W3FLDD ('SIZE', IDSTR, MDSF(IMOD,J), MDST,         &
                           MDSEN, TIME, T2N, RCLD(3), NDT(3),         &
                           NDTNEW, DATA2, IERR )
            END IF
!
! 8. Moving grid data ----------------------------------------------- /
!
        CASE ( 8 )
! notes: 
! SUBROUTINE W3FLDM in w3fldsmd.ftn : 
!<       INTEGER, INTENT(INOUT)  :: NH, THO(2,4,NHM), TF0(2), TFN(2)
!>       INTEGER, INTENT(INOUT)  :: NH, THO(2,-7:4,NHM), TF0(2), TFN(2)
!<       REAL, INTENT(INOUT)     :: HA(NHM,4), HD(NHM,4), A0, AN, D0, DN
!>       REAL, INTENT(INOUT)     :: HA(NHM,-7:4), HD(NHM,-7:4), A0, AN, D0, DN
! Arguments #
!   THO     8
!   HA      9
!   HD     10
! Here, that is TMV AMV DMV
          CALL W3FLDM ( 4, MDST, MDSEN, TIME, ETIME, NMV, NMVMAX, TMV,&
                        AMV, DMV, TG0, GA0, GD0, TGN, GAN, GDN, IERR )
!
      END SELECT
!
! 9. End of routine -------------------------------------------------- /
!
      RETURN
!
! Formats
!
!/T 9000 FORMAT ( ' TEST WMUPD1 : INPUT : ',2I4)
!/
!/ End of WMUPD1 ----------------------------------------------------- /
!/
      END SUBROUTINE WMUPD1
!/ ------------------------------------------------------------------- /
      SUBROUTINE WMUPD2 ( IMOD, J, JMOD, IERR )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         10-Dec-2006 |
!/                  +-----------------------------------+
!/
!/    14-Oct-2006 : Origination.                        ( version 3.10 )
!/    10-Dec-2006 : Bug fix WMUPD2 initial fields.      ( version 3.10 )
!/
!  1. Purpose :
!
!     Update selected input using input grids.
!
!  2. Method :
!
!     Managing data, interpolation done inother routines.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Model number,
!       J       Int.   I   Input type.
!       JMOD    Int.   I   Model number source grid.
!       IERR    Int.   O   Error indicator.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3ERVMD  Subroutine tracing.
!      EXTCDE    Subr.   Id.    Program abort.
!      WMUPDV    Subr.  local   Interpolation of vector fields.
!      WMUPDS    Subr.  local   Interpolation of scalar fields.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WMUPDT    Subr. WMUPDTMD Master input update routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!  7. Remarks :
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/CRX0   Current vector component conservation.
!       !/CRX1   Current speed conservation.
!       !/CRX2   Current exenrgy conservation.
!
!       !/WNX0   Wind vector component conservation.
!
!       !/S     Enable subroutine tracing.
!       !/T     Enable test output
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!/
      USE W3WDATMD, ONLY: TIME
      USE W3IDATMD, ONLY: INPUTS
      USE WMMDATMD, ONLY: IMPROC, NMPERR, NMPSCR, MDST, MDSE, MDSS,   &
                          MDSO, ETIME, IDINP
!/
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, J, JMOD
      INTEGER, INTENT(OUT)    :: IERR
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: ICONSC, ICONSW
!/S      INTEGER, SAVE           :: IENT = 0
!/
!/ ------------------------------------------------------------------- /
! 0.  Initialization
! 0.a Subroutine tracing and echo of input
!
!/S      CALL STRACE (IENT, 'WMUPD2')
!
!/T      WRITE (MDST,9000) IMOD, J, JMOD
!/T      WRITE (MDST,9001) INPUTS(IMOD)%TFN(:,J),                     &
!/T                        INPUTS(JMOD)%TFN(:,J), ETIME
!
      IERR = 0
!/CRX0      ICONSC = 0
!/CRX1      ICONSC = 1
!/CRX2      ICONSC = 2
!/WNX0      ICONSW = 0
!/WNX1      ICONSW = 1
!/WNX2      ICONSW = 2
!
! 1. Shift fields ( currents and winds only ) ------------------------ /
!
      SELECT CASE (J)
!
! 1.a Currents
!
        CASE (2)
          IF ( INPUTS(IMOD)%TFN(1,J) .GT. 0 ) THEN
              INPUTS(IMOD)%TC0(:) = INPUTS(IMOD)%TFN(:,J)
              INPUTS(IMOD)%CX0    = INPUTS(IMOD)%CXN
              INPUTS(IMOD)%CY0    = INPUTS(IMOD)%CYN
!/T              WRITE (MDST,9010) J, INPUTS(IMOD)%TFN(:,J)
!/T            ELSE
!/T              WRITE (MDST,9011) J
            END IF
!
! 1.b Winds
!
        CASE (3)
          IF ( INPUTS(IMOD)%TFN(1,J) .GT. 0 ) THEN
              INPUTS(IMOD)%TW0(:) = INPUTS(IMOD)%TFN(:,J)
              INPUTS(IMOD)%WX0    = INPUTS(IMOD)%WXN
              INPUTS(IMOD)%WY0    = INPUTS(IMOD)%WYN
              INPUTS(IMOD)%DT0    = INPUTS(IMOD)%DTN
!/T              WRITE (MDST,9010) J, INPUTS(IMOD)%TFN(:,J)
!/T            ELSE
!/T              WRITE (MDST,9011) J
            END IF
!
      END SELECT
!
! 2. Process fields at ending time ----------------------------------- /
!
!/T      WRITE (MDST,9020) J, INPUTS(JMOD)%TFN(:,J)
      INPUTS(IMOD)%TFN(:,J) = INPUTS(JMOD)%TFN(:,J)
!
      SELECT CASE (J)
!
! 2.a-3 Ice parameter 1
!
        CASE (-7)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP1,                      &
                        JMOD, INPUTS(JMOD)%ICEP1, 0. )
!
! 2.a-3 Ice parameter 2
!
        CASE (-6)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP2,                      &
                        JMOD, INPUTS(JMOD)%ICEP2, 0. )
!
! 2.a-3 Ice parameter 3
!
        CASE (-5)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP3,                      &
                        JMOD, INPUTS(JMOD)%ICEP3, 0. )
!
! 2.a-3 Ice parameter 4
!
        CASE (-4)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP4,                      &
                        JMOD, INPUTS(JMOD)%ICEP4, 0. )
!
! 2.a-3 Ice parameter 5
!
        CASE (-3)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEP5,                      &
                        JMOD, INPUTS(JMOD)%ICEP5, 0. )
!
! 2.a-2 Mud densities
!
        CASE (-2)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%MUDD,                      &
                        JMOD, INPUTS(JMOD)%MUDD, 0. )
!
! 2.a-1 Mud viscosities
!
        CASE (-1)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%MUDT,                      &
                        JMOD, INPUTS(JMOD)%MUDT, 0. )
!
! 2.a-0 Mud thicknesses
!
        CASE (0)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%MUDV,                      &
                        JMOD, INPUTS(JMOD)%MUDV, 0. )
!
! 2.a Water levels
!
        CASE (1)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%WLEV,                      &
                        JMOD, INPUTS(JMOD)%WLEV, 0. )
!
! 2.b Curents
!
        CASE (2)
          CALL WMUPDV ( IMOD, INPUTS(IMOD)%CXN, INPUTS(IMOD)%CYN,     &
                        JMOD, INPUTS(JMOD)%CXN, INPUTS(JMOD)%CYN,     &
                        0., ICONSC )
!
! 2.c Wind speeds
!
        CASE (3)
          CALL WMUPDV ( IMOD, INPUTS(IMOD)%WXN, INPUTS(IMOD)%WYN,     &
                        JMOD, INPUTS(JMOD)%WXN, INPUTS(JMOD)%WYN,     &
                        0., ICONSW )
          IF ( IDINP(IMOD,J) .EQ. 'WNS' ) CALL WMUPDS                 &
                      ( IMOD, INPUTS(IMOD)%DTN,                       &
                        JMOD, INPUTS(JMOD)%DTN, 0. )
!
! 2.d Ice concentrations
!
        CASE (4)
          CALL WMUPDS ( IMOD, INPUTS(IMOD)%ICEI,                      &
                        JMOD, INPUTS(JMOD)%ICEI, 0. )
          IF ( IDINP(IMOD,J) .EQ. 'ISI' ) CALL WMUPDS                 &
                      ( IMOD, INPUTS(IMOD)%BERGI,                     &
                        JMOD, INPUTS(JMOD)%BERGI, 0. )
!
! 2.e Assimilation data 0
!
        CASE (5)
          GOTO 2999
!
! 2.f Assimilation data 1
!
        CASE (6)
          GOTO 2999
!
! 2.g Assimilation data 2
!
        CASE (7)
          GOTO 2999
!
      END SELECT
!
! 3. Check and update first fields ( currents and winds only ) ------- /
!
      SELECT CASE (J)
!
! 3.a Currents
!
        CASE (2)
          IF ( INPUTS(IMOD)%TC0(1) .LT. 0 ) THEN
              INPUTS(IMOD)%TC0(:) = INPUTS(JMOD)%TC0(:)
!/T              WRITE (MDST,9030) J, INPUTS(IMOD)%TC0(:)
!/CRX0              ICONSC = 0
!/CRX1              ICONSC = 1
!/CRX2              ICONSC = 2
              CALL WMUPDV ( IMOD, INPUTS(IMOD)%CX0, INPUTS(IMOD)%CY0, &
                            JMOD, INPUTS(JMOD)%CX0, INPUTS(JMOD)%CY0, &
                            0., ICONSC )
            END IF
!
! 3.b Winds
!
        CASE (3)
          IF ( INPUTS(IMOD)%TW0(1) .LT. 0 ) THEN
              INPUTS(IMOD)%TW0(:) = INPUTS(JMOD)%TW0(:)
!/T              WRITE (MDST,9030) J, INPUTS(IMOD)%TW0(:)
!/WNX0              ICONSW = 0
!/WNX1              ICONSW = 1
!/WNX2              ICONSW = 2
              CALL WMUPDV ( IMOD, INPUTS(IMOD)%WX0, INPUTS(IMOD)%WY0, &
                            JMOD, INPUTS(JMOD)%WX0, INPUTS(JMOD)%WY0, &
                            0., ICONSW )
              IF ( IDINP(IMOD,J) .EQ. 'WNS' ) CALL WMUPDS             &
                          ( IMOD, INPUTS(IMOD)%DT0,                   &
                            JMOD, INPUTS(JMOD)%DT0, 0. )
            END IF
!
      END SELECT
!
! 4. End of routine -------------------------------------------------- /
!
      RETURN
!       
! Error escape locations
!
 2999 CONTINUE
      IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSE,1999)
      CALL EXTCDE ( 2999 )
      RETURN
!
! Formats
!
 1999 FORMAT (/' *** ERROR WMUPD2: OPTION NOT YET IMPLEMENTED ***'/)
!
!/T 9000 FORMAT ( ' TEST WMUPD2 : INPUT : ',3I4)
!/T 9001 FORMAT ( ' TEST WMUPD2 : TIME OF IMOD : ',I9.8,1X,I6.6/      &
!/T               '               TIME OF JMOD : ',I9.8,1X,I6.6/      &
!/T               '               ENDING TIME  : ',I9.8,1X,I6.6)
!/T 9010 FORMAT ( ' TEST WMUPD2 : SHIFTING ',I1,' TIME = ',I8.8,I7.6)
!/T 9011 FORMAT ( ' TEST WMUPD2 : NO DATA FOR ',I1,' TO SHIFT')
!/T 9020 FORMAT ( ' TEST WMUPD2 : PROCESSING ',I1,' TIME = ',I8.8,I7.6)
!/T 9030 FORMAT ( ' TEST WMUPD2 : INITIAL FIELD FOR ',I1,             &
!/T               ' TIME = ',I8.8,I7.6)
!/
!/ End of WMUPD2 ----------------------------------------------------- /
!/
      END SUBROUTINE WMUPD2
!/ ------------------------------------------------------------------- /
      SUBROUTINE WMUPDV ( IMOD, VX, VY, JMOD, VXI, VYI, UNDEF, CONSTP )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         06-Dec-2010 |
!/                  +-----------------------------------+
!/
!/    14-Oct-2006 : Origination.                        ( version 3.10 )
!/    12-Jan-2007 : General clean-up and bug fixes.     ( version 3.10 )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
!/                  specify index closure for a grid.   ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/
!  1. Purpose :
!
!     Interpolate vector field from input grid to model grid.
!
!  2. Method :
!
!     Interpolating or averaging from input grid.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Output model number,
!       VX/Y    Int.   O   Output vector field.
!       JMOD    Int.   I   Input model number,
!       VX/YI   Int.   I   Input vector field.
!       UNDEF   Int.   I   Value for mapped out point and points not
!                          covered.
!       CONSTP  Int.   I   Conservation type :
!                           1: Vector speed.
!                           2: Vector speed squared.
!                           *: Vector components.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3ERVMD  Subroutine tracing.
!      EXTCDE    Subr.   Id.    Program abort.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WMUPD2    Subr. WMUPDTMD Input update routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!  7. Remarks :
!
!     - Grid pointers for output grid need to be set externally.
!     - If input grid does not cover point of target grid, taget grid 
!       values are set to UNDEF.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/S     Enable subroutine tracing.
!       !/T     Enable test output
!       !/T1    Test output interpolation data.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!/
      USE W3GDATMD, ONLY: NX, NY, X0, Y0, SX, SY, GRIDS, FLAGLL,      &
                          GTYPE, RLGTYPE, CLGTYPE, UNGTYPE,           &
                          ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL
      USE WMMDATMD, ONLY: IMPROC, NMPERR, NMPSCR, MDST, MDSE, MDSO,   &
                          MDSS
!/
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, JMOD, CONSTP
      REAL, INTENT(OUT)       :: VX(NX,NY), VY(NX,NY)
      REAL, INTENT(IN)        :: VXI(GRIDS(JMOD)%NX,GRIDS(JMOD)%NY),  &
                                 VYI(GRIDS(JMOD)%NX,GRIDS(JMOD)%NY),  &
                                 UNDEF
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: IXO, IYO, IX, IY, IXF0, IXFN, IYF0,  &
                                 IYFN, IXS0, IXSN, IYS0, IYSN, IXS,   &
                                 MXA, MYA, J, J1, J2, IXC, IYC, JJ,   &
                                 JX, JY
!/S      INTEGER, SAVE           :: IENT = 0
      INTEGER, ALLOCATABLE    :: NXA(:,:), NYA(:,:)
      REAL                    :: XR, YR, R1, R2, RT, XFL, XFR, XSL,   &
                                 XSR, YFL, YFR, YSL, YSR
      REAL                    :: VXL, VYL, VA0, VA, VA2, FACTOR,      &
                                 WTOT, WL
      REAL, ALLOCATABLE       :: RXA(:,:), RYA(:,:)
      LOGICAL                 :: MAP1(NX,NY), MAP2(NX,NY),            &
                                 MAP3(NX,NY), FLAGUP
!
      INTEGER, POINTER        :: NXI, NYI, MAP(:,:), MAPI(:,:)
      REAL, POINTER           :: X0I, Y0I, SXI, SYI
      INTEGER, POINTER        :: ICLOSE
!/T1      CHARACTER(LEN=17)       :: FORMAT1
!/
!/ ------------------------------------------------------------------- /
! 0.  Initialization
! 0.a Subroutine tracing and test output
!
!/S      CALL STRACE (IENT, 'WMUPDV')
!

      IF ( GRIDS(IMOD)%GTYPE .EQ. CLGTYPE .OR. &
           GRIDS(JMOD)%GTYPE .EQ. CLGTYPE ) THEN
          WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDV: ', &
          'CURVILINEAR GRID SUPPORT NOT YET IMPLEMENTED ***'
          CALL EXTCDE ( 999 )
      ELSE IF ( GRIDS(IMOD)%GTYPE .EQ. UNGTYPE .OR. &
                GRIDS(JMOD)%GTYPE .EQ. UNGTYPE ) THEN
          WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDV: ', &
          'UNSTRUCTURED GRID SUPPORT NOT YET IMPLEMENTED ***'
          CALL EXTCDE ( 999 )
      END IF
!
      NXI    => GRIDS(JMOD)%NX
      NYI    => GRIDS(JMOD)%NY
      X0I    => GRIDS(JMOD)%X0
      Y0I    => GRIDS(JMOD)%Y0
      SXI    => GRIDS(JMOD)%SX
      SYI    => GRIDS(JMOD)%SY
      MAP    => GRIDS(IMOD)%MAPSTA
      MAPI   => GRIDS(JMOD)%MAPSTA
      ICLOSE => GRIDS(JMOD)%ICLOSE

      IF ( ICLOSE .EQ. ICLOSE_TRPL ) THEN
         IF ( IMPROC.EQ.NMPERR ) WRITE(MDSE,*)'SUBROUTINE WMUPDV IS'// &
         ' NOT YET ADAPTED FOR TRIPOLE GRIDS. STOPPING NOW.'
         CALL EXTCDE ( 1 )
      END IF

!
!/T      WRITE (MDST,9000) IMOD, NX, NY, X0, Y0, SX, SY,              &
!/T                        JMOD, NXI, NYI, X0I, Y0I, SXI, SYI, UNDEF
!
! 0.b Initialize fields
!
      VX     = UNDEF
      VY     = UNDEF
!
! 1. Case of identical resolution and coinciding grids --------------- /
!

      IF ( ABS(SX/SXI-1.) .LT. 1.E-3                         .AND.    &
           ABS(SY/SYI-1.) .LT. 1.E-3                         .AND.    &
           ABS(MOD((ABS(X0-X0I))/SX+0.5,1.)-0.5) .LT. 1.E-2  .AND.    &
           ABS(MOD((ABS(Y0-Y0I))/SY+0.5,1.)-0.5) .LT. 1.E-2 ) THEN
!
! 1.a Offsets
!

          IXO    = NINT((X0-X0I)/SX)
!
          IF ( FLAGLL ) THEN
              IXF0   = 1
              IXFN   = NX
              IXS0   = -999
              IXSN   = -999
            ELSE
              IXF0   = MAX (  1  , 1-IXO )
              IXFN   = MIN ( NX  , NXI-IXO )
              IXS0   = MAX (  1  , 1+IXO )
              IXSN   = IXS0 + IXFN - IXF0
            END IF
!
          IYO    = NINT((Y0-Y0I)/SY)
!
          IYF0   = MAX (  1  , 1-IYO )
          IYFN   = MIN ( NY  , NYI-IYO )
          IYS0   = MAX (  1  , 1+IYO )
          IYSN   = IYS0 + IYFN - IYF0
!
!/T          WRITE (MDST,9010) IXO, IYO, IXF0, IXFN, IYF0, IYFN,      &
!/T                                      IXS0, IXSN, IYS0, IYSN
!
! 1.b Fill arrays for sea points only
!

          DO IX=IXF0, IXFN
            IF ( FLAGLL ) THEN
                IXS    = 1 + NINT ( MOD (                             &
                  1080.+X0+(REAL(IX)-0.5)*SX-X0I , 360. ) / SX - 0.5 )
                IF ( IXS .GT. NXI ) CYCLE
              ELSE
                IXS    = IX + IXO
              END IF
            VX(IX,IYF0:IYFN) = VXI(IXS,IYS0:IYSN)
            VY(IX,IYF0:IYFN) = VYI(IXS,IYS0:IYSN)
            END DO
!
! 1.c Return to calling routine
!
          RETURN
!
        END IF
!
! 2.  General case --------------------------------------------------- /
!
! 2.a Interpolation / averaging data for X axis
!
      IF ( SX/SXI .LT. 1.0001 ) THEN
          MXA    = 2
        ELSE
          MXA    = 2 + INT(SX/SXI)
        END IF
!
!/T      WRITE (MDST,9020) 'X'
!/T1      WRITE (FORMAT1,'(A,I2,A,I2,A)') "'(10X,",MXA+1,'I5,',MXA+1,"F6.2)'"
!/T1      WRITE (MDST,9021) NX, MXA
!
      ALLOCATE ( NXA(NX,0:MXA) , RXA(NX,MXA) )
      NXA    = 0
      RXA    = 0.
!
      IF ( MXA .EQ. 2 ) THEN
!
          DO IX=1, NX
            IF ( FLAGLL ) THEN
                XR     = 1. + MOD       &
                         ( 1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI
              ELSE
                XR     = 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI
              END IF
            IF ( XR.GT.0. ) THEN
                J1     = INT(XR)
                J2     = J1 + 1
                R2     = MAX ( 0. , XR-REAL(J1) )
                R1     = 1. - R2
                IF ( FLAGLL .AND. ICLOSE.NE.ICLOSE_NONE ) THEN
                    J1 = 1 + MOD(J1-1,NXI)
                    J2 = 1 + MOD(J2-1,NXI)
                  END IF
                IF ( J1.GE.1 .AND. J1.LE.NXI .AND. R1.GT.0.05 ) THEN
                    NXA(IX,0) = NXA(IX,0) + 1
                    NXA(IX,NXA(IX,0)) = J1
                    RXA(IX,NXA(IX,0)) = R1
                  END IF
                IF ( J2.GE.1 .AND. J2.LE.NXI .AND. R2.GT.0.05 ) THEN
                    NXA(IX,0) = NXA(IX,0) + 1
                    NXA(IX,NXA(IX,0)) = J2
                    RXA(IX,NXA(IX,0)) = R2
                  END IF
                IF ( NXA(IX,0)  .GT. 0 ) THEN
                    RT     = SUM ( RXA(IX,:) )
                    IF ( RT .LT. 0.7 ) THEN
                        NXA(IX,:) = 0
                        RXA(IX,:) = 0.
                      END IF
                  END IF
              END IF
            END DO
!
        ELSE
!
          DO IX=1, NX
!
            XFL    = X0 + REAL(IX-1)*SX - 0.5*SX
            XFR    = X0 + REAL(IX-1)*SX + 0.5*SX
            IF ( FLAGLL ) THEN
                IXC    = 1 + NINT ( MOD (                             &
                            1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI )
                IXS0   = IXC - 1 - MXA/2
                IXSN   = IXC + 1 + MXA/2
              ELSE
                IXC    = NINT ( 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI )
                IXS0   = MAX (  1  , IXC - 1 - MXA/2 )
                IXSN   = MIN ( NXI , IXC + 1 + MXA/2 )
              END IF
            DO J=IXS0, IXSN
               JJ=J
              IF ( FLAGLL ) THEN
                  IF ( ICLOSE.NE.ICLOSE_NONE ) JJ = 1 + MOD(J-1,NXI)
                  IF ( JJ.LT.1 .OR. JJ.GT. NXI ) CYCLE
                  IXC   = NINT((0.5*(XFL+XFR)-X0I-REAL(JJ-1)*SXI)/360.)
                  IF ( IXC .NE. 0 ) THEN
                      XFL    = XFL - REAL(IXC) * 360.
                      XFR    = XFR - REAL(IXC) * 360.
                    END IF
                ELSE
                  JJ     = J
                END IF
              XSL    = MAX ( XFL , X0I + REAL(JJ-1)*SXI - 0.5*SXI )
              XSR    = MIN ( XFR , X0I + REAL(JJ-1)*SXI + 0.5*SXI )
              R1     = MAX ( 0. , XSR - XSL ) / SX
              IF ( R1 .GT. 0 ) THEN
                  NXA(IX,0) = NXA(IX,0) + 1
                  NXA(IX,NXA(IX,0)) = JJ
                  RXA(IX,NXA(IX,0)) = R1
                END IF
              END DO
            IF ( NXA(IX,0)  .GT. 0 ) THEN
                RT     = SUM ( RXA(IX,:) )
                IF ( RT .LT. 0.7 ) THEN
                    NXA(IX,:) = 0
                    RXA(IX,:) = 0.
                  END IF
              END IF
            END DO
!
        END IF
!
!/T1      DO, IX=1, NX
!/T1        IF ( NXA(IX,0) .GT. 0 ) WRITE (MDST,FORMAT1)                &
!/T1               IX, NXA(IX,1:MXA), RXA(IX,1:MXA), SUM(RXA(IX,1:MXA))
!/T1        END DO
!
! 2.b Interpolation / averaging data for Y axis
!
      IF ( SY/SYI .LT. 1.0001 ) THEN
          MYA    = 2
        ELSE
          MYA    = 2 + INT(SY/SYI)
        END IF
!
!/T      WRITE (MDST,9020) 'Y'
!/T1      FORMAT1 = '(10X,  I5,  F6.2)'
!/T1      WRITE (FORMAT1,'(A,I2,A,I2,A)') "'(10X,",MYA+1,'I5,',MYA+1,"F6.2)'"
!/T1      WRITE (MDST,9021) NY, MYA
!
      ALLOCATE ( NYA(NY,0:MYA) , RYA(NY,MYA) )
      NYA    = 0
      RYA    = 0.
!
      IF ( MYA .EQ. 2 ) THEN
!
          DO IY=1, NY
            YR     = 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI
            IF ( YR.GT.0. ) THEN
                J1     = INT(YR)
                J2     = J1 + 1
                R2     = MAX ( 0. , YR-REAL(J1) )
                R1     = 1. - R2
                IF ( J1.GE.1 .AND. J1.LE.NYI .AND. R1.GT.0.05 ) THEN
                    NYA(IY,0) = NYA(IY,0) + 1
                    NYA(IY,NYA(IY,0)) = J1
                    RYA(IY,NYA(IY,0)) = R1
                  END IF
                IF ( J2.GE.1 .AND. J2.LE.NYI .AND. R2.GT.0.05 ) THEN
                    NYA(IY,0) = NYA(IY,0) + 1
                    NYA(IY,NYA(IY,0)) = J2
                    RYA(IY,NYA(IY,0)) = R2
                  END IF
                IF ( NYA(IY,0)  .GT. 0 ) THEN
                    RT     = SUM ( RYA(IY,:) )
                    IF ( RT .LT. 0.7 ) THEN
                        NYA(IY,:) = 0
                        RYA(IY,:) = 0.
                      END IF
                  END IF
              END IF
            END DO
!
        ELSE
!
          DO IY=1, NY
            YFL    = Y0 + REAL(IY-1)*SY - 0.5*SY
            YFR    = Y0 + REAL(IY-1)*SY + 0.5*SY
            IYC    = NINT ( 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI )
            IYS0   = MAX (  1  , IYC - 1 - MYA/2 )
            IYSN   = MIN ( NYI , IYC + 1 + MYA/2 )
            DO J=IYS0, IYSN
              YSL    = MAX ( YFL , Y0I + REAL(J-1)*SYI - 0.5*SYI )
              YSR    = MIN ( YFR , Y0I + REAL(J-1)*SYI + 0.5*SYI )
              R1     = MAX ( 0. , YSR - YSL ) / SY
              IF ( R1 .GT. 0 ) THEN
                  NYA(IY,0) = NYA(IY,0) + 1
                  NYA(IY,NYA(IY,0)) = J
                  RYA(IY,NYA(IY,0)) = R1
                END IF
              END DO
            IF ( NYA(IY,0)  .GT. 0 ) THEN
                RT     = SUM ( RYA(IY,:) )
                IF ( RT .LT. 0.7 ) THEN
                    NYA(IY,:) = 0
                    RYA(IY,:) = 0.
                  END IF
              END IF
            END DO
!
        END IF
!
!/T1      DO, IY=1, NY
!/T1        IF ( NYA(IY,0) .GT. 0 ) WRITE (MDST,FORMAT1)                &
!/T1               IY, NYA(IY,1:MYA), RYA(IY,1:MYA), SUM(RYA(IY,1:MYA))
!/T1        END DO
!
! 2.c Process grid
!
      MAP1   = .FALSE.
      MAP2   = .FALSE.
      FACTOR = 1.
!
      DO IX=1, NX
        IF ( NXA(IX,0) .EQ. 0 ) CYCLE
        DO IY=1, NY
          IF ( NYA(IY,0) .EQ. 0 ) CYCLE
          IF ( MAP(IY,IX).NE.0 ) THEN
              VXL    = 0.
              VYL    = 0.
              VA     = 0.
              VA2    = 0.
              WTOT   = 0.
              DO J1=1, NXA(IX,0)
                JX     = NXA(IX,J1)
                DO J2=1, NYA(IY,0)
                  JY     = NYA(IY,J2)
                  IF ( MAPI(JY,JX) .NE. 0 ) THEN
                      WL     = RXA(IX,J1) * RYA(IY,J2)
                      WTOT   = WTOT + WL
                      VXL    = VXL + WL * VXI(JX,JY)
                      VYL    = VYL + WL * VYI(JX,JY)
                      VA     = VA  + WL * SQRT                        &
                                   ( VXI(JX,JY)**2 + VYI(JX,JY)**2 )
                      VA2    = VA2 + WL *                             &
                                   ( VXI(JX,JY)**2 + VYI(JX,JY)**2 )
                    END IF
                  END DO
                END DO
              IF ( WTOT .LT. 0.05 ) THEN
                  MAP1(IX,IY) = .TRUE.
                ELSE
                  MAP2(IX,IY) = .TRUE.
                  VXL    = VXL / WTOT
                  VYL    = VYL / WTOT
                  VA     = VA  / WTOT
                  VA2    = SQRT ( VA2 / WTOT )
                  VA0    = SQRT ( VXL**2 + VYL**2 )
                  IF ( CONSTP .EQ. 1 ) THEN
                      FACTOR    = MIN ( 1.25 , VA/MAX(1.E-7,VA0) )
                    ELSE IF ( CONSTP .EQ. 2 ) THEN
                      FACTOR    = MIN ( 1.25 , VA2/MAX(1.E-7,VA0) )
                    END IF
                  VX(IX,IY) = FACTOR * VXL
                  VY(IX,IY) = FACTOR * VYL
                END IF
            END IF
          END DO
        END DO
!
! 2.d Reconcile mask differences
!
!/T      WRITE (MDST,9022)
!
      JJ     = 0
      ICLOSE => GRIDS(IMOD)%ICLOSE
!
      DO
        IF ( JJ .GT. SWPMAX ) EXIT
        FLAGUP = .FALSE.
        MAP3   = .FALSE.
        JJ     = JJ + 1
!/T        WRITE (MDST,9023) JJ
        DO IX=1, NX
          DO IY=1, NY
            IF ( MAP1(IX,IY) ) THEN
                VXL    = 0.
                VYL    = 0.
                J1     = 0
                IF ( FLAGLL ) THEN
                    DO J2=IX-1, IX+1
                      IF ( (J2.GT.1 .AND. J2.LE.NX) .OR. ICLOSE.NE.ICLOSE_NONE ) THEN
                          JX     = 1 + MOD(NX+J2-1,NX)
                          DO JY=IY-1, IY+1
                            IF ( JY.GT.1 .AND. JY.LE.NY ) THEN
                                IF ( MAP2(JX,JY) ) THEN
                                    VXL     = VXL + VX(JX,JY)
                                    VYL     = VYL + VY(JX,JY)
                                    J1      = J1 + 1
                                  END IF
                              END IF
                            END DO
                        END IF
                      END DO
                  ELSE
                    DO JX=IX-1, IX+1
                      IF ( JX.GT.1 .AND. JX.LE.NX ) THEN
                          DO JY=IY-1, IY+1
                            IF ( JY.GT.1 .AND. JY.LE.NY ) THEN
                                IF ( MAP2(JX,JY) ) THEN
                                    VXL     = VXL + VX(JX,JY)
                                    VYL     = VYL + VY(JX,JY)
                                    J1      = J1 + 1
                                  END IF
                              END IF
                            END DO
                        END IF
                      END DO
                  END IF !FLAGLL
                IF ( J1 .GT. 0 ) THEN
                    VX(IX,IY) = VXL / REAL(J1)
                    VY(IX,IY) = VYL / REAL(J1)
                    MAP1(IX,IY) = .FALSE.
                    MAP3(IX,IY) = .TRUE.
                    FLAGUP = .TRUE.
                  END IF
              END IF
            END DO
          END DO
        IF ( FLAGUP ) THEN
            MAP2   = MAP2 .OR. MAP3
          ELSE
            EXIT
          END IF
        END DO
!
! 3. End of routine -------------------------------------------------- /
!
      DEALLOCATE ( NXA, NYA, RXA, RYA )
!
      RETURN
!
! Formats
!
!/T 9000 FORMAT ( ' TEST WMUPDV : GRID INFORMATION : '/               &
!/T               '             ',3I5,4E11.3/                         &
!/T               '             ',3I5,4E11.3/                         &
!/T               '               UNDEFINED = ',E10.3)
!/T 9010 FORMAT ( ' TEST WMUPDV : COINCIDING GRIDS, OFFSETS :',2I6/   &
!/T               '               TARGET GRID RANGES        :',4I6/   &
!/T               '               SOURCE GRID RANGES        :',4I6)
!/T 9020 FORMAT ( ' TEST WMUPDV : WEIGHTS FOR ',A,' INTERPOATION')
!/T1 9021 FORMAT ( ' TEST WMUPDV : ARAY DIMENSIONED AS : ',2I6)
!/T 9022 FORMAT ( ' TEST WMUPDV : RECONCILING MASKS')
!/T 9023 FORMAT ( '               SWEEP NR ',I4)
!/
!/ End of WMUPDV ----------------------------------------------------- /
!/
      END SUBROUTINE WMUPDV
!/ ------------------------------------------------------------------- /
      SUBROUTINE WMUPDS ( IMOD, FD, JMOD, FDI, UNDEF )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         06-Dec-2010 |
!/                  +-----------------------------------+
!/
!/    14-Oct-2006 : Origination.                        ( version 3.10 )
!/    12-Jan-2007 : General clean-up and bug fixes.     ( version 3.10 )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
!/                  specify index closure for a grid.   ( version 3.14 )
!/                  (T. J. Campbell, NRL)
!/    11-May-2015 : Updates to 2-ways nestings for UG   ( version 5.08 )
!/
!  1. Purpose :
!
!     Interpolate scalar field from input grid to model grid.
!
!  2. Method :
!
!     Interpolating or averaging from input grid.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       IMOD    Int.   I   Output model number,
!       FD      Int.   O   Output scaler field.
!       JMOD    Int.   I   Input model number,
!       FDI     Int.   I   Input scaler field.
!       UNDEF   Int.   I   Value for mapped out point and points not
!                          covered.
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE    Subr. W3ERVMD  Subroutine tracing.
!      EXTCDE    Subr.   Id.    Program abort.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      WMUPD2    Subr. WMUPDTMD Input update routine.
!     ----------------------------------------------------------------
!
!  6. Error messages :
!
!  7. Remarks :
!
!     - Grid pointers for output grid need to be set externally.
!     - If input grid does not cover point of target grid, taget grid 
!       values are set to UNDEF.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/S     Enable subroutine tracing.
!       !/T     Enable test output
!       !/T1    Test output interpolation data.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
!/
      USE W3SERVMD, ONLY: EXTCDE
!/S      USE W3SERVMD, ONLY: STRACE
!/
      USE W3GDATMD, ONLY: NX, NY, X0, Y0, SX, SY, GRIDS, FLAGLL,      &
                          GTYPE, RLGTYPE, CLGTYPE, UNGTYPE,           &
                          ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL
      USE WMMDATMD, ONLY: IMPROC, NMPERR, NMPSCR, MDST, MDSE, MDSO,   &
                          MDSS
!/
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: IMOD, JMOD
      REAL, INTENT(OUT)       :: FD(NX,NY)
      REAL, INTENT(IN)        :: FDI(GRIDS(JMOD)%NX,GRIDS(JMOD)%NY),  &
                                 UNDEF
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: IXO, IYO, IX, IY, IXF0, IXFN, IYF0,  &
                                 IYFN, IXS0, IXSN, IYS0, IYSN, IXS,   &
                                 MXA, MYA, J, J1, J2, IXC, IYC, JJ,   &
                                 JX, JY
!/S      INTEGER, SAVE           :: IENT = 0
      INTEGER, ALLOCATABLE    :: NXA(:,:), NYA(:,:)
      REAL                    :: XR, YR, R1, R2, RT, XFL, XFR, XSL,   &
                                 XSR, YFL, YFR, YSL, YSR
      REAL                    :: FDL, WTOT, WL
      REAL, ALLOCATABLE       :: RXA(:,:), RYA(:,:)
      LOGICAL                 :: MAP1(NX,NY), MAP2(NX,NY),            &
                                 MAP3(NX,NY), FLAGUP
!
      INTEGER, POINTER        :: NXI, NYI, MAP(:,:), MAPI(:,:)
      REAL, POINTER           :: X0I, Y0I, SXI, SYI
      INTEGER, POINTER        :: ICLOSE
!/T1      CHARACTER(LEN=17)       :: FORMAT1
!/
!/ ------------------------------------------------------------------- /
! 0.  Initialization
! 0.a Subroutine tracing and test output
!
!/S      CALL STRACE (IENT, 'WMUPDS')
!
      IF ( GRIDS(IMOD)%GTYPE .EQ. CLGTYPE .OR. &
           GRIDS(JMOD)%GTYPE .EQ. CLGTYPE ) THEN
          WRITE (MDSE,'(/2A)') ' *** ERROR WMUPDS: ', &
          'CURVILINEAR GRID SUPPORT NOT YET IMPLEMENTED ***'
          CALL EXTCDE ( 999 )
      END IF
!
      NXI    => GRIDS(JMOD)%NX
      NYI    => GRIDS(JMOD)%NY
      X0I    => GRIDS(JMOD)%X0
      Y0I    => GRIDS(JMOD)%Y0
      SXI    => GRIDS(JMOD)%SX
      SYI    => GRIDS(JMOD)%SY
      MAP    => GRIDS(IMOD)%MAPSTA
      MAPI   => GRIDS(JMOD)%MAPSTA
      ICLOSE => GRIDS(JMOD)%ICLOSE

      IF ( ICLOSE .EQ. ICLOSE_TRPL ) THEN
         IF ( IMPROC.EQ.NMPERR ) WRITE(MDSE,*)'SUBROUTINE WMUPDS IS'// &
         ' NOT YET ADAPTED FOR TRIPOLE GRIDS. STOPPING NOW.'
         CALL EXTCDE ( 1 )
      END IF

!
!/T      WRITE (MDST,9000) IMOD, NX, NY, X0, Y0, SX, SY,              &
!/T                        JMOD, NXI, NYI, X0I, Y0I, SXI, SYI, UNDEF
!
! 0.b Initialize fields
!
      FD     = UNDEF
!
! 1. Case of identical resolution and coinciding grids --------------- /
!
      IF ( ABS(SX/SXI-1.) .LT. 1.E-3                         .AND.    &
           ABS(SY/SYI-1.) .LT. 1.E-3                         .AND.    &
           ABS(MOD((ABS(X0-X0I))/SX+0.5,1.)-0.5) .LT. 1.E-2  .AND.    &
           ABS(MOD((ABS(Y0-Y0I))/SY+0.5,1.)-0.5) .LT. 1.E-2 ) THEN
!
! 1.a Offsets
!
          IXO    = NINT((X0-X0I)/SX)
!
          IF ( FLAGLL ) THEN
              IXF0   = 1
              IXFN   = NX
              IXS0   = -999
              IXSN   = -999
            ELSE
              IXF0   = MAX (  1  , 1-IXO )
              IXFN   = MIN ( NX  , NXI-IXO )
              IXS0   = MAX (  1  , 1+IXO )
              IXSN   = IXS0 + IXFN - IXF0
            END IF
!
          IYO    = NINT((Y0-Y0I)/SY)
!
          IYF0   = MAX (  1  , 1-IYO )
          IYFN   = MIN ( NY  , NYI-IYO )
          IYS0   = MAX (  1  , 1+IYO )
          IYSN   = IYS0 + IYFN - IYF0
!
!/T          WRITE (MDST,9010) IXO, IYO, IXF0, IXFN, IYF0, IYFN,      &
!/T                                      IXS0, IXSN, IYS0, IYSN
!
! 1.b Fill arrays for sea points only
!
          IF ( FLAGLL ) THEN
              DO IX=IXF0, IXFN
                IXS    = 1 + NINT ( MOD (                             &
                  1080.+X0+(REAL(IX)-0.5)*SX-X0I , 360. ) / SX - 0.5 )
                IF ( IXS .GT. NXI ) CYCLE
                FD(IX,IYF0:IYFN) = FDI(IXS,IYS0:IYSN)
                END DO
            ELSE
              DO IX=IXF0, IXFN
                IXS    = IX + IXO
                FD(IX,IYF0:IYFN) = FDI(IXS,IYS0:IYSN)
                END DO
            END IF
!
! 1.c Return to calling routine
!
          RETURN
!
        END IF
!
! 2.  General case --------------------------------------------------- /
!
! 2.a Interpolation / averaging data for X axis
!
      IF ( SX/SXI .LT. 1.0001 ) THEN
          MXA    = 2
        ELSE
          MXA    = 2 + INT(SX/SXI)
        END IF
!
!/T      WRITE (MDST,9020) 'X'
!/T1      FORMAT1 = '(10X,  I5,  F6.2)'
!/T1      WRITE (FORMAT1,'(A,I2,A,I2,A)') "'(10X,",MXA+1,'I5,',MXA+1,"F6.2)'"
!/T1      WRITE (MDST,9021) NX, MXA
!
      ALLOCATE ( NXA(NX,0:MXA) , RXA(NX,MXA) )
      NXA    = 0
      RXA    = 0.
!
      IF ( MXA .EQ. 2 ) THEN
!
          DO IX=1, NX
            IF ( FLAGLL ) THEN
                XR     = 1. + MOD       &
                         ( 1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI
              ELSE
                XR     = 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI
              END IF
            IF ( XR.GT.0. ) THEN
                J1     = INT(XR)
                J2     = J1 + 1
                R2     = MAX ( 0. , XR-REAL(J1) )
                R1     = 1. - R2
                IF ( FLAGLL .AND. ICLOSE.NE.ICLOSE_NONE ) THEN
                    J1 = 1 + MOD(J1-1,NXI)
                    J2 = 1 + MOD(J2-1,NXI)
                  END IF
                IF ( J1.GE.1 .AND. J1.LE.NXI .AND. R1.GT.0.05 ) THEN
                    NXA(IX,0) = NXA(IX,0) + 1
                    NXA(IX,NXA(IX,0)) = J1
                    RXA(IX,NXA(IX,0)) = R1
                  END IF
                IF ( J2.GE.1 .AND. J2.LE.NXI .AND. R2.GT.0.05 ) THEN
                    NXA(IX,0) = NXA(IX,0) + 1
                    NXA(IX,NXA(IX,0)) = J2
                    RXA(IX,NXA(IX,0)) = R2
                  END IF
                IF ( NXA(IX,0)  .GT. 0 ) THEN
                    RT     = SUM ( RXA(IX,:) )
                    IF ( RT .LT. 0.7 ) THEN
                        NXA(IX,:) = 0
                        RXA(IX,:) = 0.
                      END IF
                  END IF
              END IF
            END DO
!
        ELSE
!
          DO IX=1, NX
!
            XFL    = X0 + REAL(IX-1)*SX - 0.5*SX
            XFR    = X0 + REAL(IX-1)*SX + 0.5*SX
            IF ( FLAGLL ) THEN
                IXC    = 1 + NINT ( MOD (                             &
                         1080.+X0+REAL(IX-1)*SX-X0I , 360. ) / SXI )
                IXS0   = IXC - 1 - MXA/2
                IXSN   = IXC + 1 + MXA/2
              ELSE
                IXC    = NINT ( 1. + ( X0+REAL(IX-1)*SX - X0I ) / SXI )
                IXS0   = MAX (  1  , IXC - 1 - MXA/2 )
                IXSN   = MIN ( NXI , IXC + 1 + MXA/2 )
              END IF
            DO J=IXS0, IXSN
              IF ( FLAGLL ) THEN
                  IF ( ICLOSE.NE.ICLOSE_NONE ) JJ = 1 + MOD(J-1,NXI)
                  IF ( JJ.LT.1 .OR. JJ.GT. NXI ) CYCLE
                  IXC   = NINT((0.5*(XFL+XFR)-X0I-REAL(JJ-1)*SXI)/360.)
                  IF ( IXC .NE. 0 ) THEN
                      XFL    = XFL - REAL(IXC) * 360.
                      XFR    = XFR - REAL(IXC) * 360.
                    END IF
                ELSE
                  JJ     = J
                END IF
              XSL    = MAX ( XFL , X0I + REAL(JJ-1)*SXI - 0.5*SXI )
              XSR    = MIN ( XFR , X0I + REAL(JJ-1)*SXI + 0.5*SXI )
              R1     = MAX ( 0. , XSR - XSL ) / SX
              IF ( R1 .GT. 0 ) THEN
                  NXA(IX,0) = NXA(IX,0) + 1
                  NXA(IX,NXA(IX,0)) = JJ
                  RXA(IX,NXA(IX,0)) = R1
                END IF
              END DO
            IF ( NXA(IX,0)  .GT. 0 ) THEN
                RT     = SUM ( RXA(IX,:) )
                IF ( RT .LT. 0.7 ) THEN
                    NXA(IX,:) = 0
                    RXA(IX,:) = 0.
                  END IF
              END IF
            END DO
!
        END IF
!
!/T1      DO, IX=1, NX
!/T1        IF ( NXA(IX,0) .GT. 0 ) WRITE (MDST,FORMAT1)                &
!/T1               IX, NXA(IX,1:MXA), RXA(IX,1:MXA), SUM(RXA(IX,1:MXA))
!/T1        END DO
!
! 2.b Interpolation / averaging data for Y axis
!
      IF ( SY/SYI .LT. 1.0001 ) THEN
          MYA    = 2
        ELSE
          MYA    = 2 + INT(SY/SYI)
        END IF
!
!/T      WRITE (MDST,9020) 'Y'
!/T1      WRITE (FORMAT1,'(A,I2,A,I2,A)') "'(10X,",MYA+1,'I5,',MYA+1,"F6.2)'"
!/T1      WRITE (MDST,9021) NY, MYA
!
      ALLOCATE ( NYA(NY,0:MYA) , RYA(NY,MYA) )
      NYA    = 0
      RYA    = 0.
!
      IF ( MYA .EQ. 2 ) THEN
!
          DO IY=1, NY
            YR     = 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI
            IF ( YR.GT.0. ) THEN
                J1     = INT(YR)
                J2     = J1 + 1
                R2     = MAX ( 0. , YR-REAL(J1) )
                R1     = 1. - R2
                IF ( J1.GE.1 .AND. J1.LE.NYI .AND. R1.GT.0.05 ) THEN
                    NYA(IY,0) = NYA(IY,0) + 1
                    NYA(IY,NYA(IY,0)) = J1
                    RYA(IY,NYA(IY,0)) = R1
                  END IF
                IF ( J2.GE.1 .AND. J2.LE.NYI .AND. R2.GT.0.05 ) THEN
                    NYA(IY,0) = NYA(IY,0) + 1
                    NYA(IY,NYA(IY,0)) = J2
                    RYA(IY,NYA(IY,0)) = R2
                  END IF
                IF ( NYA(IY,0)  .GT. 0 ) THEN
                    RT     = SUM ( RYA(IY,:) )
                    IF ( RT .LT. 0.7 ) THEN
                        NYA(IY,:) = 0
                        RYA(IY,:) = 0.
                      END IF
                  END IF
              END IF
            END DO
!
        ELSE
!
          DO IY=1, NY
            YFL    = Y0 + REAL(IY-1)*SY - 0.5*SY
            YFR    = Y0 + REAL(IY-1)*SY + 0.5*SY
            IYC    = NINT ( 1. + ( Y0+REAL(IY-1)*SY - Y0I ) / SYI )
            IYS0   = MAX (  1  , IYC - 1 - MYA/2 )
            IYSN   = MIN ( NYI , IYC + 1 + MYA/2 )
            DO J=IYS0, IYSN
              YSL    = MAX ( YFL , Y0I + REAL(J-1)*SYI - 0.5*SYI )
              YSR    = MIN ( YFR , Y0I + REAL(J-1)*SYI + 0.5*SYI )
              R1     = MAX ( 0. , YSR - YSL ) / SY
              IF ( R1 .GT. 0 ) THEN
                  NYA(IY,0) = NYA(IY,0) + 1
                  NYA(IY,NYA(IY,0)) = J
                  RYA(IY,NYA(IY,0)) = R1
                END IF
              END DO
            IF ( NYA(IY,0)  .GT. 0 ) THEN
                RT     = SUM ( RYA(IY,:) )
                IF ( RT .LT. 0.7 ) THEN
                    NYA(IY,:) = 0
                    RYA(IY,:) = 0.
                  END IF
              END IF
            END DO
!
        END IF
!
!/T1      DO, IY=1, NY
!/T1        IF ( NYA(IY,0) .GT. 0 ) WRITE (MDST,FORMAT1)                &
!/T1               IY, NYA(IY,1:MYA), RYA(IY,1:MYA), SUM(RYA(IY,1:MYA))
!/T1        END DO
!
! 2.c Process grid
!
      MAP1   = .FALSE.
      MAP2   = .FALSE.
!
      DO IX=1, NX
        IF ( NXA(IX,0) .EQ. 0 ) CYCLE
        DO IY=1, NY
          IF ( NYA(IY,0) .EQ. 0 ) CYCLE
          IF ( MAP(IY,IX).NE.0 ) THEN
              FDL    = 0.
              WTOT   = 0.
              DO J1=1, NXA(IX,0)
                JX     = NXA(IX,J1)
                DO J2=1, NYA(IY,0)
                  JY     = NYA(IY,J2)
                  IF ( MAPI(JY,JX) .NE. 0 ) THEN
                      WL     = RXA(IX,J1) * RYA(IY,J2)
                      WTOT   = WTOT + WL
                      FDL    = FDL + WL * FDI(JX,JY)
                    END IF
                  END DO
                END DO
              IF ( WTOT .LT. 0.05 ) THEN
                  MAP1(IX,IY) = .TRUE.
                ELSE
                  MAP2(IX,IY) = .TRUE.
                  FDL    = FDL / WTOT
                  FD(IX,IY) = FDL
                END IF
            END IF
          END DO
        END DO
!
! 2.d Reconcile mask differences
!
!/T      WRITE (MDST,9022)
!
      JJ     = 0
      ICLOSE => GRIDS(IMOD)%ICLOSE
!
      DO
        IF ( JJ .GT. SWPMAX ) EXIT
        FLAGUP = .FALSE.
        MAP3   = .FALSE.
        JJ     = JJ + 1
!/T        WRITE (MDST,9023) JJ
        DO IX=1, NX
          DO IY=1, NY
            IF ( MAP1(IX,IY) ) THEN
                FDL    = 0.
                J1     = 0
                IF ( FLAGLL ) THEN
                    DO J2=IX-1, IX+1
                      IF ( (J2.GT.1 .AND. J2.LE.NX) .OR. ICLOSE.NE.ICLOSE_NONE ) THEN
                          JX     = 1 + MOD(NX+J2-1,NX)
                          DO JY=IY-1, IY+1
                            IF ( JY.GT.1 .AND. JY.LE.NY ) THEN
                                IF ( MAP2(JX,JY) ) THEN
                                    FDL     = FDL + FD(JX,JY)
                                    J1      = J1 + 1
                                  END IF
                              END IF
                            END DO
                        END IF
                      END DO
                  ELSE
                    DO JX=IX-1, IX+1
                      IF ( JX.GT.1 .AND. JX.LE.NX ) THEN
                          DO JY=IY-1, IY+1
                            IF ( JY.GT.1 .AND. JY.LE.NY ) THEN
                                IF ( MAP2(JX,JY) ) THEN
                                    FDL     = FDL + FD(JX,JY)
                                    J1      = J1 + 1
                                  END IF
                              END IF
                            END DO
                        END IF
                      END DO
                  END IF !FLAGLL
                IF ( J1 .GT. 0 ) THEN
                    FD(IX,IY) = FDL / REAL(J1)
                    MAP1(IX,IY) = .FALSE.
                    MAP3(IX,IY) = .TRUE.
                    FLAGUP = .TRUE.
                  END IF
              END IF
            END DO
          END DO
        IF ( FLAGUP ) THEN
            MAP2   = MAP2 .OR. MAP3
          ELSE
            EXIT
          END IF
        END DO
!
! 3. End of routine -------------------------------------------------- /
!
      DEALLOCATE ( NXA, NYA, RXA, RYA )
!
      RETURN
!
! Formats
!
!/T 9000 FORMAT ( ' TEST WMUPDS : GRID INFORMATION : '/               &
!/T               '             ',3I5,4E11.3/                         &
!/T               '             ',3I5,4E11.3/                         &
!/T               '               UNDEFINED = ',E10.3)
!/T 9010 FORMAT ( ' TEST WMUPDS : COINCIDING GRIDS, OFFSETS :',2I6/   &
!/T               '               TARGET GRID RANGES        :',4I6/   &
!/T               '               SOURCE GRID RANGES        :',4I6)
!/T 9020 FORMAT ( ' TEST WMUPDS : WEIGHTS FOR ',A,' INTERPOATION')
!/T1 9021 FORMAT ( ' TEST WMUPDS : ARAY DIMENSIONED AS : ',2I6)
!/T 9022 FORMAT ( ' TEST WMUPDS : RECONCILING MASKS')
!/T 9023 FORMAT ( '               SWEEP NR ',I4)
!/
!/ End of WMUPDS ----------------------------------------------------- /
!/
      END SUBROUTINE WMUPDS
!/
!/ End of module WMUPDTMD -------------------------------------------- /
!/
      END MODULE WMUPDTMD
