w3src1md.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
 
!/ ------------------------------------------------------------------- /
MODULE w3src1md
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         29-May-2009 |
  !/                  +-----------------------------------+
  !/
  !/    06-Dec-1996 : Final FORTRAN 77                    ( version 1.18 )
  !/    06-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
  !/    23-Dec-2004 : Multiple grid version.              ( version 3.06 )
  !/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
  !/
  !/    Copyright 2009 National Weather Service (NWS),
  !/       National Oceanic and Atmospheric Administration.  All rights
  !/       reserved.  WAVEWATCH III is a trademark of the NWS.
  !/       No unauthorized use without permission.
  !/
  !  1. Purpose :
  !
  !     Bundle WAM cycle 3 input and dissipation source terms with
  !     their defining parameters.
  !
  !  2. Variables and types :
  !
  !  3. Subroutines and functions :
  !
  !      Name      Type  Scope    Description
  !     ----------------------------------------------------------------
  !      W3SPR1    Subr. Public   Mean parameters from spectrum.
  !      W3SIN1    Subr. Public   Input source term.
  !      W3SDS1    Subr. Public   Dissipation source term.
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name      Type  Module   Description
  !     ----------------------------------------------------------------
  !      STRACE    Subr. W3SERVMD Subroutine tracing.            ( !/S )
  !      PRT2DS    Subr. W3ARRYMD Print plot of spectra.        ( !/T0 )
  !      OUTMAT    Subr. W3WRRYMD Print out 2D matrix.          ( !/T1 )
  !     ----------------------------------------------------------------
  !
  !  5. Remarks :
  !
  !  6. Switches :
  !
  !       !/S      Enable subroutine tracing.
  !       !/T(n)   Test output, see subroutines.
  !
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  !/
  PUBLIC
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3spr1 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         23-Dec-2004 |
    !/                  +-----------------------------------+
    !/
    !/    06-Dec-1996 : Final FORTRAN 77                    ( version 1.18 )
    !/    06-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    23-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/
    !  1. Purpose :
    !
    !     Calculate mean wave parameters for the use in the source term
    !     routines. (WAM-3)
    !
    !  2. Method :
    !
    !     See source term routines.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       A       R.A.  I   Action as a function of direction and
    !                         wavenumber.
    !       CG      R.A.  I   Group velocities.
    !       WN      R.A.  I   Wavenumbers.
    !       EMEAN   Real  O   Mean wave energy.
    !       FMEAN   Real  O   Mean wave frequency.
    !       WNMEAN  Real  O   Mean wavenumber.
    !       AMAX    Real  O   Maximum action density in spectrum.
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SRCE    Subr. W3SRCEMD Source term integration.
    !      W3EXPO    Subr.   N/A    Point output post-processor.
    !      GXEXPO    Subr.   N/A    GrADS point output post-processor.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     None.
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S  Enable subroutine tracing.
    !     !/T  Enable test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE constants
    USE w3gdatmd, ONLY: nk, nth, sig, dden, fte, ftf, ftwn
#ifdef W3_T
    USE w3odatmd, ONLY: ndst
#endif
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    REAL, INTENT(IN)        :: A(NTH,NK), CG(NK), WN(NK)
    REAL, INTENT(OUT)       :: EMEAN, FMEAN, WNMEAN, AMAX
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: IK, ITH
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    REAL                    :: EB(NK), EBAND
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3SPR1')
#endif
    !
    emean  = 0.
    fmean  = 0.
    wnmean = 0.
    amax   = 0.
    !
    ! 1.  Integral over directions
    !
    DO ik=1, nk
      eb(ik) = 0.
      DO ith=1, nth
        eb(ik) = eb(ik) + a(ith,ik)
        amax   = max( amax , a(ith,ik) )
      END DO
    END DO
    !
    ! 2.  Integrate over directions
    !
    DO ik=1, nk
      eb(ik) = eb(ik) * dden(ik) / cg(ik)
      emean  = emean  + eb(ik)
      fmean  = fmean  + eb(ik) / sig(ik)
      wnmean = wnmean + eb(ik) / sqrt(wn(ik))
    END DO
    !
    ! 3.  Add tail beyond discrete spectrum
    !     ( DTH * SIG absorbed in FTxx )
    !
    eband  = eb(nk) / dden(nk)
    emean  = emean  + eband * fte
    fmean  = fmean  + eband * ftf
    wnmean = wnmean + eband * ftwn
    !
    ! 4.  Final processing
    !
    fmean  = tpiinv * emean / max( 1.e-7 , fmean )
    wnmean = ( emean / max( 1.e-7 , wnmean ) )**2
    !
