WW3/w3src0md_8F90_source.html

#include "w3macros.h"


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

MODULE w3src0md

  !/

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

  !/                  | WAVEWATCH III           NOAA/NCEP |

  !/                  |           H. L. Tolman            |

  !/                  |                        FORTRAN 90 |

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

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

  !/

  !/    05-Jul-2006 : Origination.                        ( version 3.09 )

  !/    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 :

  !

  !     Mean wave parameter computation for case without input and

  !     dissipation.

  !

  !  2. Variables and types :

  !

  !  3. Subroutines and functions :

  !

  !      Name      Type  Scope    Description

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

  !      W3SPR0    Subr. Public   Mean parameters from spectrum.

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

  !

  !  4. Subroutines and functions used :

  !

  !      Name      Type  Module   Description

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

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

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

  !

  !  5. Remarks :

  !

  !  6. Switches :

  !

  !       !/S      Enable subroutine tracing.

  !       !/T      Test output, see subroutines.

  !

  !  7. Source code :

  !

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

  !/

  PUBLIC

  !/

CONTAINS

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

  SUBROUTINE w3spr0 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX)

    !/

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

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         05-Jul-2006 |

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

    !/

    !/    05-Jul-2006 : Origination.                        ( version 3.09 )

    !/

    !  1. Purpose :

    !

    !     Calculate mean wave parameters.

    !

    !  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, 'W3SPR0')

#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 W3SPR0 : E,F,WN MEAN ',3e10.3)

#endif

    !/

    !/ End of W3SPR0 ----------------------------------------------------- /

    !/

  END SUBROUTINE w3spr0

  !/

  !/ End of module W3SRC0MD -------------------------------------------- /

  !/

END MODULE w3src0md