w3idatmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
 
!/ ------------------------------------------------------------------- /
MODULE w3idatmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         22-Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/    02-Apr-2004 : Origination.                        ( version 3.06 )
  !/    19-Jul-2006 : Adding auxiliary grids.             ( version 3.10 )
  !/    04-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
  !/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
  !/    24-Apr-2015 : Adding OASIS coupling calls         ( version 5.07 )
  !/                  (M. Accensi & F. Ardhuin, IFREMER)
  !/    21-Jun-2018 : Add FSWND input for SMC grid. JGLi  ( version 6.04 )
  !/    22-Mar-2021 : Momentum and air density support    ( version 7.13 )
  !/
  !/    Copyright 2009 National Weather Service (NWS),
  !/       National Oceanic and Atmospheric Administration.  All rights
  !/       reserved.  WAVEWATCH III is a trademark of the NWS.
  !/       No unauthorized use without permission.
  !/
  !  1. Purpose :
  !
  !     Define data structures to set up wave model input data for
  !     several models simultaneously.
  !
  !  2. Variables and types :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      NIDATA    Int.  Public   Number of models in array dim.
  !      IIDATA    Int.  Public   Selected model for output, init. at -1.
  !      INPUT     TYPE  Public   Basic data structure.
  !      INPUTS    INPUT Public   Array of data structures.
  !     ----------------------------------------------------------------
  !
  !     All elements of INPUT are aliased to pointers with the same
  !     name. Some aditional pointer provide previous equivalenced
  !     parameters. These pointers are defined as :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      TLN       I.A.  Public   Time for water level field.
  !      TC0/N     I.A.  Public   Times for current fields.
  !      TW0/N     I.A.  Public   Times for wind fields.
  !      TDN       I.A.  Public   Time for mud density field.
  !      TTN       I.A.  Public   Time for mud thickness field.
  !      TVN       I.A.  Public   Time for mud viscosity field.
  !      TIN       I.A.  Public   Time for ice field. (concentration)
  !      TU0/N     I.A.  Public   Times for momentum fields.
  !      TR0/N     I.A.  Public   Times for air density fields.
  !      TI1N      I.A.  Public   Time for ice field. (parameter 1)
  !      TI2N      I.A.  Public   Time for ice field. (parameter 2)
  !      TI3N      I.A.  Public   Time for ice field. (parameter 3)
  !      TI4N      I.A.  Public   Time for ice field. (parameter 4)
  !      TI5N      I.A.  Public   Time for ice field. (parameter 5)
  !      TnN       I.A.  Public   Time for data types 1-3.
  !      TDN       I.A.  Public   Time for next data.
  !      TG0/N     I.A.  Public   Times for grid motion data.
  !      TFN       I.A.  Public   Array consolidating most above times.
  !      GA0/N     Real  Public   Norm of grid speed vector.
  !      GD0/N     Real  Public   Direction of grid speed vector.
  !      WX0/N     R.A.  Public   Cartesian X and Y wind components
  !      WY0/N     R.A.  Public      for both times.
  !      DT0/N     R.A.  Public   Corr. air-sea temperature differences.
  !      CX0/N     R.A.  Public   Cartesian X and Y current components
  !      CY0/N     R.A.  Public      for both times.
  !      WLEV      R.A.  Public   Next water level field.
  !      ICEI      R.A.  Public   Ice concentrations.
  !      UX0/N     R.A.  Public   Cartesian X and Y momentum components
  !      UY0/N     R.A.  Public      for both times.
  !      RH0/N     R.A.  Public   Air density for both times
  !      BERGI     R.A.  Public   Iceberg damping coefficient
  !      IINIT     Log.  Public   Flag for array initialization.
  !      FLLEV     Log.  Public   Flag for water level input.
  !      FLCUR     Log.  Public   Flag for current input.
  !      FLWIND    Log.  Public   Flag for wind input.
  !      FLICE     Log.  Public   Flag for ice input.
  !      FLTAUA    Log.  Public   Flag for atmospheric momentum input
  !      FLRHOA    Log.  Public   Flag for air density input
  !      INFLAGS1  L.A.  Public   Array consolidating the above six
  !                               flags, as well as four additional
  !                               data flags.
  !      INFLAGS2  L.A.  Public   Like INFLAGS1 but does *not* get changed
  !                               when model reads last record of ice.ww3
  !      FLAGSC    L.A.  Public   Coupling or not for input variables
  !      JFIRST    Int   Public   First index of arrays related to
  !                               input fields.  At present this is
  !                               hardwired below. Field-related arrays
  !                               (e.g., INFLAGS1) will be allocated from
  !                               JFIRST:9 (e.g., ALLOCATE(INFLAGS1(JFIRST:9))).
  !       CXTIDE    R.A.  Public   Tidal constituents of X current component
  !       CYTIDE    R.A.  Public   Tidal constituents of Y current component
  !       WLTIDE    R.A.  Public   Tidal constituents of water level
  !       FLLEVTIDE Log.  Public   Flag for use of tidal const. in water level input.
  !       FLCURTIDE Log.  Public   Flag for use of tidal const. in current input.
  !     ----------------------------------------------------------------
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      W3NINP    Subr. Public   Set number of grids/models.
  !      W3DIMI    Subr. Public   Set dimensions of arrays.
  !      W3SETI    Subr. Public   Point to selected grid / model.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      W3SETG    Subr. W3GDATMD Point to proper model grid.
  !      STRACE    Subr. W3SERVMD Subroutine tracing.
  !      EXTCDE    Subr. W3SERVMD Abort program with exit code.
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !     - The number of grids is taken from W3GDATMD, and needs to be
  !       set first with W3DIMG.
  !
  !     - INFLAGS1 dimensioning is hardwired as INFLAGS1(-7:14) where lowest possible
  !       value of JFIRST is JFIRST=-7
  !
  !  6. Switches :
  !
  !     !/S    Enable subroutine tracing.
  !     !/T    Enable test output
  !     !/TIDE Use of tidal constituents
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  PUBLIC
  !/
  !/ Module private variable for checking error returns
  !/
  INTEGER, PRIVATE        :: ISTAT
  !/
  !/ Conventional declarations
  !/
  INTEGER                 :: nidata = -1, iidata = -1
 
  INTEGER                 :: jfirst = 1
 