#ifdef W3_T
    WRITE (ndst,9000) emean, fmean, wnmean
#endif
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT (' TEST W3SPR1 : E,F,WN MEAN ',3e10.3)
#endif
    !/
    !/ End of W3SPR1 ----------------------------------------------------- /
    !/
  END SUBROUTINE w3spr1
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3sin1 (A, K, USTAR, USDIR, S, D)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         23-Dec-2004 |
    !/                  +-----------------------------------+
    !/
    !/    05-Dec-1996 : Final FORTRAN 77                    ( version 1.18 )
    !/    08-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    23-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/
    !  1. Purpose :
    !
    !     Calculate diagonal of input source (actual source term put
    !     together in W3SRCE).
    !
    !  2. Method :
    !
    !       WAM-3 : Snyder et al. (1981), Komen et al. (1984).
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       A       R.A.  I   Action density spectrum (1-D).
    !       K       R.A.  I   Wavenumber for entire spectrum.          *)
    !       USTAR   Real  I   Friction velocity.
    !       USDIR   Real  I   Direction of USTAR.
    !       S       R.A.  O   Source term (1-D version).
    !       D       R.A.  O   Diagonal term of derivative.             *)
    !     ----------------------------------------------------------------
    !                         *) Stored as 1-D array with dimension NTH*NK
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !      PRT2DS    Subr. W3SRRYMD Print plot of spectrum.
    !      OUTMAT    Subr. W3SRRYMD Print out matrix.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SRCE    Subr. W3SRCEMD Source term integration.
    !      W3EXPO    Subr.   N/A    Point output post-processor.
    !      GXEXPO    Subr.   N/A    GrADS point output post-processor.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S   Enable subroutine tracing.
    !     !/T   Enable general test output.
    !     !/T0  2-D print plot of source term.
    !     !/T1  Print arrays.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
#ifdef W3_T
    USE constants
#endif
    USE w3gdatmd, ONLY: nk, nth, nspec, sig, sig2, esin, ecos, sinc1
#ifdef W3_T
    USE w3odatmd, ONLY: ndst
#endif
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
#ifdef W3_T0
    USE w3arrymd, ONLY: prt2ds
#endif
#ifdef W3_T1
    USE w3arrymd, ONLY: outmat
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    REAL, INTENT(IN)        :: A(NSPEC), K(NSPEC), USTAR, USDIR
    REAL, INTENT(OUT)       :: S(NSPEC), D(NSPEC)
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: IS
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_T0
    INTEGER                 :: IK, ITH
#endif
    REAL                    :: COSU, SINU
#ifdef W3_T0
    REAL                    :: DOUT(NK,NTH)
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3SIN1')
#endif
    !
#ifdef W3_T
    WRITE (ndst,9000) sinc1, ustar, usdir*rade
#endif
    !
    ! 1.  Preparations
    !
    cosu   = cos(usdir)
    sinu   = sin(usdir)
    !
    ! 2.  Diagonal
    !
    DO is=1, nspec
      d(is) = sinc1 * sig2(is) * max( 0. ,                         &
           ( ustar * (ecos(is)*cosu+esin(is)*sinu)                  &
           * k(is)/sig2(is) - 0.035714) )
    END DO
    !
    s = d * a
    !
    ! ... Test output of arrays
    !
#ifdef W3_T0
    DO ik=1, nk
      DO ith=1, nth
        dout(ik,ith) = d(ith+(ik-1)*nth)
      END DO
    END DO
    CALL prt2ds (ndst, nk, nk, nth, dout, sig(1:), '  ', 1.,    &
         0.0, 0.001, 'Diag Sin', ' ', 'NONAME')
#endif
    !
