WW3/w3snl2md_8F90_source.html

#include "w3macros.h"

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

MODULE w3snl2md

  !/

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

  !/                  | WAVEWATCH III           NOAA/NCEP |

  !/                  |           H. L. Tolman            |

  !/                  |        G. Ph. van Vledder         |

  !/                  |                        FORTRAN 90 |

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

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

  !/

  !/    14-Feb-2000 : Origination.                        ( version 2.01 )

  !/    02-Feb-2001 : Exact-NL version 3.0                ( version 2.07 )

  !/    26-Aug-2002 : Exact-NL version 4.0                ( version 2.22 )

  !/    11-Nov-2002 : Interface fix.                      ( version 3.00 )

  !/    25-Sep-2003 : Exact-NL version 5.0                ( version 3.05 )

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

  !

  !     Interface module to exact nonlinear interactions.

  !

  !  2. Variables and types :

  !

  !  3. Subroutines and functions :

  !

  !      Name      Type  Scope    Description

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

  !      W3SNL2    Subr. Public   Interface to Xnl calculation routines.

  !      INSNL2    Subr. Public   Initialization of Xnl routines.

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

  !

  !  4. Subroutines and functions used :

  !

  !     See subroutine.

  !

  !  5. Remarks :

  !

  !  6. Switches :

  !

  !       !/S   Enable subroutine tracing.

  !       !/T   Enable general test output.

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

  !       !/T1  Print arrays.

  !

  !  7. Source code :

  !/

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

  !/

  PUBLIC

  !/

CONTAINS

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

  SUBROUTINE w3snl2 (  A, CG, DEPTH, S, D )

    !/

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

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |        G. Ph. van Vledder         |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         24-Dec-2004 |

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

    !/

    !/    14-Feb-2000 : Origination                         ( version 2.01 )

    !/    02-Feb-2001 : Exact-NL version 3.0                ( version 2.07 )

    !/    26-Aug-2002 : Exact-NL version 4.0                ( version 2.22 )

    !/    11-Nov-2002 : Interface fix                       ( version 3.00 )

    !/    25-Sep-2003 : Exact-NL version 5.0                ( version 3.05 )

    !/    24-Dec-2004 : Multiple model version.             ( version 3.06 )

    !/

    !  1. Purpose :

    !

    !     Interface to exact interactions

    !

    !  2. Method :

    !

    !  3. Parameters :

    !

    !     Parameter list

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

    !       A       R.A.  I   Action spectrum A(ITH,IK) as a function of

    !                         direction (rad)  and wavenumber.

    !       CG      R.A.  I   Group velocities (dimension NK).

    !       DEPTH   Real  I   Water depth in meters.

    !       S       R.A.  O   Source term.

    !       D       R.A.  O   Diagonal term of derivative.

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

    !

    !  4. Subroutines used :

    !

    !      Name      Type  Module     Description

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

    !      STRACE    Subr. W3SERVMD   Subroutine tracing.

    !      xnl_main  Subr. m_xnldata  Main Xnl routine.

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

    !

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

    !

    !     - The following settings are hardwired into the xnl_init routine

    !       of Gerbrant van Vledder.

    !

    !         iufind = 0

    !         iq_prt = 0

    !         iq_test = 0

    !         iq_trace = 0

    !         iq_log = 0

    !

    !  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 constants

    USE w3gdatmd, ONLY: nk, nth, sig, th, iqtpe

    USE w3odatmd, ONLY: ndse, ndst, iaproc, naperr

    USE w3servmd, ONLY: extcde

#ifdef W3_S

    USE w3servmd, ONLY: strace

#endif

#ifdef W3_T0

    USE w3arrymd, ONLY: prt2ds

#endif

#ifdef W3_T1

    USE w3arrymd, ONLY: outmat

#endif

    USE m_xnldata, ONLY: xnl_main

    !/

    IMPLICIT NONE

    !/

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

    !/ Parameter list

    !/

    REAL, INTENT(IN)        :: A(NTH,NK), CG(NK), DEPTH

    REAL, INTENT(OUT)       :: S(NTH,NK), D(NTH,NK)

    !/

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

    !/ Local parameters

    !/

    INTEGER                 :: IK, ITH, IERR = 0

#ifdef W3_S

    INTEGER, SAVE           :: IENT = 0

#endif

    REAL                    :: A2(NK,NTH), S2(NK,NTH), D2(NK,NTH)

#ifdef W3_T0

    REAL                    :: SOUT(NK,NK), DOUT(NK,NK)

#endif

    !/

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

    !/

#ifdef W3_S

    CALL strace (ient, 'W3SNL2')

#endif

#ifdef W3_T

    WRITE (ndst,9000) iqtpe

#endif

    !

    ! 1.  Convert input spectrum ----------------------------------------- *

    !     (Action sigma spectrum, reversed indices)

    !

    DO ik=1, nk

      DO ith=1, nth

        a2(ik,ith) = a(ith,ik) / cg(ik)

      END DO

    END DO

    !

    ! 2.  Call exact interaction routines -------------------------------- *

    !

    CALL xnl_main ( a2, sig(1:nk), th, nk, nth, depth, iqtpe,       &

         s2, d2, iaproc, ierr )

    !

    IF ( ierr .NE. 0 ) GOTO 800

    !

    ! 3.  Pack results in proper format ---------------------------------- *

    !

    DO ik=1, nk

      DO ith=1, nth

        s(ith,ik) = s2(ik,ith) * cg(ik)

        d(ith,ik) = d2(ik,ith)

      END DO

    END DO

    !

    ! ... Test output :

    !