#ifdef W3_TIDE
  INTEGER                 :: ntide   ! number of tidal constituents
  REAL, ALLOCATABLE       :: tidefreq(:)
#endif
  !/
  !/ Data structure INPUT
  !/
  TYPE, PUBLIC :: input
    INTEGER               :: tfn(2,-7:10)
    INTEGER               :: tc0(2)
    INTEGER               :: tw0(2)
    INTEGER               :: tu0(2)
    INTEGER               :: tr0(2)
    INTEGER               :: tdn(2)
    INTEGER               :: tg0(2)
    REAL                  :: ga0
    REAL                  :: gd0
    REAL                  :: gan
    REAL                  :: gdn
#ifdef W3_WRST
    REAL, POINTER         :: wxnwrst(:,:)
    REAL, POINTER         :: wynwrst(:,:)
#endif
    REAL, POINTER         :: wx0(:,:)
    REAL, POINTER         :: wy0(:,:)
    REAL, POINTER         :: dt0(:,:)
    REAL, POINTER         :: wxn(:,:)
    REAL, POINTER         :: wyn(:,:)
    REAL, POINTER         :: dtn(:,:)
    REAL, POINTER         :: cx0(:,:)
    REAL, POINTER         :: cy0(:,:)
    REAL, POINTER         :: cxn(:,:)
    REAL, POINTER         :: cyn(:,:)
    REAL, POINTER         :: wlev(:,:)
    REAL, POINTER         :: icei(:,:)
    REAL, POINTER         :: ux0(:,:)
    REAL, POINTER         :: uy0(:,:)
    REAL, POINTER         :: uxn(:,:)
    REAL, POINTER         :: uyn(:,:)
    REAL, POINTER         :: rh0(:,:)
    REAL, POINTER         :: rhn(:,:)
    REAL, POINTER         :: bergi(:,:)
    REAL, POINTER         :: mudt(:,:)
    REAL, POINTER         :: mudv(:,:)
    REAL, POINTER         :: mudd(:,:)
    REAL, POINTER         :: icep1(:,:)
    REAL, POINTER         :: icep2(:,:)
    REAL, POINTER         :: icep3(:,:)
    REAL, POINTER         :: icep4(:,:)
    REAL, POINTER         :: icep5(:,:)
