#include "w3macros.h"
!/ ------------------------------------------------------------------- /
MODULE W3WDATMD
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | H. L. Tolman |
!/ | FORTRAN 90 |
!/ | Last update : 10-Dec-2014 |
!/ +-----------------------------------+
!/
!/ 22-Oct-2004 : Origination. ( version 3.06 )
!/ 13-Jun-2006 : Allocate VA consistent with MPI ( version 3.09 )
!/ data types and initialize as needed.
!/ 05-Jul-2006 : Consolidate stress vector. ( version 3.09 )
!/ 04-Oct-2006 : Add filter to array pointers. ( version 3.10 )
!/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
!/ 16-May-2010 : Add iceberg damping ( version 3.14.4 )
!/ 14-Nov-2013 : Initialize UST and USTDIR. ( version 4.13 )
!/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
!/
!/ Copyright 2009-2013 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 dynamic data for
! several models simultaneously.
!
! 2. Variables and types :
!
! Name Type Scope Description
! ----------------------------------------------------------------
! NWDATA Int. Public Number of models in array dim.
! IWDATA Int. Public Selected model for output, init. at -1.
! WDATA TYPE Public Basic data structure.
! WDATAS WDATA Public Array of data structures.
! ----------------------------------------------------------------
!
! All elements of WDATA are aliased to pointers with the same
! name. These pointers are defined as :
!
! Name Type Scope Description
! ----------------------------------------------------------------
! TIME I.A. Public Valid time for spectra.
! TIME00 I.A. Public Initial time
! TIMEEND I.A. Public Final time
! TLEV I.A. Public Valid time for water levels.
! TICE I.A. Public Valid time for ice concentration
! TIC1 I.A. Public Valid time for ice thickness
! TIC5 I.A. Public Valid time for ice floe
! VA R.A. Public Storage array for spectra.
! WLV R.A. Public Water levels.
! ICE R.A. Public Ice coverage.
! ICEH R.A. Public Ice thickness.
! ICEF R.A. Public Ice flow maximum diameter.
! ICEDMAX R.A. Public Ice flow maximum diameter for updates.
! BERG R.A. Public Iceberg damping.
! UST R.A. Public Friction velocity (absolute).
! USTDIR R.A. Public Friction velocity direction.
! ASF R.A. Public Stability correction factor.
! FPIS R.A. Public Input peak frequencies.
! DINIT Log. Public Flag for array initialization.
! FL_ALL Log. Public Flag for initializing all arrays,
! otherwise VA is skipped.
! ----------------------------------------------------------------
!
! 3. Subroutines and functions :
!
! Name Type Scope Description
! ----------------------------------------------------------------
! W3NDAT Subr. Public Set number of grids/models.
! W3DIMW Subr. Public Set dimensions of arrays.
! W3SETW 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.
!
! 6. Switches :
!
! !/S Enable subroutine tracing.
! !/T Enable test output
!
! 7. Source code :
!
!/ ------------------------------------------------------------------- /
PUBLIC
!/
!/ Module private variable for checking error returns
!/
INTEGER, PRIVATE :: ISTAT
!/
!/ Conventional declarations
!/
INTEGER :: NWDATA = -1, IWDATA = -1
!/
!/ Data structures
!/
TYPE WDATA
INTEGER :: TIME(2), TLEV(2), TICE(2), TIC1(2), TIC5(2)
!/OASIS INTEGER :: TIME00(2)
!/OASIS INTEGER :: TIMEEND(2)
!/COAWST INTEGER :: TIMEEND(2)
REAL, POINTER :: VA(:,:), WLV(:), ICE(:), UST(:), &
USTDIR(:), ASF(:), FPIS(:), BERG(:), &
ICEH(:), ICEF(:), ICEDMAX(:)
LOGICAL :: DINIT, FL_ALL
END TYPE WDATA
!
!/
!/ Data storage
!/
TYPE(WDATA), TARGET, ALLOCATABLE :: WDATAS(:)
!/
!/ Data aliasses for structure WDATA(S)
!/
INTEGER, POINTER :: TIME(:), TLEV(:), TICE(:), TIC1(:), TIC5(:)
!/OASIS INTEGER, POINTER :: TIME00(:)
!/OASIS INTEGER, POINTER :: TIMEEND(:)
!/COAWST INTEGER, POINTER :: TIMEEND(:)
REAL, POINTER :: VA(:,:), WLV(:), ICE(:), UST(:), &
USTDIR(:), ASF(:), FPIS(:), BERG(:), &
ICEH(:), ICEF(:), ICEDMAX(:)
LOGICAL, POINTER :: DINIT, FL_ALL
!/
CONTAINS
!/ ------------------------------------------------------------------- /
SUBROUTINE W3NDAT ( NDSE, NDST )
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | H. L. Tolman |
!/ | FORTRAN 90 |
!/ | Last update : 10-Dec-2014 !
!/ +-----------------------------------+
!/
!/ 31-Mar-2004 : Origination. ( version 3.06 )
!/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
!/
! 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
USE W3SERVMD, ONLY: EXTCDE
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
INTEGER :: I
!/S INTEGER, SAVE :: IENT = 0
!/
!/S CALL STRACE (IENT, 'W3NDAT')
!
! -------------------------------------------------------------------- /
! 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 ( WDATAS(0:NGRIDS), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
NWDATA = NGRIDS
!
! -------------------------------------------------------------------- /
! 3. Initialize parameters
!
DO I=0, NGRIDS
WDATAS(I)%DINIT = .FALSE.
WDATAS(I)%FL_ALL = .FALSE.
END DO
!
!/T WRITE (NDST,9000) NGRIDS
!
RETURN
!
! Formats
!
1001 FORMAT (/' *** ERROR W3NDAT : NGRIDS NOT YET SET *** '/ &
' NGRIDS = ',I10/ &
' RUN W3NMOD FIRST'/)
!
!/T 9000 FORMAT (' TEST W3NDAT : SETTING UP FOR ',I4,' GRIDS')
!/
!/ End of W3NDAT ----------------------------------------------------- /
!/
END SUBROUTINE W3NDAT
!/ ------------------------------------------------------------------- /
SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY )
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | H. L. Tolman |
!/ | FORTRAN 90 |
!/ | Last update : 10-Dec-2014 !
!/ +-----------------------------------+
!/
!/ 22-Oct-2004 : Origination. ( version 3.06 )
!/ 13-Jun-2006 : Allocate VA consistent with MPI ( version 3.09 )
!/ data types and initialize as needed.
!/ 05-Jul-2006 : Consolidate stress vector. ( version 3.09 )
!/ 04-Oct-2006 : Add filter to array pointers. ( version 3.10 )
!/ 14-Nov-2013 : Initialize UST and USTDIR. ( version 4.13 )
!/ 10-Dec-2014 : Add checks for allocate status ( version 5.04 )
!/
! 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.
! F_ONLY L.O. I FLag for initializing field arrays only.
! ----------------------------------------------------------------
!
! 4. Subroutines used :
!
! See module documentation.
!
! 5. Called by :
!
! Name Type Module Description
! ----------------------------------------------------------------
! W3IOGO Subr. W3IOGOMD Grid output IO routine.
! W3IORS Subr. W3IORSMD Restart file IO routine.
! WW3_SHEL Prog. N/A Main wave model driver.
! WW3_STRT Prog. N/A Initial conditions program.
! ----------------------------------------------------------------
!
! 6. Error messages :
!
! - Check on input parameters.
! - Check on previous allocation.
!
! 7. Remarks :
!
! - W3SETW 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, IGRID, W3SETG, NSPEC, NSEA, NSEAL, GRIDS
USE W3ODATMD, ONLY: NAPROC
USE W3SERVMD, ONLY: EXTCDE
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, NDSE, NDST
LOGICAL, INTENT(IN), OPTIONAL :: F_ONLY
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
INTEGER :: JGRID, NSEALM, NSEATM
!/S INTEGER, SAVE :: IENT = 0
!/
!/S CALL STRACE (IENT, 'W3DIMW')
!
! -------------------------------------------------------------------- /
! 1. Test input and module status
!
IF ( PRESENT(F_ONLY) ) THEN
FL_ALL = .NOT. F_ONLY
ELSE
FL_ALL = .TRUE.
END IF
!
IF ( NGRIDS .EQ. -1 ) THEN
WRITE (NDSE,1001)
CALL EXTCDE (1)
END IF
!
IF ( IMOD.LT.1 .OR. IMOD.GT.NWDATA ) THEN
WRITE (NDSE,1002) IMOD, NWDATA
CALL EXTCDE (2)
END IF
!
IF ( WDATAS(IMOD)%DINIT ) THEN
WRITE (NDSE,1003)
CALL EXTCDE (3)
END IF
!
!/T WRITE (NDST,9000) IMOD
!
JGRID = IGRID
IF ( JGRID .NE. IMOD ) CALL W3SETG ( IMOD, NDSE, NDST )
!
! -------------------------------------------------------------------- /
! 2. Allocate arrays
!
NSEALM = 1 + (NSEA-1)/NAPROC
NSEATM = NSEALM * NAPROC
!
IF ( FL_ALL ) THEN
ALLOCATE ( WDATAS(IMOD)%VA(NSPEC,0:NSEALM), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
IF ( NSEAL .NE. NSEALM ) WDATAS(IMOD)%VA(:,NSEALM) = 0.
END IF
!
ALLOCATE ( WDATAS(IMOD)%WLV(NSEA), &
WDATAS(IMOD)%ICE(0:NSEA), &
WDATAS(IMOD)%BERG(NSEA), &
WDATAS(IMOD)%ICEH(0:NSEA), &
WDATAS(IMOD)%ICEF(0:NSEA), &
WDATAS(IMOD)%ICEDMAX(0:NSEA), &
WDATAS(IMOD)%UST(0:NSEATM), &
WDATAS(IMOD)%USTDIR(0:NSEATM), &
WDATAS(IMOD)%ASF(NSEATM), &
WDATAS(IMOD)%FPIS(NSEATM), STAT=ISTAT )
CHECK_ALLOC_STATUS ( ISTAT )
!
WDATAS(IMOD)%UST (:) = 1.E-5
WDATAS(IMOD)%USTDIR(:) = 0.
WDATAS(IMOD)%BERG (:) = 0.
WDATAS(IMOD)%ICE (:) = 0.
WDATAS(IMOD)%ICEH (:) = GRIDS(IMOD)%IICEHINIT
WDATAS(IMOD)%ICEF (:) = 1000.
WDATAS(IMOD)%ICEDMAX(:) = 1000.
WDATAS(IMOD)%DINIT = .TRUE.
CALL W3SETW ( IMOD, NDSE, NDST )
!
!/T WRITE (NDST,9003)
!
! -------------------------------------------------------------------- /
! 5. Restore previous grid setting if necessary
!
IF ( JGRID .NE. IMOD ) CALL W3SETG ( JGRID, NDSE, NDST )
!
RETURN
!
! Formats
!
1001 FORMAT (/' *** ERROR W3DIMW : GRIDS NOT INITIALIZED *** '/ &
' RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR W3DIMW : ILLEGAL MODEL NUMBER *** '/ &
' IMOD = ',I10/ &
' NWDATA = ',I10/)
1003 FORMAT (/' *** ERROR W3DIMW : ARRAY(S) ALREADY ALLOCATED *** ')
!
!/T 9000 FORMAT (' TEST W3DIMW : MODEL ',I4,' DIM. AT ',2I5,I7)
!
!/T WRITE (NDST,9001)
!
! -------------------------------------------------------------------- /
! 3. Point to allocated arrays
!
CALL W3SETW ( IMOD, NDSE, NDST )
!
!/T WRITE (NDST,9002)
!
! -------------------------------------------------------------------- /
! 4. Update counters in grid
!/T 9001 FORMAT (' TEST W3DIMW : ARRAYS ALLOCATED')
!/T 9002 FORMAT (' TEST W3DIMW : POINTERS RESET')
!/T 9003 FORMAT (' TEST W3DIMW : DIMENSIONS STORED')
!/
!/ End of W3DIMW ----------------------------------------------------- /
!/
END SUBROUTINE W3DIMW
!/ ------------------------------------------------------------------- /
SUBROUTINE W3SETW ( IMOD, NDSE, NDST )
!/
!/ +-----------------------------------+
!/ | WAVEWATCH III NOAA/NCEP |
!/ | H. L. Tolman |
!/ | FORTRAN 90 |
!/ | Last update : 04-Oct-2006 !
!/ +-----------------------------------+
!/
!/ 31-Mar-2004 : Origination. ( version 3.06 )
!/ 05-Jul-2006 : Consolidate stress vector. ( version 3.09 )
!/ 04-Oct-2006 : Add filter to array pointers. ( version 3.10 )
!/
! 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 :
!
! Many subroutines in the WAVEWATCH system.
!
! 6. Error messages :
!
! Checks on parameter list IMOD.
!
! 7. Remarks :
!
! 8. Structure :
!
! 9. Switches :
!
! !/S Enable subroutine tracing.
! !/T Enable test output
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
USE W3SERVMD, ONLY: EXTCDE
!/S USE W3SERVMD, ONLY: STRACE
!
IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
INTEGER, INTENT(IN) :: IMOD, NDSE, NDST
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
!/S INTEGER, SAVE :: IENT = 0
!/
!/S CALL STRACE (IENT, 'W3SETW')
!
! -------------------------------------------------------------------- /
! 1. Test input and module status
!
IF ( NWDATA .EQ. -1 ) THEN
WRITE (NDSE,1001)
CALL EXTCDE (1)
END IF
!
IF ( IMOD.LT.0 .OR. IMOD.GT.NWDATA ) THEN
WRITE (NDSE,1002) IMOD, NWDATA
CALL EXTCDE (2)
END IF
!
!/T WRITE (NDST,9000) IMOD
!
! -------------------------------------------------------------------- /
! 2. Set model numbers
!
IWDATA = IMOD
!
! -------------------------------------------------------------------- /
! 3. Set pointers
!
TIME => WDATAS(IMOD)%TIME
!/OASIS TIME00 => WDATAS(IMOD)%TIME00
!/OASIS TIMEEND => WDATAS(IMOD)%TIMEEND
!/COAWST TIMEEND => WDATAS(IMOD)%TIMEEND
TLEV => WDATAS(IMOD)%TLEV
TICE => WDATAS(IMOD)%TICE
TIC1 => WDATAS(IMOD)%TIC1
TIC5 => WDATAS(IMOD)%TIC5
DINIT => WDATAS(IMOD)%DINIT
FL_ALL => WDATAS(IMOD)%FL_ALL
!
IF ( DINIT ) THEN
IF ( FL_ALL ) VA => WDATAS(IMOD)%VA
WLV => WDATAS(IMOD)%WLV
ICE => WDATAS(IMOD)%ICE
BERG => WDATAS(IMOD)%BERG
ICEH => WDATAS(IMOD)%ICEH
ICEF => WDATAS(IMOD)%ICEF
ICEDMAX=> WDATAS(IMOD)%ICEDMAX
UST => WDATAS(IMOD)%UST
USTDIR => WDATAS(IMOD)%USTDIR
ASF => WDATAS(IMOD)%ASF
FPIS => WDATAS(IMOD)%FPIS
END IF
!
RETURN
!
! Formats
!
1001 FORMAT (/' *** ERROR W3SETW : GRIDS NOT INITIALIZED *** '/ &
' RUN W3NMOD FIRST '/)
1002 FORMAT (/' *** ERROR W3SETW : ILLEGAL MODEL NUMBER *** '/ &
' IMOD = ',I10/ &
' NWDATA = ',I10/)
!
!/T 9000 FORMAT (' TEST W3SETW : MODEL ',I4,' SELECTED')
!/
!/ End of W3SETW ----------------------------------------------------- /
!/
END SUBROUTINE W3SETW
!/
!/ End of module W3WDATMD -------------------------------------------- /
!/
END MODULE W3WDATMD