WW3/w3sbt1md_8F90_source.html

#include "w3macros.h"

!/ ------------------------------------------------------------------- /

MODULE w3sbt1md

  !/

  !/                  +-----------------------------------+

  !/                  | WAVEWATCH III           NOAA/NCEP |

  !/                  |           H. L. Tolman            |

  !/                  |                        FORTRAN 90 |

  !/                  | Last update :         29-May-2009 |

  !/                  +-----------------------------------+

  !/

  !/    For updates see W3SBT1 documentation.

  !/

  !  1. Purpose :

  !

  !     JONSWAP bottom friction routine.

  !

  !  2. Variables and types :

  !

  !  3. Subroutines and functions :

  !

  !      Name      Type  Scope    Description

  !     ----------------------------------------------------------------

  !      W3SBT1    Subr. Public   JONSWAP source term.

  !     ----------------------------------------------------------------

  !

  !  4. Subroutines and functions used :

  !

  !     See subroutine documentation.

  !

  !  5. Remarks :

  !

  !  6. Switches :

  !

  !     See subroutine documentation.

  !

  !  7. Source code :

  !/

  !/ ------------------------------------------------------------------- /

  !/

  PUBLIC

  !/

CONTAINS

  !/ ------------------------------------------------------------------- /

  SUBROUTINE w3sbt1 (A, CG, WN, DEPTH, S, D)

    !/

    !/                  +-----------------------------------+

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         29-May-2009 |

    !/                  +-----------------------------------+

    !/

    !/    05-Dec-1996 : Final FORTRAN 77.                   ( version 1.18 )

    !/    08-Dec-1999 : Upgrade to FORTRAN 90.              ( version 2.00 )

    !/    20-Dec-2004 : Multiple model 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 :

    !

    !     Bottom friction source term according to the empirical JONSWAP

    !     formulation.

    !

    !  2. Method :

    !

    !              2 GAMMA   /    CG         \      SBTC1 /     \       .

    !       Sbt = ---------- | ------- - 0.5 | E  = ----- | ... | E    (1)

    !             GRAV DEPTH \  SI/WN        /      DEPTH \     /

    !

    !     Where GAMMA = -0.038 m2/s3 (JONSWAP)

    !                 = -0.067 m2/s3 (Bouws and Komen 1983)

    !

    !     In the routine, the constant 2 GAMMA / GRAV = SBTC1.

    !

    !  3. Parameters :

    !

    !     Parameter list

    !     ----------------------------------------------------------------

    !       A       R.A.  I   Action density spectrum (1-D)

    !       CG      R.A.  I   Group velocities.

    !       WN      R.A.  I   Wavenumbers.

    !       DEPTH   Real  I   Mean water depth.

    !       S       R.A.  O   Source term (1-D version).

    !       D       R.A.  O   Diagonal term of derivative (1-D version).

    !     ----------------------------------------------------------------

    !

    !  4. Subroutines used :

    !

    !      Name      Type  Module   Description

    !     ----------------------------------------------------------------

    !      STRACE    Subr. W3SERVMD Subroutine tracing (!/S switch).

    !      PRT2DS    Subr. W3ARRYMD Print plot output (!/T1 switch).

    !      OUTMAT    Subr. W3ARRYMD Matrix output (!/T2 switch).

    !     ----------------------------------------------------------------

    !

    !  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 general test output.

    !     !/T0  2-D print plot of source term.

    !     !/T1  Print arrays.

    !

    ! 10. Source code :

    !

    !/ ------------------------------------------------------------------- /

    USE w3gdatmd, ONLY: nk, nth, nspec, sig, mapwn, sbtc1

#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)        :: CG(NK), WN(NK), DEPTH, A(NSPEC)

    REAL, INTENT(OUT)       :: S(NSPEC), D(NSPEC)

    !/

    !/ ------------------------------------------------------------------- /

    !/ Local parameters

    !/

    INTEGER                 :: IS, IK, NSCUT

#ifdef W3_S

    INTEGER, SAVE           :: IENT = 0

#endif

#ifdef W3_T0

    INTEGER                 :: ITH

#endif

    REAL                    :: FACTOR, CBETA(NK)

#ifdef W3_T0

    REAL                    :: DOUT(NK,NTH)

#endif

    !/

    !/ ------------------------------------------------------------------- /

    !/

#ifdef W3_S

    CALL strace (ient, 'W3SBT1')

#endif

    !

    ! 1.  Deep water ===================================================== *

    !

    IF ( depth*wn(1) .GT. 6 ) THEN

      !

      d = 0.

      s = 0.

      !

      ! 2.  Shallow water ================================================== *

      !

    ELSE

      !

      ! 2.a Set constant

      !

      factor = sbtc1 / depth

      !

#ifdef W3_T

      WRITE (ndst,9000) factor, depth

#endif

      !

      ! 2.b Wavenumber dependent part.

      !

      DO ik=1, nk

        IF ( wn(ik)*depth .GT. 6. ) EXIT

        cbeta(ik) = factor *                                      &

             max(0., (cg(ik)*wn(ik)/sig(ik)-0.5) )

      END DO

      !

      ! 2.c Fill diagional matrix

      !

      nscut  = (ik-1)*nth

      !

      DO is=1, nscut

        d(is) = cbeta(mapwn(is))

      END DO

      !

      DO is=nscut+1, nspec

        d(is) = 0.

      END DO

      !

      s = d * a

      !

    END IF

    !

    ! ... 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 Sbt', ' ', 'NONAME')

#endif

    !

#ifdef W3_T1

    CALL outmat (ndst, d, nth, nth, nk, 'diag Sbt')

#endif

    !

    RETURN

    !

    ! Formats

    !

#ifdef W3_T

9000 FORMAT (' TEST W3SBT1 : FACTOR, DEPTH  : ',2e10.3)

#endif

    !/

    !/ End of W3SBT1 ----------------------------------------------------- /

    !/

  END SUBROUTINE w3sbt1

  !/

  !/ End of module W3SBT1MD -------------------------------------------- /

  !/

END MODULE w3sbt1md