#ifdef W3_TIDE
    REAL, POINTER         :: cxtide(:,:,:,:)
    REAL, POINTER         :: cytide(:,:,:,:)
    REAL, POINTER         :: wltide(:,:,:,:)
#endif
    LOGICAL               :: iinit
#ifdef W3_WRST
    LOGICAL               :: wrstiinit=.false.
#endif
    ! note that if size of INFLAGS1 is changed, then TFLAGS in wminitmd.ftn
    !    also must be resized.
    LOGICAL               :: inflags1(-7:14)
    LOGICAL               :: flagsc(-7:14)
    LOGICAL               :: inflags2(-7:14)
  END TYPE input
  !/
  !/ Data storage
  !/
  TYPE(input), TARGET, ALLOCATABLE :: inputs(:)
  !/
  !/ Data aliasses for structure INPUT(S)
  !/
  INTEGER, POINTER        :: tfn(:,:), tln(:), tc0(:), tcn(:),    &
       tw0(:), twn(:), tu0(:), tun(:),      &
       tin(:), tr0(:), trn(:), t0n(:),      &
       t1n(:), t2n(:), tdn(:), tg0(:),      &
       tgn(:), ttn(:), tvn(:), tzn(:),      &
       ti1(:), ti2(:), ti3(:), ti4(:), ti5(:)
  REAL, POINTER           :: ga0, gd0, gan, gdn
  REAL, POINTER           :: wx0(:,:), wy0(:,:), dt0(:,:),        &
       wxn(:,:), wyn(:,:), dtn(:,:),        &
#ifdef w3_wrst
       wxnwrst(:,:),wynwrst(:,:),           &
#endif
       cx0(:,:), cy0(:,:), cxn(:,:),        &
       cyn(:,:), wlev(:,:), icei(:,:),      &
       ux0(:,:), uy0(:,:), uxn(:,:),        &
       uyn(:,:), rh0(:,:), rhn(:,:),        &
       bergi(:,:), mudt(:,:), mudv(:,:),    &
       mudd(:,:), icep1(:,:), icep2(:,:),   &
       icep3(:,:), icep4(:,:), icep5(:,:)
#ifdef W3_TIDE
  REAL, POINTER           :: cxtide(:,:,:,:),         &
       cytide(:,:,:,:), wltide(:,:,:,:)
#endif
  LOGICAL, POINTER        :: iinit
  LOGICAL, POINTER        :: inflags1(:), inflags2(:), flagsc(:)
  LOGICAL, POINTER        :: fllev, flcur, flwind, flice, fltaua, &
       flrhoa
  LOGICAL, POINTER        :: flmth, flmvs, flmdn
  LOGICAL, POINTER        :: flic1, flic2, flic3, flic4, flic5
#ifdef W3_TIDE
  LOGICAL, POINTER        ::  fllevtide, flcurtide,  &
       fllevresi, flcurresi
#endif
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3ninp ( NDSE, NDST )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 !
    !/                  +-----------------------------------+
    !/
    !/    02-Apr-2004 : Origination.                        ( version 3.06 )
    !/    19-Jul-2006 : Adding auxiliary grids.             ( version 3.10 )
    !/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
    !/    22-Mar-2021 : Momentum and air density support    ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Set up the number of grids to be used.
    !
    !  2. Method :
    !
    !     Use data stored in NGRIDS in W3GDATMD.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !     Any program that uses this grid structure.
    !
    !  6. Error messages :
    !
    !     - Error checks on previous setting of variable NGRIDS.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: ngrids, nauxgr
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NDSE, NDST
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: I
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
    CALL strace (ient, 'W3NINP')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( ngrids .EQ. -1 ) THEN
      WRITE (ndse,1001) ngrids
      CALL extcde (1)
    END IF
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Set variable and allocate arrays
    !
    ALLOCATE ( inputs(-nauxgr:ngrids), stat=istat )
    check_alloc_status( istat )
    nidata = ngrids
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Initialize parameters
    !
    DO i=-nauxgr, ngrids
      inputs(i)%TFN(1,:) = -1
      inputs(i)%TFN(2,:) =  0
      inputs(i)%TC0(1)   = -1
      inputs(i)%TC0(2)   =  0
      inputs(i)%TW0(1)   = -1
      inputs(i)%TW0(2)   =  0
      inputs(i)%TU0(1)   = -1
      inputs(i)%TU0(2)   =  0
      inputs(i)%TR0(1)   = -1
      inputs(i)%TR0(2)   =  0
      inputs(i)%TDN(1)   = -1
      inputs(i)%TDN(2)   =  0
      inputs(i)%TG0(1)   = -1
      inputs(i)%TG0(2)   =  0
      inputs(i)%GA0      = 0.
      inputs(i)%GD0      = 0.
      inputs(i)%GAN      = 0.
      inputs(i)%GDN      = 0.
      inputs(i)%IINIT    = .false.
      inputs(i)%INFLAGS1 = .false.
      inputs(i)%INFLAGS2 = .false.
      inputs(i)%FLAGSC   = .false.
    END DO
    !
