From 67d77157b0b045cb636dfef823c9e51dde3e9261 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 8 Aug 2022 20:38:43 -0400 Subject: [PATCH] Doxygen marked source - PR3 (#748) Doxygen documentation - marked source PR 3 --- docs/ww3_doxy_tmpl.md | 8 + model/src/constants.F90 | 208 +++--- model/src/mod_constants.f90 | 47 +- model/src/mod_fileio.f90 | 129 +++- model/src/mod_xnl4v5.f90 | 1312 +++++++++++++++++++++++++---------- model/src/w3src0md.F90 | 25 + model/src/w3src1md.F90 | 51 ++ model/src/w3src2md.F90 | 100 +++ model/src/w3str1md.F90 | 77 ++ model/src/w3str2md.F90 | 41 +- model/src/w3swldmd.F90 | 64 ++ model/src/w3uno2md.F90 | 96 ++- model/src/w3uqckmd.F90 | 110 +++ model/src/w3wavemd.F90 | 84 +++ model/src/w3wavset.F90 | 291 ++++++++ model/src/w3wdasmd.F90 | 46 ++ model/src/w3wdatmd.F90 | 50 ++ 17 files changed, 2239 insertions(+), 500 deletions(-) diff --git a/docs/ww3_doxy_tmpl.md b/docs/ww3_doxy_tmpl.md index afd7d0cfb..34750b7cf 100644 --- a/docs/ww3_doxy_tmpl.md +++ b/docs/ww3_doxy_tmpl.md @@ -20,6 +20,14 @@ Module has two parts: a **header**, and **inline documentation** for module vari !> @details !> !> @author @date + # ALL module variables documented +module_var_1 !< + ... +!> # multiples lines can be used +!> # if needed. +module_var_i + ... +module_var_N !< ``` ###### inline documentation diff --git a/model/src/constants.F90 b/model/src/constants.F90 index 3615f4b6c..52c94ff5c 100644 --- a/model/src/constants.F90 +++ b/model/src/constants.F90 @@ -1,4 +1,16 @@ +!> @file +!> @brief Defines commonly used constants as parameters for global use. +!> +!> @author H. L. Tolman @date 05-Jun-2018 +!> #include "w3macros.h" + +!> +!> @brief Define some much-used constants for global use (all defined +!> as PARAMETER). +!> +!> @author H. L. Tolman @date 05-Jun-2018 +!> ! #ifndef ENDIANNESS #define ENDIANNESS "native" @@ -25,7 +37,7 @@ MODULE CONSTANTS !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights -!/ reserved. WAVEWATCH III is a trademark of the NWS. +!/ reserved. WAVEWATCH III is a trademark of the NWS. !/ No unauthorized use without permission. !/ ! 1. Purpose : @@ -37,88 +49,73 @@ MODULE CONSTANTS ! ! Name Type Scope Description ! ---------------------------------------------------------------- -! GRAV Real Global Acc. of gravity (m/s2) -! DWAT Real Global Density of water (kg/m3) -! DAIR Real Global Density of air (kg/m3) -! NU_AIR Real Global Kinematic viscosity of air (m2/s) -! NU_WATER Real Global Kinematic viscosity of water (m2/s) -! SED_SG Real Global Specific gravity of sediments (N.D.) -! KAPPA Real Global von Karman's constant (N.D.) -! PI Real Global pi. -! TPI Real Global 2pi. -! HPI Real Global 0.5pi. -! TPIINV Real Global 1/2pi. -! HPIINV Real Global 2/pi. -! RADE Real Global Conv. factor from radians to degrees. -! DERA Real Global Conv. factor from degrees to radians. -! RADIUS Real Global Radius of the earth. (m) -! TSTOUT Log. Global Flag for generation of test files. ! UNDEF Real Global Value for undefined variable in output ! ---------------------------------------------------------------- -! -! 5. Remarks -! -! - The flag for generating test output files is included here as -! it is needed in both ww3_shel and ww3_multi at the same time. -! Make sure that this flag is true if you want to write to the -! test output file ! -! !/ ------------------------------------------------------------------- / !/ - LOGICAL, PARAMETER :: TSTOUT = .FALSE. -! - REAL, PARAMETER :: GRAV = 9.806 - REAL, PARAMETER :: DWAT = 1000. - REAL, PARAMETER :: DAIR = 1.225 - REAL, PARAMETER :: nu_air = 1.4E-5 + LOGICAL, PARAMETER :: TSTOUT = .FALSE. !< TSTOUT Flag for generation of test files. +! The flag for generating test output files is included here as +! it is needed in both ww3_shel and ww3_multi at the same time. +! Make sure that this flag is true if you want to write to the +! test output file ! + REAL, PARAMETER :: GRAV = 9.806 !< GRAV Acc. of gravity (m/s2). + REAL, PARAMETER :: DWAT = 1000. !< DWAT Density of water (kg/m3). + REAL, PARAMETER :: DAIR = 1.225 !< DAIR Density of air (kg/m3). + REAL, PARAMETER :: NU_AIR = 1.4E-5 !< NU_AIR Kinematic viscosity of air (m2/s). !mdo *** Changing nu_water to be consistent with DWAT=1000 (assumes 10degC) - REAL, PARAMETER :: nu_water = 1.31E-6 !mdo WAS: 3.E-6 - REAL, PARAMETER :: sed_sg = 2.65 - REAL, PARAMETER :: KAPPA = 0.40 !Von Karman's constant +!mdo WAS: 3.E-6 + REAL, PARAMETER :: NU_WATER = 1.31E-6 !< NU_WATER Kinematic viscosity of water (m2/s). + REAL, PARAMETER :: SED_SG = 2.65 !< SED_SG Specific gravity of sediments (N.D.). + REAL, PARAMETER :: KAPPA = 0.40 !< KAPPA von Karman's constant (N.D.). ! - REAL, PARAMETER :: PI = 3.141592653589793 - REAL, PARAMETER :: TPI = 2.0 * PI - REAL, PARAMETER :: HPI = 0.5 * PI - REAL, PARAMETER :: TPIINV = 1. / TPI - REAL, PARAMETER :: HPIINV = 1. / HPI - REAL, PARAMETER :: RADE = 180. / PI - REAL, PARAMETER :: DERA = PI / 180. + REAL, PARAMETER :: PI = 3.141592653589793 !< PI Value of Pi. + REAL, PARAMETER :: TPI = 2.0 * PI !< TPI 2*Pi. + REAL, PARAMETER :: HPI = 0.5 * PI !< HPI 1/2*Pi. + REAL, PARAMETER :: TPIINV = 1. / TPI !< TPIINV Inverse of 2*Pi. + REAL, PARAMETER :: HPIINV = 1. / HPI !< HPIINV Inverse of 1/2*Pi. + REAL, PARAMETER :: RADE = 180. / PI !< RADE Conversion factor from radians to degrees. + REAL, PARAMETER :: DERA = PI / 180. !< DERA Conversion factor from degrees to radians. ! - REAL, PARAMETER :: RADIUS = 4.E7 * TPIINV + REAL, PARAMETER :: RADIUS = 4.E7 * TPIINV !< RADIUS Radius of the earth (m). ! - REAL, PARAMETER :: G2PI3I = 1. / ( GRAV**2 * TPI**3 ) - REAL, PARAMETER :: G1PI1I = 1. / ( GRAV * TPI ) + REAL, PARAMETER :: G2PI3I = 1. / ( GRAV**2 * TPI**3 ) !< G2PI3I Inverse of gravity^2 * (2*Pi)^3. + REAL, PARAMETER :: G1PI1I = 1. / ( GRAV * TPI ) !< G1PI1I Inverse of gravity * 2 * Pi. ! - REAL :: UNDEF = -999.9 + REAL :: UNDEF = -999.9 !< UNDEF Value for undefined variable in output. - ! Filled in by the pre-processor with 'big_endian', 'little_endian', or 'native' - character(*), parameter :: FILE_ENDIAN = ENDIANNESS -! -! Parameters for friction factor table -! - INTEGER, PARAMETER :: SIZEFWTABLE=300 - REAL :: FWTABLE(0:SIZEFWTABLE) - REAL :: DELAB - REAL, PARAMETER :: ABMIN = -1. - REAL, PRIVATE, PARAMETER :: ABMAX = 8. - INTEGER, PARAMETER :: srce_direct = 0 - INTEGER, PARAMETER :: srce_imp_post = 1 - INTEGER, PARAMETER :: srce_imp_pre = 2 - INTEGER, PARAMETER :: DEBUG_NODE = 1104 - INTEGER, PARAMETER :: DEBUG_ELEMENT = 50 - - LOGICAL :: LPDLIB = .FALSE. - LOGICAL :: LSETUP = .FALSE. + CHARACTER(*), PARAMETER :: FILE_ENDIAN = ENDIANNESS !< FILE_ENDIAN Filled by preprocessor with 'big_endian', + !< 'little_endian', or 'native'. +! +! Parameters for friction factor table +! + INTEGER, PARAMETER :: SIZEFWTABLE=300 !< SIZEFWTABLE + REAL :: FWTABLE(0:SIZEFWTABLE) !< FWTABLE + REAL :: DELAB !< DELAB + REAL, PARAMETER :: ABMIN = -1. !< ABMIN + REAL, PRIVATE, PARAMETER :: ABMAX = 8. !< ABMAX + INTEGER, PARAMETER :: srce_direct = 0 !< srce_direct + INTEGER, PARAMETER :: srce_imp_post = 1 !< srce_imp_post + INTEGER, PARAMETER :: srce_imp_pre = 2 !< srce_imp_pre + INTEGER, PARAMETER :: DEBUG_NODE = 1014 !< DEBUG_NODE Node number used for debugging. + INTEGER, PARAMETER :: DEBUG_ELEMENT = 50 !< DEBUG_ELEMENT Element number used for debug. + LOGICAL :: LPDLIB = .FALSE. !< LPDLIB Logical for using the PDLIB library. + LOGICAL :: LSETUP = .FALSE. !< LSETUP Logical LSETUP is not used. ! ! Parameters in support of running as ESMF component ! ! --- Flag indicating whether or not the model has been invoked as an ! ESMF Component. This flag is set to true in the WMESMFMD ESMF ! module during initialization. - LOGICAL :: IS_ESMF_COMPONENT = .FALSE. + LOGICAL :: IS_ESMF_COMPONENT = .FALSE. !< IS_ESMF_COMPONENT Flag for model invoked via ESMF. ! CONTAINS ! ---------------------------------------------------------------------- +!> +!> @brief Estimate friction coefficients in oscillatory boundary layers +!> using tabulation on Kelvin functions. +!> +!> @author F. Ardhuin @date 28-Feb-2013 +!> SUBROUTINE TABU_FW !/ !/ +-----------------------------------+ @@ -176,20 +173,13 @@ SUBROUTINE TABU_FW ! !/ ------------------------------------------------------------------- / IMPLICIT NONE - INTEGER, PARAMETER :: NITER=100 - REAL , PARAMETER :: XM=0.50, EPS1=0.00001 -! VARIABLE. TYPE. PURPOSE. -! *XM* REAL POWER OF TAUW/TAU IN ROUGHNESS LENGTH. -! *XNU* REAL KINEMATIC VISCOSITY OF AIR. -! *NITER* INTEGER NUMBER OF ITERATIONS TO OBTAIN TOTAL STRESS -! *EPS1* REAL SMALL NUMBER TO MAKE SURE THAT A SOLUTION -! IS OBTAINED IN ITERATION WITH TAU>TAUW. + INTEGER, PARAMETER :: NITER=100 + REAL , PARAMETER :: XM=0.50 + REAL , PARAMETER :: EPS1=0.00001 ! ---------------------------------------------------------------------- INTEGER I,ITER REAL KER, KEI REAL ABR,ABRLOG,L10,FACT,FSUBW,FSUBWMEMO,dzeta0,dzeta0memo -! -! ! DELAB = (ABMAX-ABMIN)/REAL(SIZEFWTABLE) L10=ALOG(10.) @@ -210,26 +200,54 @@ SUBROUTINE TABU_FW fsubw=.08/(ker**2+kei**2) fsubw=.5*(fsubwmemo+fsubw) dzeta0=.5*(dzeta0memo+dzeta0) - END DO + END DO ! -! Maximum value of 0.5 for fe is based on field -! and lab experiment by Lowe et al. JGR 2005, 2007 -! - FWTABLE(I) = MIN(fsubw,0.5) +! Maximum value of 0.5 for fe is based on field +! and lab experiment by Lowe et al. JGR 2005, 2007 +! + FWTABLE(I) = MIN(fsubw,0.5) ! WRITE(994,*) 'Friction factor:',I,ABR,FWTABLE(I) END DO RETURN END SUBROUTINE TABU_FW ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE KZEONE(X, Y, RE0, IM0, RE1, IM1) +!> +!> @brief June 1999 adaptation to CRESTb, all tests on range of (x,y) +!> have been bypassed, we implicitly expect X to be positive or |x,y| +!> non zero. +!> +!> @details The variables X and Y are the real and imaginary parts of +!> the argument of the first two modified bessel functions +!> of the second kind,k0 and k1. Re0,im0,re1 and im1 give +!> the real and imaginary parts of exp(x)*k0 and exp(x)*k1, +!> respectively. Although the real notation used in this +!> subroutine may seem inelegant when compared with the +!> complex notation that fortran allows, this version runs +!> about 30 percent faster than one written using complex +!> variables. +!> +!> @copyright This subroutine is copyright by ACM, see +!> http://www.acm.org/pubs/copyright_policy/softwareCRnotice.html. +!> ACM declines any responsibility of any kind. +!> +!> @param X Real part of argument to modified Bessel functions. +!> @param Y Imaginary part of argument to modified Bessel functions. +!> @param RE0 Real part of exp(x)*k0. +!> @param IM0 Imaginary part of exp(x)*k0. +!> @param RE1 Real part of exp(x)*k1. +!> @param IM1 Imaginary part of exp(x)*k1. +!> +!> @author N/A @date N/A +!> + SUBROUTINE KZEONE(X, Y, RE0, IM0, RE1, IM1) ! June 1999 adaptation to CRESTb, all tests on range of (x,y) have been ! bypassed, we implicitly expect X to be positive or |x,y| non zero -! +! ! This subroutine is copyright by ACM ! see http://www.acm.org/pubs/copyright_policy/softwareCRnotice.html ! ACM declines any responsibility of any kind -! +! ! THE VARIABLES X AND Y ARE THE REAL AND IMAGINARY PARTS OF ! THE ARGUMENT OF THE FIRST TWO MODIFIED BESSEL FUNCTIONS ! OF THE SECOND KIND,K0 AND K1. RE0,IM0,RE1 AND IM1 GIVE @@ -245,7 +263,7 @@ SUBROUTINE KZEONE(X, Y, RE0, IM0, RE1, IM1) DOUBLE PRECISION X, Y, X2, Y2, RE0, IM0, RE1, IM1, & R1, R2, T1, T2, P1, P2, RTERM, ITERM, L DOUBLE PRECISION , PARAMETER, DIMENSION(8) :: EXSQ = & - (/ 0.5641003087264D0,0.4120286874989D0,0.1584889157959D0, & + (/ 0.5641003087264D0,0.4120286874989D0,0.1584889157959D0, & 0.3078003387255D-1,0.2778068842913D-2,0.1000044412325D-3, & 0.1059115547711D-5,0.1522475804254D-8 /) DOUBLE PRECISION , PARAMETER, DIMENSION(8) :: TSQ = & @@ -386,20 +404,34 @@ SUBROUTINE KZEONE(X, Y, RE0, IM0, RE1, IM1) IM1 = T1*R2 + T2*R1 RETURN END SUBROUTINE KZEONE - + ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE KERKEI(X,KER,KEI) +!> +!> @brief Computes the values of the zeroth order Kelvin function +!> Ker and Kei. +!> +!> @details These functions are used to determine the friction factor +!> fw as a function of the bottom roughness length assuming a linear +!> profile of eddy viscosity (See Grant and Madsen, 1979). +!> +!> @param X +!> @param KER +!> @param KEI +!> +!> @author N/A @date N/A +!> + SUBROUTINE KERKEI(X,KER,KEI) !********************************************************************** ! Computes the values of the zeroth order Kelvin function Ker and Kei -! These functions are used to determine the friction factor fw as a +! These functions are used to determine the friction factor fw as a ! function of the bottom roughness length assuming a linear profile ! of eddy viscosity (See Grant and Madsen, 1979) !********************************************************************** IMPLICIT NONE - + DOUBLE PRECISION ZR,ZI,CYR,CYI,CYR1,CYI1 REAL X,KER,KEI - + ZR=X*.50D0*SQRT(2.0D0) ZI=ZR CALL KZEONE(ZR, ZI, CYR, CYI,CYR1,CYI1) diff --git a/model/src/mod_constants.f90 b/model/src/mod_constants.f90 index 2e4cb2c00..6b6082e76 100644 --- a/model/src/mod_constants.f90 +++ b/model/src/mod_constants.f90 @@ -1,31 +1,50 @@ +!> @file +!> @brief Module for m_constants. +!> +!> @author N/A @date N/A +!> + !------------------------------------------------------------------------------ +!> +!> @brief Module for m_constants. +!> +!> @author N/A @date N/A +!> + module m_constants !------------------------------------------------------------------------------ ! ! physical constants ! -real grav ! gravitational acceleration -real sqrtg ! square root of grav -real gsq ! square of grav -real nu ! kinematic viscosity of water +real grav !< gravitational acceleration +real sqrtg !< square root of grav +real gsq !< square of grav +real nu !< kinematic viscosity of water ! -real d_water ! density of water -real d_air ! density of air +real d_water !< density of water +real d_air !< density of air ! ! mathematical constants ! -real pi ! circular constant, 3.1415... -real pi2 ! 2*pi -real pih ! pi/2 -real dera ! conversion from degrees to radians -real rade ! conversion from radians to degrees -real expmin ! min argument for exp. function to avoid underflow -real expmax ! max argument for exp. function to avoid overflow -real sqrt2 ! square root of 2 ~ 1.41 +real pi !< circular constant, 3.1415... +real pi2 !< 2*pi +real pih !< pi/2 +real dera !< conversion from degrees to radians +real rade !< conversion from radians to degrees +real expmin !< min argument for exp. function to avoid underflow +real expmax !< max argument for exp. function to avoid overflow +real sqrt2 !< square root of 2 ~ 1.41 ! contains ! + !------------------------------------------------------------------------------ +!> +!> @brief Subroutine init_constants sets constant values. +!> +!> @author N/A @date N/A +!> + subroutine init_constants !------------------------------------------------------------------------------ ! diff --git a/model/src/mod_fileio.f90 b/model/src/mod_fileio.f90 index 9a3fd1f52..b09081b9e 100644 --- a/model/src/mod_fileio.f90 +++ b/model/src/mod_fileio.f90 @@ -1,4 +1,19 @@ +!> @file +!> @brief Module for storing file i/o related variables. +!> +!> @author Gerbrant van Vledder @date 8-Feb-2003 +!> + !-----------------------------------------------------------------------------! +!> +!> @brief Module for storing file i/o related variables. +!> +!> @details The values for the parameter i_log, i_prt and iw_tst must be set +!> in one of the routines of the host program or in subroutine sys_init. +!> +!> @author Gerbrant van Vledder @date 8-Feb-2003 +!> + module m_fileio !-----------------------------------------------------------------------------! ! @@ -24,31 +39,47 @@ module m_fileio ! The following two parameters must be set by the user ! They define the overall test level and the output channel ! -integer,parameter :: i_print=0 ! (0/1/2) Test output printing off/on -! ! Output channel defined by i_out +integer,parameter :: i_print=0 !< (0/1/2) Test output printing off/on + !< Output channel defined by i_out ! -integer,parameter :: i_out=6 ! Output channel to screen -! ! ==1 screen output for Unix/Linux systems -! ! ==6 screen output for Windows +integer,parameter :: i_out=6 !< Output channel to screen + !< ==1 screen output for Unix/Linux systems + !< ==6 screen output for Windows !------------------------------------------------------------------------------ ! ! Standard switches to activate Logging, Test and Print ouput ! -integer i_log ! (0/1) Logging off/on -integer i_prt ! (0/1) Printing off/on -integer i_tst ! (0,1,2...) Test level off/on +integer i_log !< (0/1) Logging off/on +integer i_prt !< (0/1) Printing off/on +integer i_tst !< (0,1,2...) Test level off/on ! ! ! Standard unit numbers of input & output files ! -integer lu_err ! standard error file -integer lu_inp ! standard input file -integer lu_log ! standard logging -integer lu_prt ! standard print output -integer lu_tst ! standard test output +integer lu_err !< standard error file +integer lu_inp !< standard input file +integer lu_log !< standard logging +integer lu_prt !< standard print output +integer lu_tst !< standard test output ! contains + !-----------------------------------------------------------------------------! +!> +!> @brief Open file with name FILENAME and determine unit number IUNIT. +!> +!> @details File type determined in QUAL. Depending on the value of IUFIND +!> a search is performed for a free unit number. +!> +!> @param[in] filename File name. +!> @param[in] qual File qualifyer. +!> @param[in] iufind Indicator for search of unit number. +!> @param[inout] iunit Unit number. +!> @param[out] iostat Error indicator. +!> +!> @author Gerbrant van Vledder @date 8-Feb-2003 +!> + subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! !-----------------------------------------------------------------------------! ! @@ -116,11 +147,11 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! ! !Type I/O Name Description !---------------------------------------------------- -character(len=*), intent(in) :: filename ! File name -character(len=2), intent(in) :: qual ! File qualifyer -integer, intent(in) :: iufind ! Indicator for search of unit number -integer, intent(inout) :: iunit ! Unit number -integer, intent(out) :: iostat ! Error indicator +character(len=*), intent(in) :: filename +character(len=2), intent(in) :: qual +integer, intent(in) :: iufind +integer, intent(inout) :: iunit +integer, intent(out) :: iostat ! ! 4. Subroutines used ! @@ -160,12 +191,12 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! !------------------------------------------------------------------------------ ! Local variables ! -character(len=7) :: cstat ! string with status of file I/O -character(len=11) :: cform ! string with format of file I/O -integer junit ! temporary unit number -logical lexist ! indicator if a file exists -logical lopen ! indicator if a file is opened -integer iuerr ! error indicator from Z_FLUNIT +character(len=7) :: cstat !< string with status of file I/O +character(len=11) :: cform !< string with format of file I/O +integer junit !< temporary unit number +logical lexist !< indicator if a file exists +logical lopen !< indicator if a file is opened +integer iuerr !< error indicator from Z_FLUNIT !------------------------------------------------------------------------------------- ! initialisations !------------------------------------------------------------------------------------- @@ -198,7 +229,7 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! ! if(qual(2:2) == 'F') cform = 'formatted' if(qual(2:2) == 'U') cform = 'unformatted' - if(qual(2:2) == 'B') cform = 'binary' ! extension to FORTRAN 95 standard + if(qual(2:2) == 'B') cform = 'binary' !< extension to FORTRAN 95 standard if(qual(2:2) == 'R') cform = 'unformatted' ! ! Check if file exists @@ -321,6 +352,14 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! end subroutine ! !-----------------------------------------------------------------------------! +!> +!> @brief Close file with unit number IUNIT, and set IUNIT=-1. +!> +!> @param[inout] iunit Unit number. +!> +!> @author Gerbrant van Vledder @date 24-Aug-2000 +!> + subroutine z_fclose(iunit) ! !-----------------------------------------------------------------------------! ! @@ -348,7 +387,7 @@ subroutine z_fclose(iunit) ! ! !Type I/O Name Description !----------------------------------------------------------------------------- -integer, intent(inout) :: iunit ! Unit number +integer, intent(inout) :: iunit !----------------------------------------------------------------------------- close(iunit) iunit = -1 @@ -357,6 +396,24 @@ subroutine z_fclose(iunit) ! end subroutine ! !-----------------------------------------------------------------------------! +!> +!> @brief Find a free unit number. +!> +!> @details Starting at LU_MIN till LU_MAX are investigated until +!> a free (i.e. not connected to a file) is found. +!> Use is made of the standard fortran INQUIRE function. +!> The values of LU_MIN and LU_MAX should be specified +!> in an initialisation routine +!> +!> If no free unit number if found in the range +!> lu_min - lu_high, then the function returns IUNIT = -1. +!> +!> @param[out] iunit Resulting unit number. +!> @param[out] ierr Error level. +!> +!> @author Gerbrant van Vledder @date 14-Apr-2000 +!> + subroutine z_flunit(iunit,ierr) ! !-----------------------------------------------------------------------------! ! @@ -402,8 +459,8 @@ subroutine z_flunit(iunit,ierr) ! ! !Type I/O Name Description !---------------------------------------------------------- -integer, intent(out) :: iunit ! resulting unit number -integer, intent(out) :: ierr ! error level +integer, intent(out) :: iunit +integer, intent(out) :: ierr ! ! 4. Subroutines used ! @@ -427,21 +484,21 @@ subroutine z_flunit(iunit,ierr) ! !---------------------------------------------------------------------------------- ! local parameters ! -integer junit ! counter for unit numbers -logical lopen ! indicator if a unit number is connected to a file -logical lnot ! indicates if a forbidden unit number is checked -integer i_not ! counter to check forbidded unit numbers +integer junit !< counter for unit numbers +logical lopen !< indicator if a unit number is connected to a file +logical lnot !< indicates if a forbidden unit number is checked +integer i_not !< counter to check forbidded unit numbers ! !--------------------------------------------------------------------------------- ! range of unit numbers to search ! -integer, parameter :: lu_min=60 ! minimum unit number -integer, parameter :: lu_max=200 ! maximum unit number +integer, parameter :: lu_min=60 !< minimum unit number +integer, parameter :: lu_max=200 !< maximum unit number ! ! specification of forbidden unit numbers ! -integer, parameter :: lu_nr=3 ! number of forbidden unit numbers -integer lu_not(lu_nr) ! list of forbidden unit numbers +integer, parameter :: lu_nr=3 !< number of forbidden unit numbers +integer lu_not(lu_nr) !< list of forbidden unit numbers !---------------------------------------------------------------------------------- lu_not(1) = 100 lu_not(2) = 101 diff --git a/model/src/mod_xnl4v5.f90 b/model/src/mod_xnl4v5.f90 index 867e9874a..9cddd8d6c 100644 --- a/model/src/mod_xnl4v5.f90 +++ b/model/src/mod_xnl4v5.f90 @@ -1,4 +1,16 @@ +!> @file +!> @brief Module for computing the quadruplet interaction. +!> +!> @author Gerbrant van Vledder @date 9-Sep-2003 +!> + !------------------------------------------------------------------------------ +!> +!> @brief Module for computing the quadruplet interaction. +!> +!> @author Gerbrant van Vledder @date 9-Sep-2003 +!> + module m_xnldata !------------------------------------------------------------------------------ ! module for computing the quadruplet interaction @@ -24,214 +36,214 @@ module m_xnldata !------------------------------------------------------------------------------------ implicit none ! -character(len=60) q_version ! version string +character(len=60) q_version !< version string ! -character(len=20) sub_name ! Name of active subroutine -character(len=20) qbase ! base name for I/O files -character(len=20) qf_error ! name of file with error messages +character(len=20) sub_name !< Name of active subroutine +character(len=20) qbase !< base name for I/O files +character(len=20) qf_error !< name of file with error messages ! -integer iufind ! Specifies handling of unit numbers, see Z_FILEIO -integer iscreen ! identifier for screen, set in XNL_INIT +integer iufind !< Specifies handling of unit numbers, see Z_FILEIO +integer iscreen !< identifier for screen, set in XNL_INIT ! ! unit numbers for I/O ! -integer luq_bqf ! binary file storing and retrieving precomputed loci -integer luq_cfg ! user defined configuration -integer luq_err ! file with error messages -integer luq_fil ! test output for filtering -integer luq_grd ! ASCII file storing and retrieving precomputed loci -integer luq_int ! test file for test output of integration -integer luq_loc ! statistics about computed loci -integer luq_log ! logging -integer luq_prt ! general print file for quadruplets -integer luq_trf ! testing transformation of loci -integer luq_tst ! test file for quadruplets -integer luq_txt ! reading (error) text file -integer luq_t13 ! test of basis integration +integer luq_bqf !< binary file storing and retrieving precomputed loci +integer luq_cfg !< user defined configuration +integer luq_err !< file with error messages +integer luq_fil !< test output for filtering +integer luq_grd !< ASCII file storing and retrieving precomputed loci +integer luq_int !< test file for test output of integration +integer luq_loc !< statistics about computed loci +integer luq_log !< logging +integer luq_prt !< general print file for quadruplets +integer luq_trf !< testing transformation of loci +integer luq_tst !< test file for quadruplets +integer luq_txt !< reading (error) text file +integer luq_t13 !< test of basis integration !------------------------------------------------------------------------------ ! physical coefficients, to be obtained through interface XNL_INIT !------------------------------------------------------------------------------ -real q_grav ! gravitational acceleration (Earth = 9.81 m/s^2) -real qf_tail ! power of spectral tail of E(f), e.g. -4,, -4.5, -5 -! ! these values must be set in the interface routine +real q_grav !< gravitational acceleration (Earth = 9.81 m/s^2) +real qf_tail !< power of spectral tail of E(f), e.g. -4,, -4.5, -5 + !< these values must be set in the interface routine !------------------------------------------------------------------------------ ! filtering coefficients !------------------------------------------------------------------------------ -real qf_krat ! maximum ratio of the interacting wave numbers k1 and k3 -real qf_dmax ! maximum directional difference between k1 and k3 -real qf_frac ! fraction of maximum action density to filter +real qf_krat !< maximum ratio of the interacting wave numbers k1 and k3 +real qf_dmax !< maximum directional difference between k1 and k3 +real qf_frac !< fraction of maximum action density to filter ! ! program switches, optionally to be reset in routine Q_SETCONFIG ! -integer iq_compact ! switch to compact data -! == 0, do not compact -! == 1, compact data by elimiting zero contribution along locus -! -integer iq_cple ! type of coupling coefficient -! == 1, deep water coefficient of Webb -! == 2, deep water coefficient of Zakharov -! == 3, finite depth coefficient of Hasselmann & Herterich -! == 4, finite depth coefficient of Zakharov -! == 5, finite depth coefficient of Lin & Perrie -! -integer iq_disp ! type of dispersion relation, viz. depth dependency -! == 1, deep water, possibly with geometric scaling -! == 2, linear dispersion relation, w^2 = g.k.tanh(kd) -! == 3, nonlinear dispersion relation -! -integer iq_dscale ! switch to activate depth scaling according to - ! Herterich and Hasselmann -! ! == 0, No depth scaling -! ! == 1, depth scaling activated -! -integer iq_filt ! switch to activate filtering in wave number space -! ! ==0, no filtering -! ! ==1, filtering activated -! -integer iq_gauleg ! switch for Gauss-Legendre interpolation -! ! == 0, No Gauss-Legendre, default -! ! > 0 Gauss-Legendre, iq_gauleg is number of points -! -integer iq_geom ! type of scaling -! == 0, no geometric scaling, only directional scaling of loci -! == 1, geometric scaling using Resio/Tracy method -! only possible in the case IQ_DISP=1 -! -integer iq_grid ! type of spectral grid -! == 1, sector & symmetric around zero -! == 2, sector & symmetric around zero & non-symmetric -! == 3, full circle & non-symmetric -! -integer iq_integ ! option to output integration results -! ! ==0 no output of integration -! ! ==1 only sum per locus -! ! ==2 also information per point on locus -! ! ==3 only basic line integrals -! -integer iq_interp ! type of interpolation to retrieve action density -! ! == 1, bi-linear interpolation in discrete spectrum (default) -! ! == 2, take nearest bins, on the basis of maximum weight -! -integer iq_locus ! Option for computation of locus -! ! ==1, explicit polar method with fixed k-step -! ! ==2, explicit polar method with adpative k-stepping -! ! ==3, explicit polar method with geometric k-spacing -! -integer iq_log ! switch to activate logging to file QBASE//.LOG -! ! == 0, No print output -! ! == 1, print output -! -integer iq_lump ! switch to activate lumping on locus -! ! == 0, No lumping -! ! == 1, Lumping along locus -! -integer iq_make ! option to make quadruplet grid -! == 1, make when needed (default) -! == 2, always make quadruplet grid -! == 3, only make grid file -! -integer iq_mod ! option to redistribute points on locus -! ! == 0, Points will be used as computed by tracing algortihm -! ! == 1, Equi-distant spacing on points along locus (NLOC1) -! -integer iq_prt ! switch to activate print output, to file QBASE//.PRT -! ! == 0, No print output -! ! == 1, print output -! -integer iq_search ! switch to determine search for a proper grid -! == 0, no search is carried out -! == 1, search nearest (relative) interaction grid -! -integer iq_screen ! option to send output to the screen -! ! == 0, no output is send to screen -! ! == 1, output is send to screen -! -integer iq_sym ! switch to activate use of symmetry reduction -! ! == 0, no symmetries are used -! ! == 1, symmetry activated (default) -! -integer iq_test ! test level, output is directed to unit luqtst -! ! == 0, no test output -! ! == 1, output of basic I/O -! ! == 2, extensive test output -! -integer iq_trace ! trace option -! ! == 0, no trace of subroutine calls -! ! > 0, maximum number of traces per subroutine -! ! < 0, as for >0 but now output is send to the screen -! -integer iq_trf ! option to print transformed loci to special output file -! ! == 0, no output to data file unit luqtrf -! ! == 1, test output from routine Q_GETLOCUS -! -integer iq_t13 ! option to output T13 integration -! ! ==0, no output -! ! ==1, test output of T13 per locus -! -integer iq_xdia ! switch to activate output to extended DIA data file -! == 0, no output -! > 0, output to data file, but only when lumping is also -! activated +integer iq_compact !< switch to compact data +!< == 0, do not compact +!< == 1, compact data by elimiting zero contribution along locus +! +integer iq_cple !< type of coupling coefficient +!< == 1, deep water coefficient of Webb +!< == 2, deep water coefficient of Zakharov +!< == 3, finite depth coefficient of Hasselmann & Herterich +!< == 4, finite depth coefficient of Zakharov +!< == 5, finite depth coefficient of Lin & Perrie +! +integer iq_disp !< type of dispersion relation, viz. depth dependency +!< == 1, deep water, possibly with geometric scaling +!< == 2, linear dispersion relation, w^2 = g.k.tanh(kd) +!< == 3, nonlinear dispersion relation +! +integer iq_dscale !< switch to activate depth scaling according to + !< Herterich and Hasselmann + !< == 0, No depth scaling + !< == 1, depth scaling activated +! +integer iq_filt !< switch to activate filtering in wave number space + !< ==0, no filtering + !< ==1, filtering activated +! +integer iq_gauleg !< switch for Gauss-Legendre interpolation + !< == 0, No Gauss-Legendre, default + !< > 0 Gauss-Legendre, iq_gauleg is number of points +! +integer iq_geom !< type of scaling +!< == 0, no geometric scaling, only directional scaling of loci +!< == 1, geometric scaling using Resio/Tracy method +!< only possible in the case IQ_DISP=1 +! +integer iq_grid !< type of spectral grid +!< == 1, sector & symmetric around zero +!< == 2, sector & symmetric around zero & non-symmetric +!< == 3, full circle & non-symmetric +! +integer iq_integ !< option to output integration results + !< ==0 no output of integration + !< ==1 only sum per locus + !< ==2 also information per point on locus + !< ==3 only basic line integrals +! +integer iq_interp !< type of interpolation to retrieve action density + !< == 1, bi-linear interpolation in discrete spectrum (default) + !< == 2, take nearest bins, on the basis of maximum weight +! +integer iq_locus !< Option for computation of locus + !< ==1, explicit polar method with fixed k-step + !< ==2, explicit polar method with adpative k-stepping + !< ==3, explicit polar method with geometric k-spacing +! +integer iq_log !< switch to activate logging to file QBASE//.LOG + !< == 0, No print output + !< == 1, print output +! +integer iq_lump !< switch to activate lumping on locus + !< == 0, No lumping + !< == 1, Lumping along locus +! +integer iq_make !< option to make quadruplet grid +!< == 1, make when needed (default) +!< == 2, always make quadruplet grid +!< == 3, only make grid file +! +integer iq_mod !< option to redistribute points on locus + !< == 0, Points will be used as computed by tracing algortihm + !< == 1, Equi-distant spacing on points along locus (NLOC1) +! +integer iq_prt !< switch to activate print output, to file QBASE//.PRT + !< == 0, No print output + !< == 1, print output +! +integer iq_search !< switch to determine search for a proper grid + !< == 0, no search is carried out + !< == 1, search nearest (relative) interaction grid +! +integer iq_screen !< option to send output to the screen + !< == 0, no output is send to screen + !< == 1, output is send to screen +! +integer iq_sym !< switch to activate use of symmetry reduction + !< == 0, no symmetries are used + !< == 1, symmetry activated (default) +! +integer iq_test !< test level, output is directed to unit luqtst + !< == 0, no test output + !< == 1, output of basic I/O + !< == 2, extensive test output +! +integer iq_trace !< trace option + !< == 0, no trace of subroutine calls + !< > 0, maximum number of traces per subroutine + !< < 0, as for >0 but now output is send to the screen +! +integer iq_trf !< option to print transformed loci to special output file + !< == 0, no output to data file unit luqtrf + !< == 1, test output from routine Q_GETLOCUS +! +integer iq_t13 !< option to output T13 integration + !< ==0, no output + !< ==1, test output of T13 per locus +! +integer iq_xdia !< switch to activate output to extended DIA data file + !< == 0, no output + !< > 0, output to data file, but only when lumping is also + !< activated !--------------------------------------------------------------------------------------- ! ! ! grid administration ! -character(len=13) aqname ! name of ASCII grid file -character(len=13) bqname ! name of binary quadruplet grid file -character(len=13) lastquadfile ! name of last retrieved BQF file -character(len=21) q_header ! header of Binary Quadruplet File as intended in BQF-file -character(len=21) r_header ! header of Binary Quadruplet File as exists in BQF-file -logical lq_grid ! flag to make (new) interaction grid -! -integer nkq ! number of wave numbers of quad-grid -integer naq ! number of angles of quad-grad -integer ncirc ! number of angles on a full circle -! -integer ia_k1,ik_k1 ! indices of main loop variables -integer ia_k3,ik_k3 ! indices of main loop variables -! -real fqmin ! lowest frequency in Hz -real fqmax ! highest frequency in Hz -real q_sector ! half plane width in degrees (for iq_grid=1,2) -real q_dstep ! step size for generating BQF files -! -integer, parameter :: mq_stack=10 ! maximum number of elements in stack -! -integer mlocus ! maximum number of points on locus for defining arrays -integer nlocus0 ! preferred number of points on locus -integer nlocus1 ! number of points on locus as computed in Q_CMPLOCUS -integer klocus ! number of points on locus as stored in quadruplet database - ! based on nlocus0, iq_gauleg and iq_lump (without compacting) - ! used in Q_ALLOCATE to define size of data arrays -integer nlocus ! number of points on locus, equal to klocus -integer nlocusx ! number of points on locus for use in computation (nlocusx <= nlocus) -! -real kqmin ! lowest wave number -real kqmax ! highest wave number -real wk_max ! maximum weight for wave number interpolation, set in Q_INIT -! -real k0x,k0y,dk0 ! components of initial wave number of locus, -real krefx,krefy ! components of reference wave number for quad-grid -real k1x,k1y ! components of k1 wave number -real k2x,k2y ! components of k2 wave number -real k3x,k3y ! components of k3 wave number -real k4x,k4y ! components of k4 wave number -real px,py ! components of difference k1-k3 wave number -real pmag ! magnitude of P-vector -real pang ! angle related of P-vector, Pang = atan2(py,px), (radians) -real sang ! angle of symmytry axis of locus, SANG = PANG +/ pi° (radians) -real xang ! angle of locus for the case that w1=w3, Xang=atan2(-px,py), (radians) -real q ! difference of radian frequencies, used in Resio-Tracy method -real kmin_loc ! minimum wave number of locus along symmetry axis -real kmax_loc ! maximum wave number of locus along symmetry axis -real kmid ! wave number at midpoint of locus along symmetry axis -real kmidx ! x-component of wave number at midpoint of locus along symmetry axis -real kmidy ! y-component of wave number at midpoint of locus along symmetry axis -real loc_crf ! circumference of locus in (kx,ky)-space -real loc_area ! area of locus, measured in (kx-ky)- space -real loc_xz ! x-coordinate of center of gravity of locus in (kx,ky)-space -real loc_yz ! y-coordinate of center of gravity of locus in (kx,ky)-space +character(len=13) aqname !< name of ASCII grid file +character(len=13) bqname !< name of binary quadruplet grid file +character(len=13) lastquadfile !< name of last retrieved BQF file +character(len=21) q_header !< header of Binary Quadruplet File as intended in BQF-file +character(len=21) r_header !< header of Binary Quadruplet File as exists in BQF-file +logical lq_grid !< flag to make (new) interaction grid +! +integer nkq !< number of wave numbers of quad-grid +integer naq !< number of angles of quad-grad +integer ncirc !< number of angles on a full circle +! +integer ia_k1,ik_k1 !< indices of main loop variables +integer ia_k3,ik_k3 !< indices of main loop variables +! +real fqmin !< lowest frequency in Hz +real fqmax !< highest frequency in Hz +real q_sector !< half plane width in degrees (for iq_grid=1,2) +real q_dstep !< step size for generating BQF files +! +integer, parameter :: mq_stack=10 !< maximum number of elements in stack +! +integer mlocus !< maximum number of points on locus for defining arrays +integer nlocus0 !< preferred number of points on locus +integer nlocus1 !< number of points on locus as computed in Q_CMPLOCUS +integer klocus !< number of points on locus as stored in quadruplet database + !< based on nlocus0, iq_gauleg and iq_lump (without compacting) + !< used in Q_ALLOCATE to define size of data arrays +integer nlocus !< number of points on locus, equal to klocus +integer nlocusx !< number of points on locus for use in computation (nlocusx <= nlocus) +! +real kqmin !< lowest wave number +real kqmax !< highest wave number +real wk_max !< maximum weight for wave number interpolation, set in Q_INIT +! +real k0x,k0y,dk0 !< components of initial wave number of locus, +real krefx,krefy !< components of reference wave number for quad-grid +real k1x,k1y !< components of k1 wave number +real k2x,k2y !< components of k2 wave number +real k3x,k3y !< components of k3 wave number +real k4x,k4y !< components of k4 wave number +real px,py !< components of difference k1-k3 wave number +real pmag !< magnitude of P-vector +real pang !< angle related of P-vector, Pang = atan2(py,px), (radians) +real sang !< angle of symmytry axis of locus, SANG = PANG +/ pi° (radians) +real xang !< angle of locus for the case that w1=w3, Xang=atan2(-px,py), (radians) +real q !< difference of radian frequencies, used in Resio-Tracy method +real kmin_loc !< minimum wave number of locus along symmetry axis +real kmax_loc !< maximum wave number of locus along symmetry axis +real kmid !< wave number at midpoint of locus along symmetry axis +real kmidx !< x-component of wave number at midpoint of locus along symmetry axis +real kmidy !< y-component of wave number at midpoint of locus along symmetry axis +real loc_crf !< circumference of locus in (kx,ky)-space +real loc_area !< area of locus, measured in (kx-ky)- space +real loc_xz !< x-coordinate of center of gravity of locus in (kx,ky)-space +real loc_yz !< y-coordinate of center of gravity of locus in (kx,ky)-space ! ! data for extended input k-grid, necessary when input grid is smaller than ! internal k-grid. @@ -244,144 +256,144 @@ module m_xnldata ! information about pre_computed locus, only half the angles need to be saved ! ! -integer, allocatable :: quad_nloc(:,:) ! number of points on locus -integer, allocatable :: quad_ik2(:,:,:) ! lower wave number index of k2 -integer, allocatable :: quad_ia2(:,:,:) ! lower direction index of k2 -integer, allocatable :: quad_ik4(:,:,:) ! lower wave number index of k4 -integer, allocatable :: quad_ia4(:,:,:) ! lower direction index of k4 -real, allocatable :: quad_w1k2(:,:,:) ! weight 1 of k2 -real, allocatable :: quad_w2k2(:,:,:) ! weight 2 of k2 -real, allocatable :: quad_w3k2(:,:,:) ! weight 3 of k2 -real, allocatable :: quad_w4k2(:,:,:) ! weight 4 of k2 -real, allocatable :: quad_w1k4(:,:,:) ! weight 1 of k4 -real, allocatable :: quad_w2k4(:,:,:) ! weight 2 of k4 -real, allocatable :: quad_w3k4(:,:,:) ! weight 3 of k4 -real, allocatable :: quad_w4k4(:,:,:) ! weight 4 of k4 -real, allocatable :: quad_zz (:,:,:) ! compound product of cple*ds*sym/jac +integer, allocatable :: quad_nloc(:,:) !< number of points on locus +integer, allocatable :: quad_ik2(:,:,:) !< lower wave number index of k2 +integer, allocatable :: quad_ia2(:,:,:) !< lower direction index of k2 +integer, allocatable :: quad_ik4(:,:,:) !< lower wave number index of k4 +integer, allocatable :: quad_ia4(:,:,:) !< lower direction index of k4 +real, allocatable :: quad_w1k2(:,:,:) !< weight 1 of k2 +real, allocatable :: quad_w2k2(:,:,:) !< weight 2 of k2 +real, allocatable :: quad_w3k2(:,:,:) !< weight 3 of k2 +real, allocatable :: quad_w4k2(:,:,:) !< weight 4 of k2 +real, allocatable :: quad_w1k4(:,:,:) !< weight 1 of k4 +real, allocatable :: quad_w2k4(:,:,:) !< weight 2 of k4 +real, allocatable :: quad_w3k4(:,:,:) !< weight 3 of k4 +real, allocatable :: quad_w4k4(:,:,:) !< weight 4 of k4 +real, allocatable :: quad_zz (:,:,:) !< compound product of cple*ds*sym/jac ! ! characteristic of computed locus ! -real, allocatable :: x2_loc(:) ! k2x coordinates around locus -real, allocatable :: y2_loc(:) ! k2y coordinates around locus -real, allocatable :: z_loc(:) ! data value around locus -real, allocatable :: s_loc(:) ! coordinate along locus -real, allocatable :: x4_loc(:) ! k4x coordinates around locus -real, allocatable :: y4_loc(:) ! k4y coordinates around locus -real, allocatable :: ds_loc(:) ! step size around locus -real, allocatable :: jac_loc(:) ! jacobian term around locus -real, allocatable :: cple_loc(:) ! coupling coefficient around locus -real, allocatable :: sym_loc(:) ! factor for symmetry between k3 and k4 -! -real, allocatable :: k_pol(:) ! wave numbers during polar generation of locus -real, allocatable :: c_pol(:) ! cosines during polar generation of locus -real, allocatable :: a_pol(:) ! angles of polar locus +real, allocatable :: x2_loc(:) !< k2x coordinates around locus +real, allocatable :: y2_loc(:) !< k2y coordinates around locus +real, allocatable :: z_loc(:) !< data value around locus +real, allocatable :: s_loc(:) !< coordinate along locus +real, allocatable :: x4_loc(:) !< k4x coordinates around locus +real, allocatable :: y4_loc(:) !< k4y coordinates around locus +real, allocatable :: ds_loc(:) !< step size around locus +real, allocatable :: jac_loc(:) !< jacobian term around locus +real, allocatable :: cple_loc(:) !< coupling coefficient around locus +real, allocatable :: sym_loc(:) !< factor for symmetry between k3 and k4 +! +real, allocatable :: k_pol(:) !< wave numbers during polar generation of locus +real, allocatable :: c_pol(:) !< cosines during polar generation of locus +real, allocatable :: a_pol(:) !< angles of polar locus ! ! characteristics of modified locus, result ! -real, allocatable :: x2_mod(:) ! k2x coordinates along locus -real, allocatable :: y2_mod(:) ! k2y coordinates along locus -real, allocatable :: x4_mod(:) ! k4x coordinates along locus -real, allocatable :: y4_mod(:) ! k4y coordinates along locus -real, allocatable :: z_mod(:) ! data value around locus -real, allocatable :: s_mod(:) ! coordinate along locus -real, allocatable :: ds_mod(:) ! step size around locus -real, allocatable :: jac_mod(:) ! jacobian term around locus -real, allocatable :: cple_mod(:) ! coupling coefficient around locus -real, allocatable :: sym_mod(:) ! factor for symmetry between k3 and k4 -! -real, allocatable :: k2m_mod(:) ! k2 magnitude around locus -real, allocatable :: k2a_mod(:) ! k2 angle around locus -real, allocatable :: k4m_mod(:) ! k4 magnitude around locus -real, allocatable :: k4a_mod(:) ! k4 angle around locus +real, allocatable :: x2_mod(:) !< k2x coordinates along locus +real, allocatable :: y2_mod(:) !< k2y coordinates along locus +real, allocatable :: x4_mod(:) !< k4x coordinates along locus +real, allocatable :: y4_mod(:) !< k4y coordinates along locus +real, allocatable :: z_mod(:) !< data value around locus +real, allocatable :: s_mod(:) !< coordinate along locus +real, allocatable :: ds_mod(:) !< step size around locus +real, allocatable :: jac_mod(:) !< jacobian term around locus +real, allocatable :: cple_mod(:) !< coupling coefficient around locus +real, allocatable :: sym_mod(:) !< factor for symmetry between k3 and k4 +! +real, allocatable :: k2m_mod(:) !< k2 magnitude around locus +real, allocatable :: k2a_mod(:) !< k2 angle around locus +real, allocatable :: k4m_mod(:) !< k4 magnitude around locus +real, allocatable :: k4a_mod(:) !< k4 angle around locus ! ! result of subroutine Q_weight ! -real, allocatable :: wk_k2(:) ! position of k2 and k4 wave number -real, allocatable :: wk_k4(:) ! w.r.t. discrete k-grid -real, allocatable :: wa_k2(:) ! position of k2 and k4 wave number -real, allocatable :: wa_k4(:) ! w.r.t. discrete a-grid -real, allocatable :: wt_k2(:) ! weight factor in tail, -real, allocatable :: wt_k4(:) ! wt==1 for wave numbers inside k-grid -! -integer, allocatable :: t_ik2(:) ! transformed weight for k2-magnitude -integer, allocatable :: t_ia2(:) ! transformed direction for k2 -integer, allocatable :: t_ik4(:) ! transformed tail factor for k2 -integer, allocatable :: t_ia4(:) ! transformed weight for k4 -real, allocatable :: t_w1k2(:) ! transformed weight 1 for k2 -real, allocatable :: t_w2k2(:) ! transformed weight 2 for k2 -real, allocatable :: t_w3k2(:) ! transformed weight 3 for k2 -real, allocatable :: t_w4k2(:) ! transformed weight 4 for k2 -real, allocatable :: t_w1k4(:) ! transformed weight 1 for k4 -real, allocatable :: t_w2k4(:) ! transformed weight 2 for k4 -real, allocatable :: t_w3k4(:) ! transformed weight 3 for k4 -real, allocatable :: t_w4k4(:) ! transformed weight 4 for k4 -real, allocatable :: t_zz(:) ! product term +real, allocatable :: wk_k2(:) !< position of k2 and k4 wave number +real, allocatable :: wk_k4(:) !< w.r.t. discrete k-grid +real, allocatable :: wa_k2(:) !< position of k2 and k4 wave number +real, allocatable :: wa_k4(:) !< w.r.t. discrete a-grid +real, allocatable :: wt_k2(:) !< weight factor in tail, +real, allocatable :: wt_k4(:) !< wt==1 for wave numbers inside k-grid +! +integer, allocatable :: t_ik2(:) !< transformed weight for k2-magnitude +integer, allocatable :: t_ia2(:) !< transformed direction for k2 +integer, allocatable :: t_ik4(:) !< transformed tail factor for k2 +integer, allocatable :: t_ia4(:) !< transformed weight for k4 +real, allocatable :: t_w1k2(:) !< transformed weight 1 for k2 +real, allocatable :: t_w2k2(:) !< transformed weight 2 for k2 +real, allocatable :: t_w3k2(:) !< transformed weight 3 for k2 +real, allocatable :: t_w4k2(:) !< transformed weight 4 for k2 +real, allocatable :: t_w1k4(:) !< transformed weight 1 for k4 +real, allocatable :: t_w2k4(:) !< transformed weight 2 for k4 +real, allocatable :: t_w3k4(:) !< transformed weight 3 for k4 +real, allocatable :: t_w4k4(:) !< transformed weight 4 for k4 +real, allocatable :: t_zz(:) !< product term ! ! corresponding declarations ! -integer, allocatable :: r_ik2(:) -integer, allocatable :: r_ia2(:) -integer, allocatable :: r_ik4(:) -integer, allocatable :: r_ia4(:) -real, allocatable :: r_w1k2(:),r_w2k2(:),r_w3k2(:),r_w4k2(:) -real, allocatable :: r_w1k4(:),r_w2k4(:),r_w3k4(:),r_w4k4(:) -real, allocatable :: r_zz(:),r_jac(:),r_cple(:),r_sym(:),r_ws(:) -! -real, allocatable :: dt13(:) ! increment along locus -! -real, allocatable :: q_xk(:) ! extended wave number array starting at index 0 -real, allocatable :: q_sk(:) ! step size of extended wave number array -real sk_max ! maximum wave number in extended array -! -real, allocatable :: q_k(:) ! wave number grid [1/m] -real, allocatable :: q_dk(:) ! width of wave number bins [1/m] -real, allocatable :: q_kpow(:) ! wave number to a certain power, used in filtering -real, allocatable :: q_f(:) ! frequencies accociated to wave number/depth -real, allocatable :: q_df(:) ! step size of frequency grid -real, allocatable :: q_sig(:) ! radian frequencies associated to wave number/depth -real, allocatable :: q_dsig(:) ! step size of radian frequency grid -real, allocatable :: q_cg(:) ! group velocity (m/s) -real, allocatable :: q_a(:) ! directions of quadruplet grid in radians -real, allocatable :: q_ad(:) ! directions of quadruplet grid in degrees -real, allocatable :: a(:,:) ! Action density on wave number grid A(sigma,theta) -real, allocatable :: nspec(:,:) ! Action density on wave number grid N(kx,ky) -real, allocatable :: nk1d(:) ! Internal 1d action density spectrum N(k) -real, allocatable :: qnl(:,:) ! Nonlinear energy transfer Snl(k,theta) -! -integer id_facmax ! Factor for determining range of depth search (Q_SEARCHGRID) -real q_dird1,q_dird2 ! first and last direction of host model (via XNL_INIT) degrees -real q_depth ! local water depth in m -real q_maxdepth ! maximum water depth, set in XNL_INIT, used in Q_CTRGRID -real q_mindepth ! minimum water depth, set in XNL_INIT, used in Q_CTRGRID -real q_lambda ! geometric scaling factor for 'deep' water loci -real q_scale ! additional scale factor resulting from SEARCH for neasrest grid -! -real eps_q ! absolute accuracy for check of Q -real eps_k ! absolute accuracy for equality check of k -real rel_k ! relative accuracy for equality check of k -! -integer iq_stack ! Sequence number of stack with subroutine calls -character(len=21) cstack(mq_stack) ! Stack with module names +integer, allocatable :: r_ik2(:) !< corresponding declarations r_ik2 +integer, allocatable :: r_ia2(:) !< corresponding declarations r_ia2 +integer, allocatable :: r_ik4(:) !< corresponding declarations r_ik4 +integer, allocatable :: r_ia4(:) !< corresponding declarations r_ia4 +real, allocatable :: r_w1k2(:),r_w2k2(:),r_w3k2(:),r_w4k2(:) !< corresponding declarations +real, allocatable :: r_w1k4(:),r_w2k4(:),r_w3k4(:),r_w4k4(:) !< corresponding declarations +real, allocatable :: r_zz(:),r_jac(:),r_cple(:),r_sym(:),r_ws(:) !< corresponding declarations +! +real, allocatable :: dt13(:) !< increment along locus +! +real, allocatable :: q_xk(:) !< extended wave number array starting at index 0 +real, allocatable :: q_sk(:) !< step size of extended wave number array +real sk_max !< maximum wave number in extended array +! +real, allocatable :: q_k(:) !< wave number grid [1/m] +real, allocatable :: q_dk(:) !< width of wave number bins [1/m] +real, allocatable :: q_kpow(:) !< wave number to a certain power, used in filtering +real, allocatable :: q_f(:) !< frequencies accociated to wave number/depth +real, allocatable :: q_df(:) !< step size of frequency grid +real, allocatable :: q_sig(:) !< radian frequencies associated to wave number/depth +real, allocatable :: q_dsig(:) !< step size of radian frequency grid +real, allocatable :: q_cg(:) !< group velocity (m/s) +real, allocatable :: q_a(:) !< directions of quadruplet grid in radians +real, allocatable :: q_ad(:) !< directions of quadruplet grid in degrees +real, allocatable :: a(:,:) !< Action density on wave number grid A(sigma,theta) +real, allocatable :: nspec(:,:) !< Action density on wave number grid N(kx,ky) +real, allocatable :: nk1d(:) !< Internal 1d action density spectrum N(k) +real, allocatable :: qnl(:,:) !< Nonlinear energy transfer Snl(k,theta) +! +integer id_facmax !< Factor for determining range of depth search (Q_SEARCHGRID) +real q_dird1,q_dird2 !< first and last direction of host model (via XNL_INIT) degrees +real q_depth !< local water depth in m +real q_maxdepth !< maximum water depth, set in XNL_INIT, used in Q_CTRGRID +real q_mindepth !< minimum water depth, set in XNL_INIT, used in Q_CTRGRID +real q_lambda !< geometric scaling factor for 'deep' water loci +real q_scale !< additional scale factor resulting from SEARCH for neasrest grid +! +real eps_q !< absolute accuracy for check of Q +real eps_k !< absolute accuracy for equality check of k +real rel_k !< relative accuracy for equality check of k +! +integer iq_stack !< Sequence number of stack with subroutine calls +character(len=21) cstack(mq_stack) !< Stack with module names ! ! characteristics of locus ! -real crf1 ! estimated circumference of locus +real crf1 !< estimated circumference of locus !--------------------------------------------------------------------------------- ! ! information about type of grid ! -integer iaref ! index of first angle of reference wave numbers -integer iamax ! maximum difference in indices for sector grids -integer iaq1,iaq2 ! indices of do-loop for directions -integer iag1,iag2 ! range of directions for precomputed interaction grid -real q_ang1,q_ang2 ! lower and upper angle of grid in degrees -real q_delta ! directional spacing of angular grid in radians -real q_deltad ! directional spacing of angular grid in degrees +integer iaref !< index of first angle of reference wave numbers +integer iamax !< maximum difference in indices for sector grids +integer iaq1,iaq2 !< indices of do-loop for directions +integer iag1,iag2 !< range of directions for precomputed interaction grid +real q_ang1,q_ang2 !< lower and upper angle of grid in degrees +real q_delta !< directional spacing of angular grid in radians +real q_deltad !< directional spacing of angular grid in degrees ! -real q_ffac ! geometric factor between subsequent frequencies -real q_kfac ! geometric factor between subsequent wave numbers - ! (only valid for IQ_IDISP==1) -real qk_tail ! power of spectral tail of N(k), computed from qf_tail +real q_ffac !< geometric factor between subsequent frequencies +real q_kfac !< geometric factor between subsequent wave numbers + !< (only valid for IQ_IDISP==1) +real qk_tail !< power of spectral tail of N(k), computed from qf_tail ! !----------------------------------------------------------------------------- ! @@ -399,28 +411,55 @@ module m_xnldata ! !============== General settings ================= ! -integer iq_type ! method for computing the nonlinear interactions -! depending on the value of iq_type a number of settings -! for other processes or schematizations are set in Q_COMPU -! iq_type==1: deep water, symmetric spectrum, Webb coupling coefficient -! 2: deep water computation with WAM depth scaling based on Herterich -! and Hasselmann (1980) -! 3: finite depth transfer +integer iq_type !< method for computing the nonlinear interactions +!< depending on the value of iq_type a number of settings +!< for other processes or schematizations are set in Q_COMPU +!< iq_type==1: deep water, symmetric spectrum, Webb coupling coefficient +!< 2: deep water computation with WAM depth scaling based on Herterich +!< and Hasselmann (1980) +!< 3: finite depth transfer ! -integer iq_err ! counts the number of errors -! if no error occurred, IQ_ERR = 0 -! for each occuring error, iq_err is incremented -! errors are always terminating -! routine Q_ERROR handles the reporting on the error +integer iq_err !< counts the number of errors +!< if no error occurred, IQ_ERR = 0 +!< for each occuring error, iq_err is incremented +!< errors are always terminating +!< routine Q_ERROR handles the reporting on the error ! -integer iq_warn ! counts the number of warnings +integer iq_warn !< counts the number of warnings ! ! indices for test output of actual integration ! these values are set and optionally modified in Q_SETCONFIG ! contains !---------------------------------------------------------------------------------- -!------------------------------------------------------------------------------ + +!> +!> @brief Initialize coefficients, integration space, file i/o for computation +!> nonlinear quadruplet wave-wave interaction. +!> +!> @details Set version number. +!> Set unit unit numbers. +!> Open quad related files. +!> Optionally reset configuration by a back door option. +!> Compute integration spaces for given water depths. +!> +!> @param[in] sigma Radian frequencies +!> @param[in] dird Directions (degrees) +!> @param[in] nsigma Number of sigma values +!> @param[in] ndir Number of directions +!> @param[in] pftail power of spectral tail, e.g. -4 or -5 +!> @param[in] x_grav gravitational acceleration +!> @param[in] depth depths for which integration space must be computed +!> @param[in] ndepth Number of water depths +!> @param[in] iquad Type of method for computing nonlinear interactions +!> @param[in] iqgrid Type of grid for computing nonlinear interactions +!> @param[in] iproc Processor number, controls output file for MPI +!> @param[out] ierr Error indicator. If no errors are detected IERR=0 +!> +!> @author Gerbrant van Vledder @date 4-Sep-2003 +!> +!------------------------------------------------------------------------------ + subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & & iquad,iqgrid,iproc,ierr) !------------------------------------------------------------------------------ @@ -490,7 +529,7 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & integer, intent(in) :: iquad ! Type of method for computing nonlinear interactions integer, intent(in) :: iqgrid ! Type of grid for computing nonlinear interactions integer, intent(in) :: iproc ! Processor number, controls output file for MPI -integer, intent(out) :: ierr ! Error indicator. If no errors are detected IERR=0 +integer, intent(out) :: ierr ! Error indicator. If no errors are detected IERR=0 ! ! 4. Error messages ! @@ -533,14 +572,14 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & ! ! Local parameters ! -integer iuerr ! error indicator -integer idepth ! index over water depths -integer igrid ! status of quadruplet grid file -integer ia,ik ! counters +integer iuerr !< error indicator +integer idepth !< index over water depths +integer igrid !< status of quadruplet grid file +integer ia,ik !< counters ! -real depmin ! minimum water depth -real dstep ! directional step -real dgap ! directional gap between first and last direction +real depmin !< minimum water depth +real dstep !< directional step +real dgap !< directional gap between first and last direction ! call q_setversion ! set version number !------------------------------------------------------------------------------ @@ -743,8 +782,29 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & ! ! return -end subroutine +end subroutine xnl_init + +!> +!> @brief Compute nonlinear transfer for a given action density spectrum +!> on a given sigma and direction grid (Webb/Resio/Tracy/Van Vledder). +!> +!> +!> @param[in] aspec Action density spectrum as a function of (sigma,theta) +!> @param[in] sigma radian frequencies +!> @param[in] angle directions in radians (sector or full circle) +!> @param[in] nsig number of frequencies (sigma) +!> @param[in] ndir number of directions +!> @param[in] depth water depth +!> @param[in] iquad method of computing nonlinear quadruplet interactions +!> @param[out] xnl nonlinear quadruplet interaction computed with a certain exact method (k,theta) +!> @param[out] diag diagonal term for semi-implicit integration +!> @param[in] iproc MPI processor number +!> @param[out] ierr error indicator +!> +!> @author Gerbrant Ph. van Vledder @date 27-Sep-2002 +!> !-----------------------------------------------------------------------------! + subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & & iproc, ierr) !-----------------------------------------------------------------------------! @@ -809,7 +869,7 @@ subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & real, intent(out) :: xnl(nsig,ndir) ! nonlinear quadruplet interaction computed with ! a certain exact method (k,theta) real, intent(out) :: diag(nsig,ndir) ! diagonal term for semi-implicit integration -integer, intent(out) :: ierr ! error indicator +integer, intent(out) :: ierr ! error indicator ! !-------------------------------------------------------------------------------- ! @@ -836,20 +896,20 @@ subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & !-------------------------------------------------------------------------------- ! local variables ! -integer, save :: i_qmain ! counter number of calls of XNL_MAIN -integer i_qlast ! value of iquad in last call +integer, save :: i_qmain !< counter number of calls of XNL_MAIN +integer i_qlast !< value of iquad in last call ! -integer isig ! counter for sigma values -integer idir ! counter of directions -real q_dfac ! depth scale factor for nonlinear transfer +integer isig !< counter for sigma values +integer idir !< counter of directions +real q_dfac !< depth scale factor for nonlinear transfer ! -real sum_e ! sum of energy -real sum_a ! sum of action -real sum_mx ! sum of momentum in x-direction -real sum_my ! sum of momentum in y-direction +real sum_e !< sum of energy +real sum_a !< sum of action +real sum_mx !< sum of momentum in x-direction +real sum_my !< sum of momentum in y-direction ! -data i_qmain /0/ ! keep track of number of calls of XNL_MAIN -data i_qlast /0/ ! keep track of last call with IQUAD +data i_qmain /0/ !< keep track of number of calls of XNL_MAIN +data i_qlast /0/ !< keep track of last call with IQUAD ! !-------------------------------------------------------------------------------- ! @@ -939,6 +999,15 @@ subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Check configuration for non-linear transfer. +!> +!> @details Allocate data arrays. +!> +!> @author Gerbrant van Vledder @date 8-Aug-2003 +!> + subroutine q_allocate !------------------------------------------------------------------------------ ! @@ -1003,8 +1072,8 @@ subroutine q_allocate ! ! Local variables !------------------------------------------------------------------------------- -integer maq ! number of theta elements in grid matrix -integer mkq ! number of k-elements in grid matrix +integer maq !< number of theta elements in grid matrix +integer mkq !< number of k-elements in grid matrix !------------------------------------------------------------------------------- call q_stack('+q_allocate') ! @@ -1155,6 +1224,15 @@ subroutine q_allocate return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Check configuration for computation of non-linear transfer. +!> +!> @details Check each parameter setting. +!> +!> @author Gerbrant van Vledder @date 12-Jun-2003 +!> + subroutine q_chkconfig !------------------------------------------------------------------------------ ! @@ -1331,6 +1409,28 @@ subroutine q_chkconfig return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Check conservation laws of non-linear transfer. +!> +!> @details The following conservation laws should be fulfilled: +!> @verbatim +!> Wave Energy SUME=0 +!> Wave Action SUMA=0 +!> Momentum vector SUMMX,SUMMY=0 +!> @endverbatim +!> +!> @param[in] xnl Transfer rate. +!> @param[in] nk Number of wave numbers. +!> @param[in] ndir Number of directions. +!> @param[out] sum_e Sum of wave energy. +!> @param[out] sum_a Sum of wave action. +!> @param[out] sum_mx Sum of momentum in x-direction. +!> @param[out] sum_my Sum of momentum in y-direction. +!> +!> @author Gerbrant van Vledder @date 13-Aug-2002 +!> + subroutine q_chkcons(xnl,nk,ndir,sum_e,sum_a,sum_mx,sum_my) !------------------------------------------------------------------------------ ! @@ -1439,6 +1539,37 @@ subroutine q_chkcons(xnl,nk,ndir,sum_e,sum_a,sum_mx,sum_my) return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Check resonance conditions of 4 interacting wave numbers +!> for a given water depth and dispersion relation. +!> +!> @details The sum of wave number vectors and associated radian frequencies +!> are computed: +!> +!> @verbatim +!> k1 + k2 - (k3 + k4) +!> w1 + w2 - (w3 + w4) +!> +!> in which w_i = g k_i tanh(k_i d) +!> @endverbatim +!> +!> @param[inout] k1x X-component of wave number vector k1 +!> @param[inout] k1y Y-component of wave number vector k1 +!> @param[inout] k2x X-component of wave number vector k2 +!> @param[inout] k2y Y-component of wave number vector k2 +!> @param[inout] k3x X-component of wave number vector k3 +!> @param[inout] k3y Y-component of wave number vector k3 +!> @param[inout] k4x X-component of wave number vector k4 +!> @param[inout] k4y Y-component of wave number vector k4 +!> @param[inout] dep Depth in m +!> @param[inout] sum_kx Sum of x-components of quadruplet +!> @param[inout] sum_ky Sum of y-components of quadruplet +!> @param[inout] sum_w Sum of radian frequencies +!> +!> @author Gerbrant Van Vledder @date 9-Aug-2002 +!> + subroutine q_chkres(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,dep,sum_kx,sum_ky,sum_w) !------------------------------------------------------------------------------ ! @@ -1524,8 +1655,24 @@ subroutine q_chkres(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,dep,sum_kx,sum_ky,sum_w) sum_w = w1 + w2 - (w3 + w4) ! return -end subroutine +end subroutine q_chkres + !------------------------------------------------------------------------------ +!> +!> @brief Compute locus function used for the determination of the +!> resonnance condition. +!> +!> @details See ALKYON, 1999. +!> +!> @param[out] ka Lowest wave number magnitude of k2-locus. +!> @param[out] kb Highest wave number magnitude of k2-locus. +!> @param[out] km Wave number magnitude at mid point. +!> @param[out] kw Half width of locus. +!> @param[out] loclen Estimated length of locus. +!> +!> @author Gerbrant van Vledder @date 8-Aug-2003 +!> + subroutine q_cmplocus(ka,kb,km,kw,loclen) !------------------------------------------------------------------------------ ! @@ -1783,6 +1930,40 @@ subroutine q_cmplocus(ka,kb,km,kw,loclen) return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Control of interaction grid administration. +!> +!> @details +!> @verbatim +!> The generation of the database file depend on the control varaible of IQ_MAKE +!> if IQ_MAKE==1, make a grid when needed +!> 2, always make grid +!> 3, make a grid and stop, useful for test purposes +!> +!> The maximum number of points on the locus, as stored in the BQF file +!> is read from the header and stored in the variable NLOCUS. +!> +!> Input parameter values: +!> +!> itask - task to perform by Q_CTRGRID +!> ==1: read and check header block +!> ==2: read and write grid file, according to setting of IQ_MAKE +!> +!> igrid - status of grid checking +!> ==0: a proper grid exists +!> ==1: grid file does not exist +!> ==2: grid file exists, but it is incorrect +!> ==3: read error in accessing grid information +!> +!> @endverbatim +!> +!> @param[in] itask Task to perform by Q_CTRGRID. +!> @param[out] igrid Status of grid checking. +!> +!> @author Gerbrant van Vledder @date 13-Sep-2003 +!> + subroutine q_ctrgrid(itask,igrid) !------------------------------------------------------------------------------ ! @@ -1839,15 +2020,8 @@ subroutine q_ctrgrid(itask,igrid) ! ! 3. Parameters used ! -integer, intent(in) :: itask ! task to perform by Q_CTRGRID -! ==1: read and check header block -! ==2: read and write grid file, according to -! setting of IQ_MAKE -integer, intent(out) :: igrid ! status of grid checking -! ==0: a proper grid exists -! ==1: grid file does not exist -! ==2: grid file exists, but it is incorrect -! ==3: read error in accessing grid information +integer, intent(in) :: itask +integer, intent(out) :: igrid ! ! 4. Error messages ! @@ -2198,6 +2372,27 @@ subroutine q_ctrgrid(itask,igrid) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute scaling factor for nonlinear transfer in finite depth. +!> +!> @details Compute mean wave number km. +!> +!> Compute scale factor based on parameterized function of (km*d) +!> according to Herterich and Hasselmann +!> and parameterisation from WAM model. +!> +!> @param[in] n Number of sigma-values. +!> @param[in] sigma Number of directions. +!> @param[in] angle N(nsig,nang) Action density. +!> @param[in] nsig Sigma values. +!> @param[in] nang Directions in (radians). +!> @param[in] depth Depth (m). +!> @param[in] grav Gravitational acceleration. +!> @param[out] q_dfac Scale factor. +!> +!> @author Gerbrant van Vledder @date 23-Aug-2002 +!> + subroutine q_dscale(n,sigma,angle,nsig,nang,depth,grav,q_dfac) !------------------------------------------------------------------------------ ! @@ -2330,6 +2525,21 @@ subroutine q_dscale(n,sigma,angle,nsig,nang,depth,grav,q_dfac) return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Error handling routine. +!> +!> @details Produces a warning to an error +!> that has occured prints the error message and print +!> module stack to trace the origin of the error. +!> +!> @param[in] err_type Type of error. +!> @param[in] err_name Reference to error message. +!> @param[in] err_msg Optional additional error message. +!> +!> @author Gerbrant van Vledder @date 8-Aug-2002 +!> + subroutine q_error(err_type,err_name,err_msg) !------------------------------------------------------------------------------ ! @@ -2509,6 +2719,25 @@ subroutine q_error(err_type,err_name,err_msg) return end subroutine !------------------------------------------------------------------------------ + +!> +!> @brief Retrieve locus from basic locus as stored in the database. +!> +!> @details In the case of geometric scaling, k-scaling is used using scale laws +!> described by Tracy. +!> +!> Directional transformation using linear transformations, shifting and mirror +!> imaging. +!> +!> @param[in] ik1 K-index of wave number k1. +!> @param[in] ia1 Theta-index of wave number k1. +!> @param[in] ik3 K-index of wave number k3. +!> @param[in] ia3 Theta-index of wave number k3. +!> @param[out] ifnd Indicator if reference locus exists in database. +!> +!> @author Gerbrant van Vledder @date 27-Aug-2003 +!> + subroutine q_getlocus(ik1,ia1,ik3,ia3,ifnd) !------------------------------------------------------------------------------ ! @@ -2869,6 +3098,25 @@ subroutine q_getlocus(ik1,ia1,ik3,ia3,ifnd) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Initializing module for quadruplets and setting default settings. +!> +!> @details Conversion of power of spectral tail from E(f) to N(k) using the +!> following relations: +!> +!> @verbatim +!> E(f) ~ f^qf_tail +!> +!> N(k) ~ k^qk_tail +!> +!> qk_tail = qf_tail/2 -1 +!> +!> See also Note 13 of G.Ph. van Vledder +!> @endverbatim +!> +!> @author Gerbrant van Vledder @date 25-Sep-2002 +!> + subroutine q_init !------------------------------------------------------------------------------ ! @@ -3150,6 +3398,18 @@ subroutine q_init return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute characteristics of locus used to optimize its acutal computation. +!> +!> @param[out] ka Minimum k along symmetry axis. +!> @param[out] kb Maximum k along symmetry axis. +!> @param[out] km Wave number at midpoint. +!> @param[out] kw Half width of locus at midpoint. +!> @param[out] loclen Estimated length of locus. +!> +!> @author Gerbrant van Vledder @date 14-Oct-2002 +!> + subroutine q_locpos(ka,kb,km,kw,loclen) !------------------------------------------------------------------------------ ! @@ -3491,6 +3751,15 @@ subroutine q_locpos(ka,kb,km,kw,loclen) end subroutine ! !------------------------------------------------------------------------------ +!> +!> @brief Set-up grid for computation of loci. +!> +!> @details Generate data file with basic loci for computation of +!> nonlinear quadruplet interactions. +!> +!> @author Gerbrant van Vledder @date 10-Jun-2003 +!> + subroutine q_makegrid !------------------------------------------------------------------------------ ! @@ -3863,6 +4132,19 @@ subroutine q_makegrid return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Modify points along the locus, such that they are evenly distributed +!> only when intended, i.e. when IQ_LOCUS==2. +!> +!> @details Compute new spacing along locus. +!> Redistribute points and coefficient at new spacing using linear interpolation. +!> Output DIA configuration when also lumping active. +!> +!> If no redistribution is needed, then copy relevant data. +!> +!> @author Gerbrant van Vledder @date 11-Jun-2003 +!> + subroutine q_modify !------------------------------------------------------------------------------ ! @@ -4231,6 +4513,24 @@ subroutine q_modify return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute position of locus for given k1-k3 vector. +!> +!> @details Explicit polar method, see Van Vledder 2000, Monterey paper. +!> Optionally using a fixed k-step, geometric k-step or adaptive stepping. +!> +!> @param[in] kmin Minimum wave number on locus. +!> @param[in] kmax Maximum wave number on locus. +!> @param[in] kx_beg X-coordinate of begin point. +!> @param[in] ky_beg Y-coordinate of begin point. +!> @param[in] kx_end X-coordinate of end point. +!> @param[in] ky_end Y-coordinate of end point. +!> @param[in] loclen Estimated length of locus. +!> @param[out] ierr Error condition. +!> +!> @author Gerbrant van Vledder @date 8-Aug-2003 +!> + subroutine q_polar2(kmin,kmax,kx_beg,ky_beg,kx_end,ky_end,loclen,ierr) !------------------------------------------------------------------------------ ! @@ -4475,6 +4775,22 @@ subroutine q_polar2(kmin,kmax,kx_beg,ky_beg,kx_end,ky_end,loclen,ierr) return end subroutine !----------------------------------------------------------------------------------- +!> +!> @brief Set settings for computing the nonlinear interactions. +!> +!> @details Set optimal basic settings. +!> Set some settings based on the value of IQUAD. +!> +!> Based on the value of IQUAD a number of settings are preset. +!> In the case the file [qbase].CFG exists, this file +!> is analyzed and possibly some settings are reset. +!> +!> @param[in] iquad Indicator for a specific choice of settings +!> for computing the nonlinear interactions. +!> +!> @author Gerbrant van Vledder @date 16-Jun-2003 +!> + subroutine q_setconfig(iquad) !------------------------------------------------------------------------------ ! @@ -4719,6 +5035,18 @@ subroutine q_setconfig(iquad) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Search nearest valid grid, read grid file and scale factor. +!> +!> @details Using the actual water depth all possible interaction grids are +!> checked in upward and downward direction. +!> +!> @param[in] depth Depth for which grid file must be found. +!> @param[out] igrid Status of grid checking. +!> +!> @author Gerbrant van Vledder @date 9-Sep-2003 +!> + subroutine q_searchgrid(depth,igrid) !------------------------------------------------------------------------------ ! @@ -4939,6 +5267,14 @@ subroutine q_searchgrid(depth,igrid) return end subroutine !----------------------------------------------------------------- +!> +!> @brief Subroutine has automatically been written by MODULE5. +!> +!> @details Source code options:S. Do not use m_xnldata. +!> +!> @author Gerbrant van Vledder @date 15-Sep-2003 +!> + subroutine q_setversion !----------------------------------------------------------------- ! do not use m_xnldata @@ -4953,6 +5289,23 @@ subroutine q_setversion return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Add or remove mod_name name from module stack. +!> +!> @details Mod_name must be preceeded by a '+' , '-'. +!> +!> The module name is pushed to the stack when preceeded by '+' +!> and removed if mname starts with '-'. +!> +!> In case an error is active,the module name is not removed +!> from the stack if mname starts with a '-'. The module is +!> always removed from the stack if mname starts with '!'. +!> +!> @param[in] mod_name Module name. +!> +!> @author Gerbrant van Vledder @date 11-Jun-2003 +!> + subroutine q_stack(mod_name) !------------------------------------------------------------------------------ ! @@ -5064,6 +5417,16 @@ subroutine q_stack(mod_name) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Write summary of GurboQuad settings to print file. +!> +!> @details Based on the value of IQUAD a number of settings are preset. +!> In the case the file [qbase].CFG exists, this file is analyzed and +!> possibly some settings are reset. +!> +!> @author Gerbrant van Vledder @date 16-Jun-2003 +!> + subroutine q_summary !------------------------------------------------------------------------------ ! @@ -5265,6 +5628,23 @@ subroutine q_summary return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute symmetry factor to reduce integration. +!> +!> @details Compute distance between k1 and k3, and between k4 and k1. +!> +!> @param[in] k1x X-component of wave number k1. +!> @param[in] k1y Y-component of wave number k1. +!> @param[in] k3x X-component of wave number k3. +!> @param[in] k3y Y-component of wave number k3. +!> @param[in] k4x X-components of wave number k4. +!> @param[in] k4y Y-components of wave number k4. +!> @param[out] symfac Symmetry factor. +!> @param[in] nloc Number of points in array with wave number. +!> +!> @author Gerbrant van Vledder @date 16-Jun-2003 +!> + subroutine q_symmetry(k1x,k1y,k3x,k3y,k4x,k4y,symfac,nloc) !------------------------------------------------------------------------------ ! @@ -5346,6 +5726,22 @@ subroutine q_symmetry(k1x,k1y,k3x,k3y,k4x,k4y,symfac,nloc) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute the function T13, defined as a line integral around a locus. +!> +!> @details See Tracy and Resio (1982) and Van Vledder (1999). +!> +!> @param[in] ik1 Index of k-component of wave number k1 +!> @param[in] ia1 Index of a-component of wave number k1. +!> @param[in] ik3 Index of k-component of wave number k3. +!> @param[in] ia3 Index of a-component of wave number k3. +!> @param[out] t13 Value of line integral over a specific locus. +!> @param[out] diagk1 Contribution to diagonal term of k1. +!> @param[out] diagk3 Contribution to diagonal term of k3. +!> +!> @author Gerbrant van Vledder @date 5-Sep-2003 +!> + subroutine q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) !------------------------------------------------------------------------------ ! @@ -5589,6 +5985,15 @@ subroutine q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute interpolation weights of locus. +!> +!> @details Compute position of wave number in wave number grid. +!> Usable for linear interpolation. +!> +!> @author Gerbrant van Vledder @date 20-Aug-2002 +!> + subroutine q_weight !------------------------------------------------------------------------------ ! @@ -5793,6 +6198,25 @@ subroutine q_weight return end subroutine !----------------------------------------------------------------- +!> +!> @brief Compute locus for the special case w1=w3. +!> +!> @details For this case, the k2-locus consists of a straight line. +!> +!> @param[inout] k1x X-component of wave number k1. +!> @param[inout] k1y Y-component of wave number k1. +!> @param[inout] k3x X-component of wave number k3. +!> @param[inout] k3y Y-component of wave number k3. +!> @param[inout] npts Number of points. +!> @param[inout] k2x X-component of wave number k2. +!> @param[inout] k2y Y-component of wave number k2. +!> @param[inout] k4x X-component of wave number k4. +!> @param[inout] k4y Y-component of wave number k4. +!> @param[inout] s Distance along locus. +!> +!> @author Gerbrant van Vledder @date 11-Jun-2003 +!> + subroutine q_loc_w1w3(k1x,k1y,k3x,k3y,npts,k2x,k2y,k4x,k4y,s) !----------------------------------------------------------------- ! @@ -5922,6 +6346,29 @@ subroutine q_loc_w1w3(k1x,k1y,k3x,k3y,npts,k2x,k2y,k4x,k4y,s) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute nonlinear transfer for a given action density spectrum +!> on a given wave number and direction grid. +!> +!> @details Compute nonlinear transfer in a surface gravity wave spectrum +!> due to resonant four wave-wave interactions. +!> +!> Methods: Webb/Resio/Tracy/VanVledder. +!> +!> @param[in] aspec Action density spectrum as a function of (sigma,theta). +!> @param[in] sigma Radian frequencies. +!> @param[in] angle Directions in radians (sector or full circle). +!> @param[in] nsig Number of radian frequencies. +!> @param[in] nang Number of directions. +!> @param[in] depth Water depth in m. +!> @param[out] xnl Nonlinear quadruplet interaction computed with +!> a certain exact method (k,theta). +!> @param[out] diag Diagonal term for WAM based implicit integration scheme. +!> @param[out] ierr Error indicator. +!> +!> @author Gerbrant van Vledder @date 25-Jun-2003 +!> + subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) !------------------------------------------------------------------------------ ! @@ -6290,6 +6737,18 @@ subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) return end subroutine !------------------------------------------------------------------------------ +!> +!> @brief Compute cosine of points on locus for given wave number k. +!> +!> @details Explicit polar method, see Van Vledder 2000, Monterey paper. +!> Optionally using a fixed k-step, geometric k-step or adaptive stepping. +!> +!> @param k Wave number along symmetry axis of locus. +!> @returns x_cosk +!> +!> @author Gerbrant van Vledder @date 13-Aug-2002 +!> + real function x_cosk(k) !------------------------------------------------------------------------------ ! @@ -6372,6 +6831,26 @@ real function x_cosk(k) ! end function x_cosk !------------------------------------------------------------------------------ +!> +!> @brief Compute coupling coefficient between a quadruplet of +!> interacting wave numbers. +!> +!> @param k1x X-component of wave number k1. +!> @param k1y Y-component of wave number k1. +!> @param k2x X-component of wave number k2. +!> @param k2y Y-component of wave number k2. +!> @param k3x X-component of wave number k3. +!> @param k3y Y-component of wave number k3. +!> @param k4x X-component of wave number k4. +!> @param k4y Y-component of wave number k4. +!> @param iq_cple Type of coupling coefficient. +!> @param depth Water depth in meters. +!> @param grav Gravitational acceleration. +!> @returns x_cple +!> +!> @author Gerbrant van Vledder @date 10-Sep-2002 +!> + real function x_cple(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,iq_cple,depth,grav) !------------------------------------------------------------------------------ ! @@ -6469,6 +6948,19 @@ real function x_cple(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,iq_cple,depth,grav) return end function !------------------------------------------------------------------------------ +!> +!> @brief Compute locus function used for the determination of the +!> resonance condition. +!> +!> @details Explicit function evaluation. +!> +!> @param kxx X-component of wave number. +!> @param kyy Y-component of wave number. +!> @returns x_flocus +!> +!> @author Gerbrant van Vledder @date 9-Aug-2002 +!> + real function x_flocus(kxx,kyy) !------------------------------------------------------------------------------ ! @@ -6561,6 +7053,22 @@ real function x_flocus(kxx,kyy) return end function !------------------------------------------------------------------------------ +!> +!> @brief Compute gradient/Jacobian term for a given point on the locus. +!> +!> @details Explicit expressions for gradient term. +!> Using expression of Rasmussen (1998). +!> J = |cg2-cg4|. +!> +!> @param x2 X-component of wave number k2. +!> @param y2 Y-component of wave number k2. +!> @param x4 X-component of wave number k4. +!> @param y4 Y-component of wave number k4. +!> @returns x_jacobian +!> +!> @author Gerbrant van Vledder @date 9-Aug-2002 +!> + real function x_jacobian(x2,y2,x4,y4) !------------------------------------------------------------------------------ ! @@ -6660,6 +7168,25 @@ real function x_jacobian(x2,y2,x4,y4) return end function !------------------------------------------------------------------------------ +!> +!> @brief Compute radian frequency for a given wave number and water depth. +!> +!> @details +!> @verbatim +!> Depending on the value of the parameter iq_disp the radian +!> wave number is computed as: +!> 1) deep water +!> 2) finite depth linear dispersion relation +!> 3) finited depth non-linear dispersion relation (NOT YET implemented) +!> @endverbatim +!> +!> @param k Wave number. +!> @param d Water depth in m. +!> @returns x_disper +!> +!> @author Gerbrant van Vledder @date 9-Aug-2002 +!> + real function x_disper(k,d) !------------------------------------------------------------------------------ ! @@ -6744,6 +7271,17 @@ real function x_disper(k,d) return end function !------------------------------------------------------------------------------ +!> +!> @brief Compute locus function along symmetry axis. +!> +!> @details See ALKYON, 1999. +!> +!> @param k2 Magnitude of wave number k2. +!> @returns x_locus1 +!> +!> @author Gerbrant van Vledder @date 9-Aug-2002 +!> + real function x_locus1(k2) !------------------------------------------------------------------------------ ! @@ -6829,6 +7367,17 @@ real function x_locus1(k2) return end function !------------------------------------------------------------------------------ +!> +!> @brief Compute locus function perpendicluar to symmetry axis. +!> +!> @details See ALKYON, 1999. +!> +!> @param lambda +!> @returns x_locus2 +!> +!> @author Gerbrant van Vledder @date 9-Aug-2002 +!> + real function x_locus2(lambda) !------------------------------------------------------------------------------ ! @@ -6921,6 +7470,23 @@ real function x_locus2(lambda) return end function !------------------------------------------------------------------------------ +!> +!> @brief N/A +!> +!> @param w1x0 +!> @param w1y0 +!> @param w2x0 +!> @param w2y0 +!> @param w3x0 +!> @param w3y0 +!> @param z4x +!> @param z4y +!> @param h +!> @returns xc_hh +!> +!> @author N/A @date N/A +!> + real function xc_hh(w1x0,w1y0,w2x0,w2y0,w3x0,w3y0,z4x,z4y,h) !------------------------------------------------------------------------------ ! @@ -7230,6 +7796,15 @@ real function xc_hh(w1x0,w1y0,w2x0,w2y0,w3x0,w3y0,z4x,z4y,h) RETURN end function +!> +!> @brief N/A. +!> +!> @param x +!> @returns tanz +!> +!> @author N/A @date N/A +!> + real function tanz(x) real x ! print *,'inside tanz ' @@ -7239,6 +7814,15 @@ real function tanz(x) return end function +!> +!> @brief N/A. +!> +!> @param x +!> @returns cosz +!> +!> @author N/A @date N/A +!> + real function cosz(x) real x if (x.gt.20.) x=25. @@ -7248,6 +7832,26 @@ real function cosz(x) !------------------------------------------------------------------------------ +!> +!> @brief Compute deep water coupling coefficient for non-linear quadruplet +!> interactions. +!> +!> @details Webb (1978) and modified and corrected by Dungey and Hui (1979). +!> +!> @param k1x X-component of wave number k1. +!> @param k1y Y-component of wave number k1. +!> @param k2x X-component of wave number k2. +!> @param k2y Y-component of wave number k2. +!> @param k3x X-component of wave number k3. +!> @param k3y Y-component of wave number k3. +!> @param k4x X-component of wave number k4. +!> @param k4y Y-component of wave number k4. +!> @param grav gravitational acceleration m/s^2. +!> @returns xc_webb +!> +!> @author Gerbrant van Vledder @date 10-Sep-2002 +!> + real function xc_webb(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,grav) !------------------------------------------------------------------------------ ! diff --git a/model/src/w3src0md.F90 b/model/src/w3src0md.F90 index 0113016c1..8075c9eda 100644 --- a/model/src/w3src0md.F90 +++ b/model/src/w3src0md.F90 @@ -1,4 +1,16 @@ +!> @file +!> @brief Contains MODULE W3SRC0MD. +!> +!> @author H. L. Tolman @date 29-May-2009 +!> + #include "w3macros.h" +!> +!> @brief Mean wave parameter computation for case without input and +!> dissipation. +!> +!> @author H. L. Tolman @date 29-May-2009 +!> !/ ------------------------------------------------------------------- / MODULE W3SRC0MD !/ @@ -53,6 +65,19 @@ MODULE W3SRC0MD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate mean wave parameters. +!> +!> @param[in] A Action as a function of direction and wavenumber. +!> @param[in] CG Group velocities. +!> @param[in] WN Wavenumbers. +!> @param[out] EMEAN Mean wave energy. +!> @param[out] FMEAN Mean wave frequency. +!> @param[out] WNMEAN Mean wavenumber. +!> @param[out] AMAX Maximum action density in spectrum. +!> +!> @author H. L. Tolman @date 05-Jul-2006 +!> SUBROUTINE W3SPR0 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX) !/ !/ +-----------------------------------+ diff --git a/model/src/w3src1md.F90 b/model/src/w3src1md.F90 index 98aacdded..c67a65aa2 100644 --- a/model/src/w3src1md.F90 +++ b/model/src/w3src1md.F90 @@ -1,4 +1,16 @@ +!> @file +!> @brief Contains MODULE W3SRC1MD. +!> +!> @author H. L. Tolman @date 29-May-2009 +!> + #include "w3macros.h" +!> +!> @brief Bundle WAM cycle 3 input and dissipation source terms with +!> their defining parameters. +!> +!> @author H. L. Tolman @date 29-May-2009 +!> !/ ------------------------------------------------------------------- / MODULE W3SRC1MD !/ @@ -59,6 +71,19 @@ MODULE W3SRC1MD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief +!> +!> @param[in] A Action as a function of direction and wavenumber. +!> @param[in] CG Group velocities. +!> @param[in] WN Wavenumber. +!> @param[out] EMEAN Mean wave energy. +!> @param[out] FMEAN Mean wave frequency. +!> @param[out] WNMEAN mean wavenumber. +!> @param[out] AMAX Maximum action density in spectrum. +!> +!> @author H. L. Tolman @date 23-Dec-2004 +!> SUBROUTINE W3SPR1 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX) !/ !/ +-----------------------------------+ @@ -214,6 +239,19 @@ SUBROUTINE W3SPR1 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX) !/ END SUBROUTINE W3SPR1 !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate diagonal of input source (actual source term put +!> together in W3SRCE). +!> +!> @param[in] A Action density spectrum (1-D). +!> @param[in] K Wavenumber for entire spectrum. +!> @param[in] USTAR Friction velocity. +!> @param[in] USDIR Direction of USTAR. +!> @param[out] S Source term (1-D version). +!> @param[out] D Diagonal term of derivative. +!> +!> @author H. L. Tolman @date 23-Dec-2004 +!> SUBROUTINE W3SIN1 (A, K, USTAR, USDIR, S, D) !/ !/ +-----------------------------------+ @@ -381,6 +419,19 @@ SUBROUTINE W3SIN1 (A, K, USTAR, USDIR, S, D) !/ END SUBROUTINE W3SIN1 !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate whitecapping source term and diagonal term of derivative. +!> +!> @param[in] A Action density spectrum (1-D). +!> @param[in] K Wavenumber for entire spectrum. +!> @param[in] EMEAN Mean wave energy. +!> @param[in] FMEAN Mean wave frequency. +!> @param[in] WNMEAN Mean wavenumber. +!> @param[out] S Source term (1-D version). +!> @param[out] D Diagonal term of derivative. +!> +!> @author H. L. Tolman @date 23-Dec-2004 +!> SUBROUTINE W3SDS1 (A, K, EMEAN, FMEAN, WNMEAN, S, D) !/ !/ +-----------------------------------+ diff --git a/model/src/w3src2md.F90 b/model/src/w3src2md.F90 index 3f5450cd0..e8a182d76 100644 --- a/model/src/w3src2md.F90 +++ b/model/src/w3src2md.F90 @@ -1,4 +1,17 @@ +!> @file +!> @brief Contains MODULE W3SRC2MD. +!> +!> @author H. L. Tolman @date 29-May-2009 +!> + #include "w3macros.h" +!> +!> @brief Tolman and Chalikov (1996) input and dissipation source terms. +!> +!> @details Bundled with interpolation tables. +!> +!> @author H. L. Tolman @date 29-May-2009 +!> !/ ------------------------------------------------------------------- / MODULE W3SRC2MD !/ @@ -87,6 +100,28 @@ MODULE W3SRC2MD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate mean wave parameters for the use in the source term +!> routines (Tolman and Chalikov). +!> +!> @param[in] A Action density spectrum. +!> @param[in] CG Group velocities. +!> @param[in] WN Wavenumbers. +!> @param[in] DEPTH Water depth. +!> @param[in] FPI Peak input frequency. +!> @param[in] U Wind speed. +!> @param[in] USTAR Friction velocity. +!> @param[out] EMEAN Total energy (variance). +!> @param[out] FMEAN Mean frequency. +!> @param[out] WNMEAN Mean wavenumber. +!> @param[out] AMAX Maximum of action spectrum. +!> @param[out] ALFA Phillips' constant. +!> @param[out] FP Peak frequency. +!> +!> @author H. L. Tolman +!> @author D. Chalikov +!> @date 13-Apr-2007 +!> SUBROUTINE W3SPR2 (A, CG, WN, DEPTH, FPI, U, USTAR, & EMEAN, FMEAN, WNMEAN, AMAX, ALFA, FP ) !/ @@ -252,6 +287,24 @@ SUBROUTINE W3SPR2 (A, CG, WN, DEPTH, FPI, U, USTAR, & !/ END SUBROUTINE W3SPR2 !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate input source term. +!> +!> @param[in] A Action density spectrum (1-D). +!> @param[in] CG Group velocities for k-axis of spectrum. +!> @param[in] K Wavenumber for entire spectrum (1-D). +!> @param[in] U Wind speed at reference height. +!> @param[in] UDIR Direction of U. +!> @param[in] CD Drag coefficient at wind level ZWIND. +!> @param[in] Z0 Corresponding z0. +!> @param[out] FPI Input 'peak' frequency. +!> @param[out] S Source term (1-D version). +!> @param[out] D Diagonal term of derivative (1-D version). +!> +!> @author H. L. Tolman +!> @author D. Chalikov +!> @date 21-Feb-2004 +!> SUBROUTINE W3SIN2 ( A, CG, K, U, UDIR, CD, Z0, FPI, S, D ) !/ !/ +-----------------------------------+ @@ -515,6 +568,20 @@ SUBROUTINE W3SIN2 ( A, CG, K, U, UDIR, CD, Z0, FPI, S, D ) !/ END SUBROUTINE W3SIN2 !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate whitecapping source term and diagonal term of derivative. +!> +!> @param[in] A Input action density spectrum. +!> @param[in] CG Group velocity array. +!> @param[in] K Wavenumber array. +!> @param[in] FPI 'Peak frequency' of input (rad/s). +!> @param[in] USTAR Friction velocity (m/s). +!> @param[in] ALFA Phillips' constant. +!> @param[out] S Source term (1-D version). +!> @param[out] D Diagonal term of derivative (1-D version). +!> +!> @author H. L. Tolman @date 21-Feb-2004 +!> SUBROUTINE W3SDS2 (A, CG, K, FPI, USTAR, ALFA, S, D) !/ !/ +-----------------------------------+ @@ -763,6 +830,26 @@ SUBROUTINE W3SDS2 (A, CG, K, FPI, USTAR, ALFA, S, D) !/ END SUBROUTINE W3SDS2 !/ ------------------------------------------------------------------- / +!> +!> @brief Generate an interpolation table for the air-sea interaction +!> parameter of Chalikov and Belevich (1993). +!> +!> @details The size of the table is set in parameter statements, +!> the range is set by the input parameters of this routine. The first +!> counter of the table corresponds to the nondimensional frequency +!> +!> @verbatim +!> SIGMA Ul +!> SIGA = ---------- COS ( THETA - THETA ) (1) +!> g wind +!> @endverbatim +!> +!> The second counter of the table represents the drag coefficient. +!> The maximum values of both parameters are passed to the routine +!> through the parameter list. +!> +!> @author H. L. Tolman @date 21-Feb-2004 +!> SUBROUTINE INPTAB !/ !/ +-----------------------------------+ @@ -989,6 +1076,19 @@ SUBROUTINE INPTAB !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Calculate wind-wave interaction parameter beta. +!> +!> @param OMA Non-dimensional apparent frequency. +!> @param CL Drag coefficient at height l. +!> @param NDST +!> @returns W3BETA Wind-wave interaction parameter multiplied +!> by density ratio. +!> +!> @author H. L. Tolman +!> @author D. Chalikov +!> @date 21-Feb-2004 +!> REAL FUNCTION W3BETA ( OMA , CL , NDST ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3str1md.F90 b/model/src/w3str1md.F90 index 74b901faf..b4a7453a4 100644 --- a/model/src/w3str1md.F90 +++ b/model/src/w3str1md.F90 @@ -1,5 +1,18 @@ +!> @file +!> @brief Contains module W3STR1MD. +!> +!> @author A. J. van der Westhuysen @date 13-Jan-2013 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Module for inclusion of triad nonlinear interaction +!> according to Eldeberky's (1996) Lumped Triad Interaction (LTA) +!> source term. +!> +!> @author A. J. van der Westhuysen @date 13-Jan-2013 +!> MODULE W3STR1MD !/ !/ +-----------------------------------+ @@ -102,6 +115,70 @@ MODULE W3STR1MD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Triad interaction source term computed using the Lumped +!> Triad Appproximation (LTA) of Eldeberky (1996). +!> +!> @verbatim +!> The parametrized biphase is given by: +!> +!> 0.2 +!> beta = - pi/2 + pi/2 tanh ( ----- ) +!> Ur +!> +!> where Ur is the Ursell number. +!> +!> The source term as function of frequency p is: +!> +!> + - +!> S(p) = S(p) + S(p) +!> +!> in which +!> +!> + +!> S(p) = alpha Cp Cg,p (R(p/2,p/2))**2 sin (|beta|) ( E(p/2)**2 -2 E(p) E(p/2) ) +!> +!> - + +!> S(p) = - 2 S(2p) +!> +!> with alpha a tunable coefficient and R(p/2,p/2) is the interaction +!> coefficient of which the expression can be found in Eldeberky (1996). +!> +!> Note that a slightly adapted formulation of the LTA is used in +!> in the SWAN model: +!> +!> - Only positive contributions to higher harmonics are considered +!> here (no energy is transferred to lower harmonics). +!> +!> - The mean frequency in the expression of the Ursell number +!> is calculated according to the first order moment over the +!> zeroth order moment (personal communication, Y.Eldeberky, 1997). +!> +!> - The interactions are calculated up to 2.5 times the mean +!> frequency only. +!> +!> - Since the spectral grid is logarithmically distributed in frequency +!> space, the interactions between central bin and interacting bin +!> are interpolated such that the distance between these bins is +!> factor 2 (nearly). +!> +!> - The interactions are calculated in terms of energy density +!> instead of action density. So the action density spectrum +!> is firstly converted to the energy density grid, then the +!> interactions are calculated and then the spectrum is converted +!> to the action density spectrum back. +!> @endverbatim +!> +!> @param[in] A Action density spectrum (1-D) +!> @param[in] CG Group velocities. +!> @param[in] WN Wavenumbers. +!> @param[in] DEPTH Mean water depth. +!> @param[in] IX +!> @param[out] S Source term (1-D version). +!> @param[out] D Diagonal term of derivative (1-D version). +!> +!> @author A. J. van der Westhuysen @date 13-Jan-2013 +!> SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) !/ !/ +-----------------------------------+ diff --git a/model/src/w3str2md.F90 b/model/src/w3str2md.F90 index b66688b8b..3ef0a7001 100644 --- a/model/src/w3str2md.F90 +++ b/model/src/w3str2md.F90 @@ -1,4 +1,30 @@ +!> @file +!> @brief Contains module W3STR2MD. +!> +!> @author A. Roland @date 29-May-2012 +!> + !/ ------------------------------------------------------------------- / +!> +!> @brief This piece of code computes the triad interaction term in +!> the same way as done in the SWAN model. +!> +!> @details The approach is truncated version of the work of Elderberky. +!> In SWAN the wave spectra is treated as one-dimensional and the +!> transfer to the higher harmoics is taken into account for this +!> no justification is given and it has to be further investigated. +!> The approximation of Elderberky is for a flat bottom (actually +!> bragg-0 resonance). The biggest problem is that it is not +!> conservative, which is the biggest limitation factor. Moreover it +!> is questionable if it was taken into account the in spectral +!> wave models the freq. bandwidths are exponentially distributed in +!> freq. space, which leads to the problem that it is possible that +!> some jacobian transformation is missing the derivation of the +!> discrete form, I am now looking into this and I hope that I can +!> give some closure soon. +!> +!> @author A. Roland @date 29-May-2012 +!> MODULE W3STR2MD !/ !/ +-----------------------------------+ @@ -75,6 +101,19 @@ MODULE W3STR2MD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Slot for user-supplied triad interaction source term. +!> +!> @param[in] A +!> @param[in] CG +!> @param[in] WN +!> @param[in] DEPTH +!> @param[in] IX +!> @param[out] S +!> @param[out] D +!> +!> @author A. Roland @date 02-Feb-2014 +!> SUBROUTINE W3STR2 (A, CG, WN, DEPTH, IX, S, D) !/ !/ +-----------------------------------+ @@ -407,4 +446,4 @@ SUBROUTINE W3STR2 (A, CG, WN, DEPTH, IX, S, D) END SUBROUTINE W3STR2 !/ ------------------------------------------------------------------- / !/ - END MODULE W3STR1MD + END MODULE W3STR2MD diff --git a/model/src/w3swldmd.F90 b/model/src/w3swldmd.F90 index f4ee16b5f..dbe0c5f24 100644 --- a/model/src/w3swldmd.F90 +++ b/model/src/w3swldmd.F90 @@ -1,5 +1,20 @@ +!> @file +!> @brief Contains MODULE W3SWLMD, for swell dissipation source term. +!> +!> @author H. L. Tolman @date 21-Nov-2011 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Source term module for swell dissipation. +!> +!> @details Source term for swell dissipation based on different +!> physics that can be independently selected from the input +!> and whitecapping dissipation terms in the model setup. +!> +!> @author H. L. Tolman @date 21-Nov-2011 +!> MODULE W3SWLDMD !/ !/ +-----------------------------------+ @@ -60,6 +75,21 @@ MODULE W3SWLDMD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief FIXME +!> +!> @details A, S, D all stored as 1-D arrays with dimension NTH*NK +!> (column by column). +!> +!> @param[in] A Action density spectrum. +!> @param[in] CG Group velocities. +!> @param[in] WN Wavenumbers. +!> @param[in] DAIR Air density. +!> @param[out] S Source term. +!> @param[out] D Diagonal term of the derivative. +!> +!> @author H. L. Tolman @date 13-Aug-2021 +!> SUBROUTINE W3SWL4 (A, CG, WN, DAIR, S, D) !/ !/ +-----------------------------------+ @@ -198,6 +228,26 @@ SUBROUTINE W3SWL4 (A, CG, WN, DAIR, S, D) !/ END SUBROUTINE W3SWL4 !/ ------------------------------------------------------------------- / +!> +!> @brief Turbulent dissipation of narrow-banded swell. +!> +!> +!> @details A, S, D all stored as 1-D arrays with dimension NTH*NK +!> (column by column). +!> +!> Described in Babanin (2011, Section 7.5). +!> Babanin 2011: Cambridge Press, 295-321, 463pp. +!> +!> S = D * A +!> +!> @param[in] A Action density spectrum. +!> @param[in] CG Group velocities. +!> @param[in] WN Wavenumbers. +!> @param[out] S Source term. +!> @param[out] D Diagonal term of the derivative. +!> +!> @author H. L. Tolman @date 16-Feb-2012 +!> SUBROUTINE W3SWL6 (A, CG, WN, S, D) !/ !/ +-----------------------------------+ @@ -363,6 +413,20 @@ SUBROUTINE W3SWL6 (A, CG, WN, S, D) END SUBROUTINE W3SWL6 !/ ------------------------------------------------------------------- / !/ +!> +!> @brief Generate a linear-spaced sequence of integer numbers. +!> +!> @details Used for array addressing (indexing). +!> +!> @param X0 +!> @param X1 +!> @param DX +!> @returns IX +!> +!> @author H. L. Tolman +!> @author S. Zieger +!> @date 15-Feb-2011 +!> FUNCTION IRANGE(X0,X1,DX) RESULT(IX) !/ !/ +-----------------------------------+ diff --git a/model/src/w3uno2md.F90 b/model/src/w3uno2md.F90 index ea8f779a5..29e7756ed 100644 --- a/model/src/w3uno2md.F90 +++ b/model/src/w3uno2md.F90 @@ -1,5 +1,16 @@ +!> @file +!> @brief Contains MODULE W3UNO2MD, with UNO2 scheme. +!> +!> @author Jain-Guo Li @date 1-Jul-2013 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Portable UNO2 scheme on irregular grid. +!> +!> @author Jain-Guo Li @date 1-Jul-2013 +!> MODULE W3UNO2MD !/ !/ +-----------------------------------+ @@ -63,6 +74,31 @@ MODULE W3UNO2MD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief UNO2 scheme for irregular grid. +!> +!> @param[in] MX Field dimensions, if grid is 'closed' or circular, MX is the closed dimension. +!> @param[in] MY Field dimensions +!> @param[in] NX Part of field actually used +!> @param[in] NY Part of field actually used +!> @param[inout] VELO Local velocities (MY, MX+1). +!> @param[in] DT Time step. +!> @param[inout] DX1 Band width at points (MY, MX+1). +!> @param[inout] DX2 Band width between points (MY,0:MX+1). +!> @param[inout] Q Propagated quantity. +!> @param[in] BCLOSE Flag for closed 'X' dimension. +!> @param[in] INC Increment in 1-D array corresponding to increment in 2-D space. +!> @param[in] MAPACT List of active grid points. +!> @param[in] NACT Size of MAPACT. +!> @param[in] MAPBOU Map with boundary information (see W3MAP2). +!> @param[in] NB0 Counter in MAPBOU +!> @param[in] NB1 Counter in MAPBOU +!> @param[in] NB2 Counter in MAPBOU +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> +!> @author Jain-Guo Li @date 1-Jul-2013 +!> SUBROUTINE W3UNO2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q,BCLOSE,& INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & NDSE, NDST ) @@ -407,12 +443,32 @@ SUBROUTINE W3UNO2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q,BCLOSE,& 9020 FORMAT (' TEST W3UNO2 : IP, IXY, 2Q, 2FL') 9021 FORMAT (' ',2I6,2(1X,2E11.3)) #endif -!/ -!/ End of W3UNO2 ----------------------------------------------------- / -!/ END SUBROUTINE W3UNO2 !/ -!/ +!/ End of W3UNO2 ----------------------------------------------------- / +!> +!> @brief Preform one-dimensional propagation in a two-dimensional space +!> with irregular boundaries and regular grid. +!> +!> @param[in] MX Field dimensions, if grid is 'closed' or circular, MX is the closed dimension. +!> @param[in] MY Field dimensions +!> @param[in] NX Part of field actually used +!> @param[in] NY Part of field actually used +!> @param[inout] CFLL Local Courant numbers (MY, MX+1). +!> @param[inout] Q Propagated quantity (MY,0:MX+2). +!> @param[in] BCLOSE Flag for closed 'X' dimension. +!> @param[in] INC Increment in 1-D array corresponding to increment in 2-D space. +!> @param[in] MAPACT List of active grid points. +!> @param[in] NACT Size of MAPACT. +!> @param[in] MAPBOU Map with boundary information (see W3MAP2). +!> @param[in] NB0 Counter in MAPBOU +!> @param[in] NB1 Counter in MAPBOU +!> @param[in] NB2 Counter in MAPBOU +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> +!> @author Jain-Guo Li @date 8-Jan-2018 +!> SUBROUTINE W3UNO2r (MX, MY, NX, NY, CFLL, Q, BCLOSE, INC, & MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & NDSE, NDST ) @@ -746,11 +802,37 @@ SUBROUTINE W3UNO2r (MX, MY, NX, NY, CFLL, Q, BCLOSE, INC, & 9021 FORMAT (' ',2I6,2(1X,2E11.3)) #endif !/ + END SUBROUTINE W3UNO2r +!/ !/ End of W3UNO2r ---------------------------------------------------- / !/ - END SUBROUTINE W3UNO2r -!/ -!/ ------------------------------------------------------------------- / +!/ + +!> +!> @brief Like W3UNO2r with cell transparencies added. +!> +!> @details Adapted from W3QCK3 for UNO2 regular grid scheme with subgrid obstruction. +!> +!> @param[in] MX Field dimensions, if grid is 'closed' or circular, MX is the closed dimension. +!> @param[in] MY Field dimensions +!> @param[in] NX Part of field actually used +!> @param[in] NY Part of field actually used +!> @param[in] TRANS +!> @param[inout] CFLL Local Courant numbers (MY, MX+1). +!> @param[inout] Q Propagated quantity (MY,0:MX+2). +!> @param[in] BCLOSE Flag for closed 'X' dimension. +!> @param[in] INC Increment in 1-D array corresponding to increment in 2-D space. +!> @param[in] MAPACT List of active grid points. +!> @param[in] NACT Size of MAPACT. +!> @param[in] MAPBOU Map with boundary information (see W3MAP2). +!> @param[in] NB0 Counter in MAPBOU +!> @param[in] NB1 Counter in MAPBOU +!> @param[in] NB2 Counter in MAPBOU +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> +!> @author Jain-Guo Li @date 8-Jan-2018 +!> SUBROUTINE W3UNO2s (MX, MY, NX, NY, CFLL, TRANS, Q, BCLOSE, & INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & NDSE, NDST ) diff --git a/model/src/w3uqckmd.F90 b/model/src/w3uqckmd.F90 index fdb020b4f..4f5121d75 100644 --- a/model/src/w3uqckmd.F90 +++ b/model/src/w3uqckmd.F90 @@ -1,6 +1,16 @@ +!> @file +!> @brief Contains MODULE W3UQCKMD. +!> +!> @author H. L. Tolman @date 27-May-2014 +!> #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Portable ULTIMATE QUICKEST schemes. +!> +!> @author H. L. Tolman @date 27-May-2014 +!> MODULE W3UQCKMD !/ !/ +-----------------------------------+ @@ -71,6 +81,39 @@ MODULE W3UQCKMD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Preform one-dimensional propagation in a two-dimensional space +!> with irregular boundaries and regular grid. +!> +!> @details ULTIMATE QUICKEST scheme (see manual). +!> +!> Note that the check on monotonous behavior of QCN is performed +!> using weights CFAC, to avoid the need for IF statements. +!> +!> Called by: W3KTP2 Propagation in spectral space. +!> +!> This routine can be used independently from WAVEWATCH III. +!> +!> +!> @param[in] MX Field dimensions, if grid is 'closed' or circular, MX is the closed dimension. +!> @param[in] MY Field dimension (See MX) +!> @param[in] NX Part of field actually used +!> @param[in] NY Part of field actually used +!> @param[in] INC Increment in 1-D array corresponding to increment in 2-D space. +!> @param[in] MAPACT List of active grid points. +!> @param[in] NACT Size of MAPACT. +!> @param[in] MAPBOU Map with boundary information (See W3MAP2). +!> @param[in] NB0 Counter in MAPBOU +!> @param[in] NB1 Counter in MAPBOU +!> @param[in] NB2 Counter in MAPBOU +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> @param[inout] CFLL Local Courant numbers (MY, MX+1) +!> @param[inout] Q Propagated quantity (MY,0:MX+2) +!> @param[in] CLOSE Flag for closed 'X' dimension. +!> +!> @author H. L. Tolman @date 30-Oct-2009 +!> SUBROUTINE W3QCK1 (MX, MY, NX, NY, CFLL, Q, CLOSE, INC, & MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & NDSE, NDST ) @@ -433,6 +476,41 @@ SUBROUTINE W3QCK1 (MX, MY, NX, NY, CFLL, Q, CLOSE, INC, & !/ END SUBROUTINE W3QCK1 !/ ------------------------------------------------------------------- / +!> +!> @brief Like W3QCK1 with variable grid spacing. +!> +!> @details VELO amd Q need only bee filled in the (MY,MX) range, +!> extension is used internally for closure. +!> VELO and Q are defined as 1-D arrays internally. +!> +!> Called by: W3KTP2 Propagation in spectral space. +!> +!> This routine can be used independently from WAVEWATCH III. +!> +!> +!> @param[in] MX Field dimensions, if grid is 'closed' or circular, MX is the closed dimension. +!> @param[in] MY Field dimension (See MX). +!> @param[in] NX Part of field actually used. +!> @param[in] NY Part of field actually used. +!> @param[in] MAPACT List of active grid points. +!> @param[in] NACT Size of MAPACT. +!> @param[in] MAPBOU Map with boundary information (See W3MAP2). +!> @param[in] NB0 Counter in MAPBOU. +!> @param[in] NB1 Counter in MAPBOU. +!> @param[in] NB2 Counter in MAPBOU. +!> @param[inout] VELO Local velocities (MY, MX+1). +!> @param[in] DT Time step. +!> @param[inout] DX1 Band width at points (MY, MX+1). +!> @param[inout] DX2 Band width between points (MY,0:MX+1) +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> @param[inout] Q Propagated quantity (MY,0:MX+2). +!> @param[in] CLOSE Flag for closed 'X' dimension. +!> @param[in] INC Increment in 1-D array corresponding to +!> increment in 2-D space. +!> +!> @author H. L. Tolman @date 30-Oct-2009 +!> SUBROUTINE W3QCK2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q, CLOSE,& INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & NDSE, NDST ) @@ -806,6 +884,38 @@ SUBROUTINE W3QCK2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q, CLOSE,& !/ END SUBROUTINE W3QCK2 !/ ------------------------------------------------------------------- / +!> +!> @brief Like W3QCK1 with cell transparencies added. +!> +!> @details CFLL amd Q need only bee filled in the (MY,MX) range, +!> extension is used internally for closure. +!> CFLL and Q are defined as 1-D arrays internally. +!> +!> Called by: W3XYP2 Propagation in physical space. +!> +!> This routine can be used independently from WAVEWATCH III. +!> +!> +!> @param[in] MX Field dimensions, if grid is 'closed' or circular, MX is the closed dimension. +!> @param[in] MY Field dimension (See MX) +!> @param[in] NX Part of field actually used +!> @param[in] NY Part of field actually used +!> @param[inout] CFLL Local Courant numbers (MY, MX+1). +!> @param[in] TRANS +!> @param[in] INC Increment in 1-D array corresponding to increment in 2-D space. +!> @param[in] MAPACT List of active grid points. +!> @param[in] NACT Size of MAPACT. +!> @param[in] MAPBOU Map with boundary information (See W3MAP2). +!> @param[in] NB0 Counter in MAPBOU +!> @param[in] NB1 Counter in MAPBOU +!> @param[in] NB2 Counter in MAPBOU +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> @param[inout] Q Propagated quantity (MY,0:MX+2) +!> @param[in] CLOSE Flag for closed 'X' dimension. +!> +!> @author H. L. Tolman @date 30-Oct-2009 +!> SUBROUTINE W3QCK3 (MX, MY, NX, NY, CFLL, TRANS, Q, CLOSE, & INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, & NDSE, NDST ) diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 29659b39a..53e2eccf7 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1,5 +1,15 @@ +!> @file +!> @brief Contains MODULE W3WAVEMD. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Contains wave model subroutine, w3wave. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> MODULE W3WAVEMD !/ !/ +-----------------------------------+ @@ -181,6 +191,32 @@ MODULE W3WAVEMD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Run WAVEWATCH III for a given time interval. +!> +!> @details Currents are updated before winds as currents are used in wind +!> and USTAR processing. +!> +!> Ice and water levels can be updated only once per call. +!> +!> If ice or water level time are undefined, the update +!> takes place asap, otherwise around the "half-way point" +!> between the old and new times. +!> +!> To increase accuracy, the calculation of the intra-spectral +!> propagation is performed in two parts around the spatial propagation. +!> +!> @param[in] IMOD Model number. +!> @param[in] TEND Ending time of integration. +!> @param[in] STAMP Write time stamp (optional, defaults to T). +!> @param[in] NO_OUT Skip output (optional, defaults to F). +!> @param[in] ODAT +!> @param[in] ID_LCOMM Present only when using W3_OASIS. +!> @param[in] TIMEN Present only when using W3_OASIS. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> + SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_OASIS ,ID_LCOMM, TIMEN & @@ -3641,6 +3677,31 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !/ END SUBROUTINE W3WAVE !/ ------------------------------------------------------------------- / +!> +!> @brief Gather spectral bin information into a propagation field array. +!> +!> @details Direct copy or communication calls (MPP version). +!> The field is extracted but not converted. +!> +!> MPI version requires posing of send and receive calls in +!> W3WAVE to match local calls. +!> +!> MPI version does not require an MPI_TESTALL call for the +!> posted gather operation as MPI_WAITALL is mandatory to +!> reset persistent communication for next time step. +!> +!> MPI version allows only two new pre-fetch postings per +!> call to minimize chances to be slowed down by gathers that +!> are not yet needed, while maximizing the pre-loading +!> during the early (low-frequency) calls to the routine +!> where the amount of calculation needed for proagation is +!> the largest. +!> +!> @param[in] ISPEC Spectral bin considered. +!> @param[out] FIELD Full field to be propagated. +!> +!> @author H. L. Tolman @date 26-Dec-2012 +!> SUBROUTINE W3GATH ( ISPEC, FIELD ) !/ !/ +-----------------------------------+ @@ -3951,6 +4012,20 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) !/ END SUBROUTINE W3GATH !/ ------------------------------------------------------------------- / +!> +!> @brief Scatter data back to spectral storage after propagation. +!> +!> @details Direct copy or communication calls (MPP version). See also W3GATH. +!> The field is put back but not converted! +!> MPI persistent communication calls initialize in W3MPII. +!> See W3GATH and W3MPII for additional comments on data buffering. +!> +!> @param[inout] ISPEC Spectral bin considered. +!> @param[inout] MAPSTA Status map for spatial grid. +!> @param[inout] FIELD Full field to be propagated. +!> +!> @author H. L. Tolman @date 13-Jun-2006 +!> SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) !/ !/ +-----------------------------------+ @@ -4259,6 +4334,15 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) !/ END SUBROUTINE W3SCAT !/ ------------------------------------------------------------------- / +!> +!> @brief Check minimum number of active sea points at given processor to +!> evaluate the need for a MPI_BARRIER call. +!> +!> @param[in] MAPSTA Status map for spatial grid. +!> @param[out] FLAG0 Flag to identify 0 as minimum. +!> +!> @author H. L. Tolman @date 28-Dec-2004 +!> SUBROUTINE W3NMIN ( MAPSTA, FLAG0 ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3wavset.F90 b/model/src/w3wavset.F90 index a1a87a568..e3e04c6d0 100644 --- a/model/src/w3wavset.F90 +++ b/model/src/w3wavset.F90 @@ -1,3 +1,20 @@ +!> @file +!> @brief Contains MODULE W3WAVSET for implicit solution of wave +!> setup problem. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-Jun-2018 +!> +! ---------------------------------------------------------------- +!> +!> @brief Implicit solution of wave setup problem following +!> Dingemans for structured and unstructured grids. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-Jun-2018 +!> MODULE W3WAVSET !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -81,6 +98,17 @@ MODULE W3WAVSET LOGICAL :: DO_WAVE_SETUP = .TRUE. CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Differentiate xy, using linear shape function. +!> +!> @param[in] VAR +!> @param[out] DVDX +!> @param[out] DVDY +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> SUBROUTINE DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) !/ !/ +-----------------------------------+ @@ -190,6 +218,17 @@ SUBROUTINE DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) CALL PDLIB_exchange1Dreal(DVDY) END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Differentiate xy based on mapsta, using linear shape function. +!> +!> @param[in] VAR +!> @param[out] DVDX +!> @param[out] DVDY +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> SUBROUTINE DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) !/ !/ +-----------------------------------+ @@ -319,6 +358,17 @@ SUBROUTINE DIFFERENTIATE_XYDIR_MAPSTA(VAR, DVDX, DVDY) CALL PDLIB_exchange1Dreal(DVDY) END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Driver routine for xydir. +!> +!> @param[in] VAR +!> @param[out] DVDX +!> @param[out] DVDY +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE DIFFERENTIATE_XYDIR(VAR, DVDX, DVDY) !/ !/ +-----------------------------------+ @@ -393,6 +443,17 @@ SUBROUTINE DIFFERENTIATE_XYDIR(VAR, DVDX, DVDY) ! CALL DIFFERENTIATE_XYDIR_NATIVE(VAR, DVDX, DVDY) END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Setup boundary pointer. +!> +!> @param[out] F_X +!> @param[out] F_Y +!> @param[out] DWNX +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> SUBROUTINE TRIG_COMPUTE_LH_STRESS(F_X, F_Y, DWNX) !/ !/ +-----------------------------------+ @@ -535,6 +596,18 @@ SUBROUTINE TRIG_COMPUTE_LH_STRESS(F_X, F_Y, DWNX) #endif END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Differentiate other way around. +!> +!> @param[in] IE +!> @param[in] I1 +!> @param[inout] UGRAD +!> @param[inout] VGRAD +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_COMPUTE_DIFF(IE, I1, UGRAD, VGRAD) !/ !/ +-----------------------------------+ @@ -625,6 +698,21 @@ SUBROUTINE TRIG_COMPUTE_DIFF(IE, I1, UGRAD, VGRAD) VGRAD= (x(IP3) - x(IP2))/h END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Setup system matrix for solutions of wave setup eq. +!> +!> @param[in] FX +!> @param[in] FY +!> @param[in] DWNX +!> @param[out] ASPAR +!> @param[out] B +!> @param[in] ACTIVE +!> @param[out] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY, DWNX, ACTIVE, ACTIVESEC) !/ !/ +-----------------------------------+ @@ -790,6 +878,19 @@ SUBROUTINE TRIG_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY, DWNX, ACTIVE, ACTIVE END IF END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Preconditioner. +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> @param[in] ACTIVE +!> @param[in] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) !/ !/ +-----------------------------------+ @@ -911,6 +1012,19 @@ SUBROUTINE TRIG_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC CALL PDLIB_exchange1Dreal(TheOut) END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> @param[in] ACTIVE +!> @param[in] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) !/ !/ +-----------------------------------+ @@ -1001,6 +1115,17 @@ SUBROUTINE TRIG_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut, ACTIVE, ACTIVESEC) CALL PDLIB_exchange1Dreal(TheOut) END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Scalar product plus exchange. +!> +!> @param[in] V1 +!> @param[in] V2 +!> @param[inout] eScal +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) !/ !/ +-----------------------------------+ @@ -1101,6 +1226,19 @@ SUBROUTINE TRIG_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) eScal=lScal(1) END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Poisson equation solver. +!> +!> @param[in] ASPAR +!> @param[in] B +!> @param[out] TheOut +!> @param[in] ACTIVE +!> @param[in] ACTIVESEC +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut, ACTIVE, ACTIVESEC) !/ !/ +-----------------------------------+ @@ -1268,6 +1406,15 @@ SUBROUTINE TRIG_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut, ACTIVE, A TheOut=V_X END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Set mean value. +!> +!> @param[inout] TheVar +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_SET_MEANVALUE_TO_ZERO(TheVar) !/ !/ +-----------------------------------+ @@ -1383,6 +1530,16 @@ SUBROUTINE TRIG_SET_MEANVALUE_TO_ZERO(TheVar) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Compute active node for setup comp. +!> +!> @param[in] DWNX +!> @param[out] ACTIVE +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> SUBROUTINE COMPUTE_ACTIVE_NODE(DWNX, ACTIVE) !/ !/ +-----------------------------------+ @@ -1479,6 +1636,13 @@ SUBROUTINE COMPUTE_ACTIVE_NODE(DWNX, ACTIVE) #endif END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Setup computation. +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE TRIG_WAVE_SETUP_COMPUTATION !/ !/ +-----------------------------------+ @@ -1630,6 +1794,15 @@ SUBROUTINE TRIG_WAVE_SETUP_COMPUTATION #endif END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Wave setup for FD grids. +!> +!> @param[in] IMOD +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE PREPARATION_FD_SCHEME(IMOD) !/ !/ +-----------------------------------+ @@ -1788,6 +1961,17 @@ SUBROUTINE PREPARATION_FD_SCHEME(IMOD) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Compute off diagonal for FD grids. +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut) !/ !/ +-----------------------------------+ @@ -1872,6 +2056,17 @@ SUBROUTINE FD_WAVE_SETUP_APPLY_FCT(ASPAR, TheIn, TheOut) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Preconditioning for FD grids. +!> +!> @param[in] ASPAR +!> @param[in] TheIn +!> @param[out] TheOut +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut) !/ !/ +-----------------------------------+ @@ -1975,6 +2170,17 @@ SUBROUTINE FD_WAVE_SETUP_APPLY_PRECOND(ASPAR, TheIn, TheOut) END IF END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Radiation stresses for FD grids. +!> +!> @param[out] SXX_t +!> @param[out] SXY_t +!> @param[out] SYY_t +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_COLLECT_SXX_XY_YY(SXX_t, SXY_t, SYY_t) !/ !/ +-----------------------------------+ @@ -2092,6 +2298,19 @@ SUBROUTINE FD_COLLECT_SXX_XY_YY(SXX_t, SXY_t, SYY_t) END IF END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Setup fluxes. +!> +!> @param[in] SXX_t +!> @param[in] SXY_t +!> @param[in] SYY_t +!> @param[out] FX +!> @param[out] FY +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_COMPUTE_LH_STRESS(SXX_t, SXY_t, SYY_t, FX, FY) !/ !/ +-----------------------------------+ @@ -2232,6 +2451,19 @@ SUBROUTINE FD_COMPUTE_LH_STRESS(SXX_t, SXY_t, SYY_t, FX, FY) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Differences on FD grids. +!> +!> @param[in] IEDGE +!> @param[in] ISEA +!> @param[inout] UGRAD +!> @param[inout] VGRAD +!> @param[inout] dist +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_COMPUTE_DIFF(IEDGE, ISEA, UGRAD, VGRAD, dist) !/ !/ +-----------------------------------+ @@ -2327,6 +2559,18 @@ SUBROUTINE FD_COMPUTE_DIFF(IEDGE, ISEA, UGRAD, VGRAD, dist) END IF END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Setup matrix on FD grids. +!> +!> @param[out] ASPAR +!> @param[out] B +!> @param[in] FX +!> @param[in] FY +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY) !/ !/ +-----------------------------------+ @@ -2433,6 +2677,17 @@ SUBROUTINE FD_WAVE_SETUP_COMPUTE_SYSTEM(ASPAR, B, FX, FY) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Scalar product. +!> +!> @param[in] V1 +!> @param[in] V2 +!> @param[inout] eScal +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) !/ !/ +-----------------------------------+ @@ -2510,6 +2765,17 @@ SUBROUTINE FD_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Poisson solver on FD grids. +!> +!> @param[in] ASPAR +!> @param[in] B +!> @param[out] TheOut +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut) !/ !/ +-----------------------------------+ @@ -2623,6 +2889,15 @@ SUBROUTINE FD_WAVE_SETUP_SOLVE_POISSON_NEUMANN_DIR(ASPAR, B, TheOut) TheOut=V_X END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Set mean value. +!> +!> @param[inout] TheVar +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_SET_MEANVALUE_TO_ZERO(TheVar) !/ !/ +-----------------------------------+ @@ -2706,6 +2981,15 @@ SUBROUTINE FD_SET_MEANVALUE_TO_ZERO(TheVar) END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief Wave setup comp on FD grids. +!> +!> @param[inout] TheVar +!> +!> @author Mathieu Dutour-Sikiric +!> @author Aron Roland +!> @date 1-May-2018 +!> SUBROUTINE FD_WAVE_SETUP_COMPUTATION !/ !/ +-----------------------------------+ @@ -2806,6 +3090,13 @@ SUBROUTINE FD_WAVE_SETUP_COMPUTATION END DO END SUBROUTINE !/ ------------------------------------------------------------------- / +!> +!> @brief General driver. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 1-May-2018 +!> SUBROUTINE WAVE_SETUP_COMPUTATION !/ !/ +-----------------------------------+ diff --git a/model/src/w3wdasmd.F90 b/model/src/w3wdasmd.F90 index b2094d285..78762f014 100644 --- a/model/src/w3wdasmd.F90 +++ b/model/src/w3wdasmd.F90 @@ -1,5 +1,39 @@ +!> @file +!> @brief Contains module W3WDASMD. +!> +!> @author H. L. Tolman @date 06-Dec-2010 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Intended as the interface for externally supplied +!> data assimilation software. +!> +!> @details This module is intended as the interface for externally +!> supplied data assimilation software to be used with WAVEWATCH III. +!> The main subroutine W3WDAS is incorporated in the generic WAVEWATCH +!> III shell ww3_shel, and thus provides integrated time management +!> and running of the wave model and data assimilation side by side. +!> +!> Present wave conditions (including dynamically changing wave +!> grids), as well as wave data are passed to the routine through +!> the dynamic data structrure, as introduced in model version 3.06. +!> +!> A three tier data structure is used with three separate data +!> sets. Tentatively, they are intended for mean wave parameters, +!> 1-D and 2-D spectral data. This separation is made only for +!> economy in file and memory usage. All three data sets are defined +!> here only by a record length and a number of records. All data are +!> treated as real numbers, but the meaning of all record components +!> is completely at the discretion of the author of the data +!> assimilation scheme. +!> +!> To promote portability, it is suggested to use this module only +!> as an interface to your own assimilation routine(s). +!> +!> @author H. L. Tolman @date 06-Dec-2010 +!> MODULE W3WDASMD !/ !/ +-----------------------------------+ @@ -83,6 +117,18 @@ MODULE W3WDASMD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief WAVEWATCH III data assimilation interface routine. +!> +!> @param[in] DASFLAG FLags for three data sets. +!> @param[in] RECL Record lengths for three data sets. +!> @param[in] NDAT Number of data for three data sets. +!> @param[in] DATA0 Observations. +!> @param[in] DATA1 Observations. +!> @param[in] DATA2 Observations. +!> +!> @author H. L. Tolman @date 06-Dec-2010 +!> SUBROUTINE W3WDAS ( DASFLAG, RECL, NDAT, DATA0, DATA1, DATA2 ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3wdatmd.F90 b/model/src/w3wdatmd.F90 index 12b2467d1..05432b618 100644 --- a/model/src/w3wdatmd.F90 +++ b/model/src/w3wdatmd.F90 @@ -1,5 +1,20 @@ +!> @file +!> @brief Contains module W3WDATMD. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Define data structures to set up wave model dynamic data for +!> several models simultaneously. +!> +!> @details The number of grids is taken from W3GDATMD, and needs to be +!> set first with W3DIMG. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> MODULE W3WDATMD !/ !/ +-----------------------------------+ @@ -183,6 +198,16 @@ MODULE W3WDATMD !/ CONTAINS !/ ------------------------------------------------------------------- / +!> +!> @brief Set up the number of grids to be used. +!> +!> @details Use data stored in NGRIDS in W3GDATMD. +!> +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> +!> @author H. L. Tolman @date 10-Dec-2014 +!> SUBROUTINE W3NDAT ( NDSE, NDST ) !/ !/ +-----------------------------------+ @@ -303,6 +328,19 @@ SUBROUTINE W3NDAT ( NDSE, NDST ) !/ END SUBROUTINE W3NDAT !/ ------------------------------------------------------------------- / +!> +!> @brief Initialize an individual data grid at the proper dimensions. +!> +!> @details Allocate directly into the structure array. Note that +!> this cannot be done through the pointer alias! +!> +!> @param[in] IMOD Model number to point to. +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> @param[in] F_ONLY FLag for initializing field arrays only. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) !/ !/ +-----------------------------------+ @@ -715,6 +753,18 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) !/ END SUBROUTINE W3DIMW !/ ------------------------------------------------------------------- / +!> +!> @brief Select one of the WAVEWATCH III grids / models. +!> +!> @details Point pointers to the proper variables in the proper element of +!> the GRIDS array. +!> +!> @param[in] IMOD Model number to point to. +!> @param[in] NDSE Error output unit number. +!> @param[in] NDST Test output unit number. +!> +!> @author H. L. Tolman @date 22-Mar-2021 +!> SUBROUTINE W3SETW ( IMOD, NDSE, NDST ) !/ !/ +-----------------------------------+