w3sis1md Module Reference

Diffusion source term. More...

Functions/Subroutines
subroutine, public	w3sis1 (A, ICE, S)
	Spectral reflection due to ice. More...

Detailed Description

Diffusion source term.

Author

S. Zieger

Date

20-Dec-2013

Copyright

Copyright 2009-2022 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.

Function/Subroutine Documentation

w3sis1()

subroutine, public w3sis1md::w3sis1	(	real, dimension(nspec), intent(in)	A,
		real, intent(in)	ICE,
		real, dimension(nspec), intent(out)	S
	)

Spectral reflection due to ice.

Parameters

[in]	A	Action density spectrum (1-D).
[in]	ICE	Sea ice concentration.
[out]	S	Source term (1-D version).

Author

S. Zieger

Date

Definition at line 75 of file w3sis1md.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           S. Zieger               |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         20-Dec-2013 |
    !/                  +-----------------------------------+
    !/
    !/    16-Nov-2012 : Origination.                        ( version 4.14 )
    !/                                                        (S. Zieger)
    !  1. Purpose :
    !     Spectral reflection due to ice.
    !
    !/ ------------------------------------------------------------------- /
    !
    !  2. Method :
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       A       R.A.  I   Action density spectrum (1-D)
    !       ICE     Real  I   Sea ice concentration.
    !       S       R.A.  O   Source term (1-D version).
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !     ----------------------------------------------------------------
    !
    !  5. Called by :
    !
    !      Name      Type  Module   Description
    !     ----------------------------------------------------------------
    !      W3SRCE    Subr. W3SRCEMD Source term integration.
    !      W3EXPO    Subr.   N/A    ASCII Point output post-processor.
    !      W3EXNC    Subr.   N/A    NetCDF Point output post-processor.
    !      GXEXPO    Subr.   N/A    GrADS point output post-processor.
    !     ----------------------------------------------------------------
    !
    !  6. Error messages :
    !
    !     None.
    !
    !  7. Remarks :
    !
    !     If ice parameter 1 is zero, no calculations are made.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S  Enable subroutine tracing.
    !     !/T   Enable general test output.
    !           2-D print plot of source term.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3odatmd, ONLY: ndse
    USE w3servmd, ONLY: extcde
    USE w3gdatmd, ONLY: nk, nth, nspec, sig, sig2, dden2
    USE w3gdatmd, ONLY: dtmin, th, dth, ecos, dtmin
    USE w3gdatmd, ONLY: is1c1, is1c2
#ifdef W3_T
    USE w3odatmd, ONLY: ndst
#endif
#ifdef W3_S
    USE w3servmd, ONLY: strace
#endif
#ifdef W3_T
    USE w3arrymd, ONLY: prt2ds
#endif
    !
    IMPLICIT NONE
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    REAL, INTENT(IN)        :: A(NSPEC), ICE
    REAL, INTENT(OUT)       :: S(NSPEC)
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    INTEGER                 :: IK, ITH, ITH2, IS, IS2
    REAL                    :: ALPHA
#ifdef W3_T
    REAL                    :: SOUT(NK,NTH)
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3SIS1')
#endif
    !
    ! 0.  Initializations ------------------------------------------------ *
    !
    s     = 0.
#ifdef W3_T
    sout  = 0.
#endif
    !
    !     Calculate scattering coefficient (linear transfer function) ---- *
    alpha = max(0., is1c1 * ice + is1c2)
#ifdef W3_T
    WRITE(ndst,8000) alpha
#endif
    !
    IF (alpha.GT.0. .AND. ice.GT.0.) THEN
      ! 1. Calculate the derivative ---------------------------------------- *
      DO ik = 1,nk
        DO ith = 1,nth
          is  = ith+(ik-1)*nth
          IF (a(is).GE.0.) THEN
            s(is)   = s(is)  -  alpha * a(is)
            DO ith2 = 1,nth
              is2 = ith2+(ik-1)*nth
              IF (is2.NE.is) THEN
                s(is2) = s(is2)  +  alpha * a(is) / real(nth-1)
              END IF
            END DO
          END IF
        END DO
      END DO
      !
      s = s / dtmin
      !
#ifdef W3_T
      DO ik = 1, nk
        DO ith = 1, nth
          is  = ith+(ik-1)*nth
          sout(ik,ith) = s(is)
        END DO
      END DO
      CALL prt2ds (ndst, nk, nk, nth, sout, sig(1:nk), '  ', 1.,    &
           0.0, 0.001, 'Diag Sir1', ' ', 'NONAME')
#endif
      !
    END IF
    ! Formats
8000 FORMAT (' TEST W3SIS1 : ALPHA :',e10.3)
    !
    !/
    !/ End of W3SIS1 ----------------------------------------------------- /
    !/

References w3gdatmd::dden2, w3gdatmd::dth, w3gdatmd::dtmin, w3gdatmd::ecos, w3servmd::extcde(), w3gdatmd::is1c1, w3gdatmd::is1c2, w3odatmd::ndse, w3odatmd::ndst, w3gdatmd::nk, w3gdatmd::nspec, w3gdatmd::nth, w3arrymd::prt2ds(), w3gdatmd::sig, w3gdatmd::sig2, w3servmd::strace(), and w3gdatmd::th.

Referenced by w3srcemd::w3srce().