#ifdef W3_T1
    CALL outmat (ndst, d, nth, nth, nk, 'diag Sin')
#endif
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT (' TEST W3SIN1 : COMMON FACT.: ',3e10.3)
#endif
    !/
    !/ End of W3SIN1 ----------------------------------------------------- /
    !/
  END SUBROUTINE w3sin1
  !/ ------------------------------------------------------------------- /
  SUBROUTINE w3sds1 (A, K, EMEAN, FMEAN, WNMEAN, S, D)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         23-Dec-2004 |
    !/                  +-----------------------------------+
    !/
    !/    05-Dec-1996 : Final FORTRAN 77                    ( version 1.18 )
    !/    08-Dec-1999 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/    23-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/
    !  1. Purpose :
    !
    !     Calculate whitecapping source term and diagonal term of derivative.
    !
    !  2. Method :
    !
    !       WAM-3
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       A       R.A.  I   Action density spectrum (1-D).
    !       K       R.A.  I   Wavenumber for entire spectrum.          *)
    !       EMEAN   Real  I   Mean wave energy.
    !       FMEAN   Real  I   Mean wave frequency.
    !       WNMEAN  Real  I   Mean wavenumber.
    !       S       R.A.  O   Source term (1-D version).
    !       D       R.A.  O   Diagonal term of derivative.             *)
    !     ----------------------------------------------------------------
    !                         *) Stored in 1-D array with dimension NTH*NK
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      STRACE    Subr. W3SERVMD Subroutine tracing.
    !      PRT2DS    Subr. W3SRRYMD Print plot of spectrum.
    !      OUTMAT    Subr. W3SRRYMD Print out matrix.
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SRCE    Subr. W3SRCEMD Source term integration.
    !      W3EXPO    Subr.   N/A    Point output post-processor.
    !      GXEXPO    Subr.   N/A    GrADS point output post-processor.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !  7. Remarks :
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S   Enable subroutine tracing.
    !     !/T   Enable general test output.
    !     !/T0  2-D print plot of source term.
    !     !/T1  Print arrays.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3gdatmd, ONLY: nk, nth, nspec, sig, sdsc1
#ifdef W3_T
    USE w3odatmd, ONLY: ndst
#endif
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
#ifdef W3_T0
    USE w3arrymd, ONLY: prt2ds
#endif
#ifdef W3_T1
    USE w3arrymd, ONLY: outmat
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    REAL, INTENT(IN)        :: A(NSPEC), K(NSPEC),                  &
         EMEAN, FMEAN, WNMEAN
    REAL, INTENT(OUT)       :: S(NSPEC), D(NSPEC)
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: IS
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
#ifdef W3_T0
    INTEGER                 :: IK, ITH
#endif
    REAL                    :: FACTOR
#ifdef W3_T0
    REAL                    :: DOUT(NK,NTH)
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3SDS1')
#endif
    !
    ! 1.  Common factor
    !
    factor = sdsc1 * fmean * wnmean**3 * emean**2
    !
#ifdef W3_T
    WRITE (ndst,9000) sdsc1, fmean, wnmean, emean, factor
#endif
    !
    ! 3.  Source term
    !
    d = factor * k
    s = d * a
    !
    ! ... Test output of arrays
    !
#ifdef W3_T0
    DO ik=1, nk
      DO ith=1, nth
        dout(ik,ith) = d(ith+(ik-1)*nth)
      END DO
    END DO
    CALL prt2ds (ndst, nk, nk, nth, dout, sig(1:), '  ', 1.,    &
         0.0, 0.001, 'Diag Sds', ' ', 'NONAME')
#endif
    !
#ifdef W3_T1
    CALL outmat (ndst, d, nth, nth, nk, 'diag Sds')
#endif
    !
    RETURN
    !
    ! Formats
    !
#ifdef W3_T
9000 FORMAT (' TEST W3SDS1 : COMMON FACT.: ',5e10.3)
#endif
    !/
    !/ End of W3SDS1 ----------------------------------------------------- /
    !/
  END SUBROUTINE w3sds1
  !/
  !/ End of module W3SRC1MD -------------------------------------------- /
  !/
END MODULE w3src1md