#ifdef W3_T
    WRITE (ndst,9000) -nauxgr, ngrids
#endif
    !
    RETURN
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR W3NINP : NGRIDS NOT YET SET *** '/         &
         '                    NGRIDS = ',i10/                   &
         '                    RUN W3NMOD FIRST'/)
    !
#ifdef W3_T
9000 FORMAT (' TEST W3NINP : SETTING UP FOR ',i2,' -',i3,' GRIDS')
#endif
    !/
    !/ End of W3NINP ----------------------------------------------------- /
    !/
  END SUBROUTINE w3ninp
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3dimi  ( IMOD, NDSE, NDST, FLAGSTIDEIN )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 !
    !/                  +-----------------------------------+
    !/
    !/    02-Apr-2004 : Origination.                        ( version 3.06 )
    !/    19-Jul-2006 : Adding auxiliary grids.             ( version 3.10 )
    !/    04-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
    !/    10-Dec-2014 : Add checks for allocate status      ( version 5.04 )
    !/    21-Jun-2018 : Add FSWND input for SMC grid. JGLi  ( version 6.04 )
    !/    22-Mar-2021 : Momentum and air density support    ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Initialize an individual data grid at the proper dimensions.
    !
    !  2. Method :
    !
    !     Allocate directly into the structure array. Note that
    !     this cannot be done through the pointer alias!
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number to point to.
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !     Main wave model drivers.
    !
    !  6. Error messages :
    !
    !     - Check on input parameters.
    !     - Check on previous allocation.
    !
    !  7. Remarks :
    !
    !     - W3SETI needs to be called after allocation to point to
    !       proper allocated arrays.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd,  ONLY: ngrids, nauxgr, igrid, w3setg, nx, ny
#ifdef W3_SMC
    USE w3gdatmd,  ONLY: fswnd, nsea
#endif
    USE w3servmd,  ONLY: extcde
#ifdef W3_S
    USE w3servmd,  ONLY: strace
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD, NDSE, NDST
    LOGICAL, INTENT(IN), OPTIONAL     :: FLAGSTIDEIN(4)
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: JGRID
    LOGICAL                 :: FLAGSTIDE(4)=.false.
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
    CALL strace (ient, 'W3DIMI')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( ngrids .EQ. -1 ) THEN
      WRITE (ndse,1001)
      CALL extcde (1)
    END IF
    !
    IF ( imod.LT.-nauxgr .OR. imod.GT.nidata ) THEN
      WRITE (ndse,1002) imod, -nauxgr, nidata
      CALL extcde (2)
    END IF
    !
    IF ( inputs(imod)%IINIT ) THEN
      WRITE (ndse,1003)
      CALL extcde (3)
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) imod
#endif
    !
    jgrid  = igrid
    IF ( jgrid .NE. imod ) CALL w3setg ( imod, ndse, ndst )
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Allocate arrays
    !
#ifdef W3_TIDE
    IF ( PRESENT(flagstidein) ) THEN
      flagstide(:) = flagstidein(:)
    END IF
#endif
 
    flic1  => inputs(imod)%INFLAGS1(-7)
    flic2  => inputs(imod)%INFLAGS1(-6)
    flic3  => inputs(imod)%INFLAGS1(-5)
    flic4  => inputs(imod)%INFLAGS1(-4)
    flic5  => inputs(imod)%INFLAGS1(-3)
    !
    flmdn  => inputs(imod)%INFLAGS1(-2)
    flmth  => inputs(imod)%INFLAGS1(-1)
    flmvs  => inputs(imod)%INFLAGS1(0)
    !
    fllev  => inputs(imod)%INFLAGS1(1)
    flcur  => inputs(imod)%INFLAGS1(2)