#ifdef W3_T0

    DO ik=1, nk

      DO ith=1, nth

        sout(ik,ith) = s(ik,ith) * tpi * sig(ik) / cg(ik)

        dout(ik,ith) = d(ik,ith)

      END DO

    END DO

    CALL prt2ds (ndst, nk, nk, nth, sout, sig(1:nk), '  ', 1.,  &

         0.0, 0.001, 'Snl(f,t)', ' ', 'NONAME')

    CALL prt2ds (ndst, nk, nk, nth, dout, sig(1:nk), '  ', 1.,  &

         0.0, 0.001, 'Diag Snl', ' ', 'NONAME')

#endif

    !

#ifdef W3_T1

    CALL outmat (ndst, s, nth, nth, nk, 'Snl')

    CALL outmat (ndst, d, nth, nth, nk, 'Diag Snl')

#endif

    !

    RETURN

    !

    !     Error escape locations

    !

800 CONTINUE

    IF ( iaproc .EQ. naperr ) WRITE (ndse,1000) ierr

    CALL extcde ( 1 )

    !

    ! Format statements

    !

1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3SNL2 :'/                &

         '     xnl_main RETURN CODE NON ZERO : ',i4,' ***'/)

    !

#ifdef W3_T

9000 FORMAT (' TEST W3SNL2 : IQTPE :',i4)

#endif

    !/

    !/ End of W3SNL2 ----------------------------------------------------- /

    !/

  END SUBROUTINE w3snl2

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

  SUBROUTINE insnl2

    !/

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

    !/                  | WAVEWATCH III           NOAA/NCEP |

    !/                  |           H. L. Tolman            |

    !/                  |        G. Ph. van Vledder         |

    !/                  |                        FORTRAN 90 |

    !/                  | Last update :         24-Dec-2004 |

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

    !/

    !/    02-Feb-2001 : Origination.                        ( version 2.07 )

    !/    25-Sep-2003 : Exact-NL version 5.0                ( version 3.05 )

    !/    24-Dec-2004 : Multiple model version.             ( version 3.06 )

    !/

    !  1. Purpose :

    !

    !     Preprocessing for nonlinear interactions (Xnl).

    !

    !  2. Method :

    !

    !     See Xnl documentation.

    !

    !  3. Parameters :

    !

    !  4. Subroutines used :

    !

    !      Name      Type  Module      Description

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

    !      STRACE    Subr. W3SERVMD    Subroutine tracing.

    !      init_constants

    !                Subr. m_xnldata   Xnl initialization routine.

    !      xnl_init  Subr. m_constants Xnl initialization routine.

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

    !

    !  5. Called by :

    !

    !      Name      Type  Module   Description

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

    !      W3IOGR    Subr. W3IOGRMD Model definition file management.

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

    !

    !  6. Error messages :

    !

    !  7. Remarks :

    !

    !  8. Structure :

    !

    !     - See source code.

    !

    !  9. Switches :

    !

    !       !/S      Enable subroutine tracing.

    !

    ! 10. Source code :

    !

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

    USE constants

    USE w3gdatmd, ONLY: nk, nth, sig, th,                           &

         nltail, dpthnl, ndpths, iqtpe

    USE w3odatmd, ONLY: ndse, ndst, iaproc, naperr

    USE w3servmd, ONLY: extcde

#ifdef W3_S

    USE w3servmd, ONLY: strace

#endif

    USE m_xnldata

    USE m_constants, ONLY: init_constants

    !/

    IMPLICIT NONE

    !/

    !/ Local parameters

    !/

    INTEGER                 :: IGRD, IERR

#ifdef W3_S

    INTEGER, SAVE           :: IENT = 0

#endif

    REAL                    :: XGRAV

    !/

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

    !/

#ifdef W3_S

    CALL strace (ient, 'INSNL2')

#endif

    !

    ! 1.  Set necessary values : ----------------------------------------- *

    !

    xgrav  = grav

    igrd   = 3

    !

#ifdef W3_T

    WRITE (ndst,9000) nltail, xgrav, iqtpe, igrd, ndpths

    WRITE (ndst,9001) dpthnl

    WRITE (ndst,9002) sig(1)*tpiinv, sig(nk)*tpiinv,             &

         th(1)*rade, th(nth)*rade

#endif

    !

    ! 2.  Call initialization routines : --------------------------------- *

    !

    CALL init_constants

    !

    CALL xnl_init ( sig(1:nk), th, nk, nth, nltail, xgrav,          &

         dpthnl, ndpths, iqtpe, igrd, iaproc, ierr )

    !

    IF ( ierr .NE. 0 ) GOTO 800

    !

    RETURN

    !

    !     Error escape locations

    !

800 CONTINUE

    IF ( iaproc .EQ. naperr ) WRITE (ndse,1000) ierr

    CALL extcde ( 1 )

    !

    !     Format statements

    !

1000 FORMAT (/' *** WAVEWATCH III ERROR IN INSNL2 :'/                &

         '     xnl_init RETURN CODE NON ZERO : ',i8/)

    !

#ifdef W3_T

9000 FORMAT (' TEST INSNL2 : NLTAIL :',f6.1/                      &

         '               XGRAV  :',f8.3/                      &

         '               IQTPE  :',i4/                        &

         '               IGRD   :',i4/                        &

         '               NDPTHS :',i4,'   (depths follow)')

9001 FORMAT ('             ',5e10.3)

9002 FORMAT ('               FREQS  :',2f8.3/                     &

         '               DIRS   :',2f6.1)

#endif

    !/

    !/ End of INSNL2 ----------------------------------------------------- /

    !/

  END SUBROUTINE insnl2

  !/

  !/ End of module W3SNL2MD -------------------------------------------- /

  !/

END MODULE w3snl2md