#ifdef W3_TIDE
    fllevtide  => inputs(imod)%INFLAGS1(11)
    flcurtide  => inputs(imod)%INFLAGS1(12)
    fllevresi  => inputs(imod)%INFLAGS1(13)
    flcurresi  => inputs(imod)%INFLAGS1(14)
    !
    fllevtide = flagstide(1)
    flcurtide = flagstide(2)
    fllevresi = flagstide(3)
    flcurresi = flagstide(4)
#endif
 
    flwind => inputs(imod)%INFLAGS1(3)
    flice  => inputs(imod)%INFLAGS1(4)
    fltaua => inputs(imod)%INFLAGS1(5)
    flrhoa => inputs(imod)%INFLAGS1(6)
    !
    ! notes: future improvement: flags for ICEPx should be
    !     "all or nothing" rather than 5 individual flags
 
    IF ( flic1  ) THEN
      ALLOCATE ( inputs(imod)%ICEP1(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    IF ( flic2  ) THEN
      ALLOCATE ( inputs(imod)%ICEP2(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    IF ( flic3  ) THEN
      ALLOCATE ( inputs(imod)%ICEP3(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    IF ( flic4  ) THEN
      ALLOCATE ( inputs(imod)%ICEP4(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    IF ( flic5  ) THEN
      ALLOCATE ( inputs(imod)%ICEP5(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    !
    IF ( flmdn  ) THEN
      ALLOCATE ( inputs(imod)%MUDD(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    IF ( flmth  ) THEN
      ALLOCATE ( inputs(imod)%MUDT(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    IF ( flmvs  ) THEN
      ALLOCATE ( inputs(imod)%MUDV(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    !
    IF ( fllev  ) THEN
      ALLOCATE ( inputs(imod)%WLEV(nx,ny), stat=istat )
      check_alloc_status( istat )
    END IF
    !
    IF ( flcur  ) THEN
#ifdef W3_SMC
      IF( fswnd ) THEN
        ALLOCATE ( inputs(imod)%CX0(nsea,1) ,              &
             inputs(imod)%CY0(nsea,1) ,              &
             inputs(imod)%CXN(nsea,1) ,              &
             inputs(imod)%CYN(nsea,1) , stat=istat )
      ELSE
#endif
        ALLOCATE ( inputs(imod)%CX0(nx,ny) ,              &
             inputs(imod)%CY0(nx,ny) ,              &
             inputs(imod)%CXN(nx,ny) ,              &
             inputs(imod)%CYN(nx,ny) , stat=istat )
#ifdef W3_SMC
      ENDIF
#endif
      check_alloc_status( istat )
    END IF
    !
#ifdef W3_TIDE
    IF ( fllevtide  ) THEN
      ALLOCATE ( inputs(imod)%WLTIDE(nx,ny,ntide,2), stat=istat )
      check_alloc_status( istat )
    END IF
    !
    IF ( flcurtide  ) THEN
      ALLOCATE ( inputs(imod)%CXTIDE(nx,ny,ntide,2),  &
           inputs(imod)%CYTIDE(nx,ny,ntide,2), stat=istat )
      check_alloc_status( istat )
    END IF
#endif
    !
 
#ifdef W3_WRST
    IF(.NOT.(inputs(imod)%WRSTIINIT)) THEN
      ALLOCATE (   inputs(imod)%WXNwrst(nx,ny) ,              &
           inputs(imod)%WYNwrst(nx,ny) , stat=istat )
      inputs(imod)%WRSTIINIT=.true.
    ENDIF
#endif
 
    IF ( flwind ) THEN
#ifdef W3_SMC
      IF( fswnd ) THEN
        ALLOCATE ( inputs(imod)%WX0(nsea,1) ,              &
             inputs(imod)%WY0(nsea,1) ,              &
             inputs(imod)%DT0(nsea,1) ,              &
             inputs(imod)%WXN(nsea,1) ,              &
             inputs(imod)%WYN(nsea,1) ,              &
             inputs(imod)%DTN(nsea,1) , stat=istat )
      ELSE
#endif
        ALLOCATE ( inputs(imod)%WX0(nx,ny) ,              &
             inputs(imod)%WY0(nx,ny) ,              &
             inputs(imod)%DT0(nx,ny) ,              &
             inputs(imod)%WXN(nx,ny) ,              &
             inputs(imod)%WYN(nx,ny) ,              &
             inputs(imod)%DTN(nx,ny) , stat=istat )
#ifdef W3_SMC
      ENDIF
#endif
      check_alloc_status( istat )
      inputs(imod)%DT0 = 0.
      inputs(imod)%DTN = 0.
    END IF
    !
    IF ( flice  ) THEN
      ALLOCATE ( inputs(imod)%ICEI(nx,ny),              &
           inputs(imod)%BERGI(nx,ny), stat=istat )
      check_alloc_status( istat )
      inputs(imod)%BERGI = 0.
    END IF
    !
    IF ( fltaua  ) THEN
#ifdef W3_SMC
      IF( fswnd ) THEN
        ALLOCATE ( inputs(imod)%UX0(nsea,1) ,              &
             inputs(imod)%UY0(nsea,1) ,              &
             inputs(imod)%UXN(nsea,1) ,              &
             inputs(imod)%UYN(nsea,1) , stat=istat )
      ELSE
#endif
        ALLOCATE ( inputs(imod)%UX0(nx,ny) ,              &
             inputs(imod)%UY0(nx,ny) ,              &
             inputs(imod)%UXN(nx,ny) ,              &
             inputs(imod)%UYN(nx,ny) , stat=istat )
#ifdef W3_SMC
      ENDIF
#endif
      check_alloc_status( istat )
    END IF
    !
    IF ( flrhoa  ) THEN
#ifdef W3_SMC
      IF( fswnd ) THEN
        ALLOCATE ( inputs(imod)%RH0(nsea,1) ,             &
             inputs(imod)%RHN(nsea,1) , stat=istat )
      ELSE
#endif
        ALLOCATE ( inputs(imod)%RH0(nx,ny) ,              &
             inputs(imod)%RHN(nx,ny) , stat=istat )
#ifdef W3_SMC
      ENDIF
#endif
      check_alloc_status( istat )
    END IF
    !
    inputs(imod)%IINIT  = .true.
    !
#ifdef W3_T
    WRITE (ndst,9001)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Point to allocated arrays
    !
    CALL w3seti ( imod, ndse, ndst )
    !
#ifdef W3_T
    WRITE (ndst,9002)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 4.  Update counters in grid
    !
#ifdef W3_T
    WRITE (ndst,9003)
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 5.  Restore previous grid setting if necessary
    !
    IF ( jgrid .NE. imod ) CALL w3setg ( jgrid, ndse, ndst )
    !
    RETURN
    !
    ! Check inputs for stresses
    IF(fltaua) THEN
#ifdef W3_FLX0
      WRITE (ndse,*) " *** WARNING W3DIMI : TAUA NOT USED *** "
#endif
#ifdef W3_FLX1
      WRITE (ndse,*) " *** WARNING W3DIMI : TAUA NOT USED *** "
#endif
#ifdef W3_FLX2
      WRITE (ndse,*) " *** WARNING W3DIMI : TAUA NOT USED *** "
#endif
#ifdef W3_FLX3
      WRITE (ndse,*) " *** WARNING W3DIMI : TAUA NOT USED *** "
#endif
#ifdef W3_FLX4
      WRITE (ndse,*) " *** WARNING W3DIMI : TAUA NOT USED *** "
#endif
    END IF
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR W3DIMI : GRIDS NOT INITIALIZED *** '/      &
         '                    RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR W3DIMI : ILLEGAL MODEL NUMBER *** '/       &
         '                    IMOD   = ',i10/                   &
         '                    NAUXGR = ',i10/                   &
         '                    NIDATA = ',i10/)
1003 FORMAT (/' *** ERROR W3DIMI : ARRAY(S) ALREADY ALLOCATED *** ')
    !
#ifdef W3_T
9000 FORMAT (' TEST W3DIMI : MODEL ',i4,' DIM. AT ',2i5,i7)
9001 FORMAT (' TEST W3DIMI : ARRAYS ALLOCATED')
9002 FORMAT (' TEST W3DIMI : POINTERS RESET')
9003 FORMAT (' TEST W3DIMI : DIMENSIONS STORED')
#endif
    !/
    !/ End of W3DIMI ----------------------------------------------------- /
    !/
  END SUBROUTINE w3dimi
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3seti ( IMOD, NDSE, NDST )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 !
    !/                  +-----------------------------------+
    !/
    !/    02-Apr-2004 : Origination.                        ( version 3.06 )
    !/    19-Jul-2006 : Adding auxiliary grids.             ( version 3.10 )
    !/    04-Oct-2006 : Add filter to array pointers.       ( version 3.10 )
    !/    22-Mar-2021 : Momentum and air density support    ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Select one of the WAVEWATCH III grids / models.
    !
    !  2. Method :
    !
    !     Point pointers to the proper variables in the proper element of
    !     the GRIDS array.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       IMOD    Int.   I   Model number to point to.
    !       NDSE    Int.   I   Error output unit number.
    !       NDST    Int.   I   Test output unit number.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     See module documentation.
    !
    !  5. Called by :
    !
    !     Any subroutine.
    !
    !  6. Error messages :
    !
    !     Many subroutines in the WAVEWATCH system.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !  9. Switches :
    !
    !     !/S    Enable subroutine tracing.
    !     !/T    Enable test output
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: nauxgr
    !
    USE w3servmd, ONLY: extcde
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: IMOD, NDSE, NDST
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
    CALL strace (ient, 'W3SETI')
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 1.  Test input and module status
    !
    IF ( nidata .EQ. -1 ) THEN
      WRITE (ndse,1001)
      CALL extcde (1)
    END IF
    !
    IF ( imod.LT.-nauxgr .OR. imod.GT.nidata ) THEN
      WRITE (ndse,1002) imod, -nauxgr, nidata
      CALL extcde (2)
    END IF
    !
#ifdef W3_T
    WRITE (ndst,9000) imod
#endif
    !
    ! -------------------------------------------------------------------- /
    ! 2.  Set model numbers
    !
    iidata = imod
    !
    ! -------------------------------------------------------------------- /
    ! 3.  Set pointers
    !
    tfn    => inputs(imod)%TFN
    tc0    => inputs(imod)%TC0
    tw0    => inputs(imod)%TW0
    tu0    => inputs(imod)%TU0
    tr0    => inputs(imod)%TR0
    tg0    => inputs(imod)%TG0
    tdn    => inputs(imod)%TDN
    !
    ti1    => inputs(imod)%TFN(:,-7)
    ti2    => inputs(imod)%TFN(:,-6)
    ti3    => inputs(imod)%TFN(:,-5)
    ti4    => inputs(imod)%TFN(:,-4)
    ti5    => inputs(imod)%TFN(:,-3)
    !
    tzn    => inputs(imod)%TFN(:,-2)
    ttn    => inputs(imod)%TFN(:,-1)
    tvn    => inputs(imod)%TFN(:,0)
    !
    tln    => inputs(imod)%TFN(:,1)
    tcn    => inputs(imod)%TFN(:,2)
    twn    => inputs(imod)%TFN(:,3)
    tin    => inputs(imod)%TFN(:,4)
    tun    => inputs(imod)%TFN(:,5)
    trn    => inputs(imod)%TFN(:,6)
    t0n    => inputs(imod)%TFN(:,7)
    t1n    => inputs(imod)%TFN(:,8)
    t2n    => inputs(imod)%TFN(:,9)
    tgn    => inputs(imod)%TFN(:,10)
    !
    ga0    => inputs(imod)%GA0
    gd0    => inputs(imod)%GD0
    gan    => inputs(imod)%GAN
    gdn    => inputs(imod)%GDN
    !
    iinit  => inputs(imod)%IINIT
    inflags1  => inputs(imod)%INFLAGS1
    inflags2  => inputs(imod)%INFLAGS2
    flagsc => inputs(imod)%FLAGSC
    !
    flic1  => inputs(imod)%INFLAGS1(-7)
    flic2  => inputs(imod)%INFLAGS1(-6)
    flic3  => inputs(imod)%INFLAGS1(-5)
    flic4  => inputs(imod)%INFLAGS1(-4)
    flic5  => inputs(imod)%INFLAGS1(-3)
    !
    flmdn  => inputs(imod)%INFLAGS1(-2)
    flmth  => inputs(imod)%INFLAGS1(-1)
    flmvs  => inputs(imod)%INFLAGS1(0)
    !
    fllev  => inputs(imod)%INFLAGS1(1)
    flcur  => inputs(imod)%INFLAGS1(2)
#ifdef W3_TIDE
    fllevtide  => inputs(imod)%INFLAGS1(11)
    flcurtide  => inputs(imod)%INFLAGS1(12)
    fllevresi  => inputs(imod)%INFLAGS1(13)
    flcurresi  => inputs(imod)%INFLAGS1(14)
#endif
 
    flwind => inputs(imod)%INFLAGS1(3)
    flice  => inputs(imod)%INFLAGS1(4)
    fltaua => inputs(imod)%INFLAGS1(5)
    flrhoa => inputs(imod)%INFLAGS1(6)
    !
    IF ( iinit ) THEN
      !
      IF ( flic1  ) THEN
        icep1  => inputs(imod)%ICEP1
      END IF
      IF ( flic2  ) THEN
        icep2  => inputs(imod)%ICEP2
      END IF
      IF ( flic3  ) THEN
        icep3  => inputs(imod)%ICEP3
      END IF
      IF ( flic4  ) THEN
        icep4  => inputs(imod)%ICEP4
      END IF
      IF ( flic5  ) THEN
        icep5  => inputs(imod)%ICEP5
      END IF
      !
      IF ( flmdn  ) THEN
        mudd   => inputs(imod)%MUDD
      END IF
      IF ( flmth  ) THEN
        mudt   => inputs(imod)%MUDT
      END IF
      IF ( flmvs  ) THEN
        mudv   => inputs(imod)%MUDV
      END IF
      !
      IF ( fllev  ) THEN
        wlev   => inputs(imod)%WLEV
      END IF
      !
      IF ( flcur  ) THEN
        cx0    => inputs(imod)%CX0
        cy0    => inputs(imod)%CY0
        cxn    => inputs(imod)%CXN
        cyn    => inputs(imod)%CYN
      END IF
#ifdef W3_TIDE
      IF ( fllevtide ) THEN
        wltide => inputs(imod)%WLTIDE
      END IF
      IF ( flcurtide ) THEN
        cxtide => inputs(imod)%CXTIDE
        cytide => inputs(imod)%CYTIDE
      END IF
#endif
      !
#ifdef W3_WRST
      wxnwrst    => inputs(imod)%WXNwrst
      wynwrst    => inputs(imod)%WYNwrst
#endif
 
      IF ( flwind  ) THEN
        wx0    => inputs(imod)%WX0
        wy0    => inputs(imod)%WY0
        dt0    => inputs(imod)%DT0
        wxn    => inputs(imod)%WXN
        wyn    => inputs(imod)%WYN
        dtn    => inputs(imod)%DTN
      END IF
      !
      IF ( flice  ) THEN
        icei   => inputs(imod)%ICEI
        bergi  => inputs(imod)%BERGI
      END IF
      !
      IF ( fltaua  ) THEN
        ux0    => inputs(imod)%UX0
        uy0    => inputs(imod)%UY0
        uxn    => inputs(imod)%UXN
        uyn    => inputs(imod)%UYN
      END IF
      !
      IF ( flrhoa  ) THEN
        rh0    => inputs(imod)%RH0
        rhn    => inputs(imod)%RHN
      END IF
      !
    END IF
    !
    RETURN
    !
    ! Formats
    !
1001 FORMAT (/' *** ERROR W3SETI : GRIDS NOT INITIALIZED *** '/      &
         '                    RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR W3SETI : ILLEGAL MODEL NUMBER *** '/       &
         '                    IMOD   = ',i10/                   &
         '                    NAUXGR = ',i10/                   &
         '                    NIDATA = ',i10/)
    !
#ifdef W3_T
9000 FORMAT (' TEST W3SETI : MODEL ',i4,' SELECTED')
#endif
    !/
    !/ End of W3SETI ----------------------------------------------------- /
    !/
  END SUBROUTINE w3seti
  !/
  !/ End of module W3IDATMD -------------------------------------------- /
  !/
END MODULE w3idatmd