#include "w3macros.h" !/ ------------------------------------------------------------------- / MODULE W3SWLDMD !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ +-----------------------------------+ !/ !/ 21-Nov-2011 : Origination. ( version 4.07 ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights !/ reserved. WAVEWATCH III is a trademark of the NWS. !/ No unauthorized use without permission. !/ ! 1. Purpose : ! ! Source term module for swell dissipation based on different ! physics that can be independently selected form the input ! and whitecapping dissipation terms in the model setup. ! ! 2. Variables and types : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : ! ! Name Type Scope Description ! ---------------------------------------------------------------- ! W3SWL4 Subr. Public Ardhuin et al (2010+) swell dissipation ! W3SWL6 Subr. Public Babanin (2011) swell dissipation ! ! IRANGE Func. Private Generate a sequence of integer values ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Remarks : ! ! ! 6. Switches : ! ! !/S Enable subroutine tracing. ! ! 7. Source code : !/ !/ ------------------------------------------------------------------- / !/ PUBLIC :: W3SWL4, W3SWL6 PRIVATE :: IRANGE !/ CONTAINS !/ ------------------------------------------------------------------- / SUBROUTINE W3SWL4 (A, CG, WN, S, D) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 23-Feb-2012 | !/ +-----------------------------------+ !/ !/ 29-May-2009 : Origination (w3srcxmd.ftn) ( version 3.14 ) !/ 06-Jan-2012 : Implementation (S. Zieger) !/ ! 1. Purpose : ! ! FIXME ! ! 2. Method : ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! A¹ R.A. I Action density spectrum ! CG R.A. I Group velocities ! WN R.A. I Wavenumbers ! S¹ R.A. O Source term ! D¹ R.A. O Diagonal term of derivative ! ¹ Stored as 1-D array with dimension NTH*NK (column by column). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! IRANGE Func. W3SWLDMD ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SRCE Subr. W3SRCEMD Source term integration. ! W3EXPO Subr. N/A Point output post-processor. ! GXEXPO Subr. N/A GrADS point output post-processor. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! None. ! ! 7. Remarks : ! ! 8. Structure : ! ! See comments in source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: GRAV, DAIR, DWAT USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG2, DDEN, FTE, SWL6B1 !/S USE W3SERVMD, ONLY: STRACE !/ IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list REAL, INTENT(IN) :: A(NSPEC), CG(NK), WN(NK) REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/S INTEGER, SAVE :: IENT = 0 INTEGER :: IKN(NK), ITH REAL, PARAMETER :: VA = 1.4E-5 ! Air kinematic viscosity (used in WAM). REAL :: EB(NK), WN2(NSPEC), EMEAN REAL :: FE, AORB, RE, RECRIT, UOSIG, CDSV !/ !/ ------------------------------------------------------------------- / !/ !/S CALL STRACE (IENT, 'W3SWL4') ! IKN = IRANGE(1,NSPEC,NTH) D = 0. WN2 = 0. ! DO ITH = 1, NTH WN2(IKN+(ITH-1)) = WN ! Wavenumbers to all directions. END DO ! EB = SUM(RESHAPE(A,(/ NTH,NK /)),1) * DDEN(1:NK) / CG EMEAN = SUM(EB) + (EB(NK) / DDEN(NK)) * FTE ! AORB = 2.0*SQRT(EMEAN) ! EB = SUM(RESHAPE(A*SIG2**2,(/ NTH,NK /)),1) * DDEN(1:NK) / CG UOSIG = 2.0*SQRT(SUM(EB)) FE = SWL6B1 ! (from NAMELIST) ! FE = 0.001 ! (from NAMELIST) !/ 0.001 - 0.019 with median value 0.007 (Ardhuin et al 2009, Babanin 2011) CDSV = 1.2 ! RECRIT = 1.0E5 RE = 4.0 * UOSIG * AORB / VA ! IF (RE .GT. RECRIT) THEN D = -(16.0/GRAV) * (DAIR/DWAT) * FE * (SIG2**2) *UOSIG ELSE D = -2.0 * (DAIR/DWAT) * CDSV * WN2 * SQRT(2.0 * VA * SIG2) END IF ! S = D * A ! ! WRITE(*,*) ' FE =',FE ! WRITE(*,*) ' HS =',4.*SQRT(EMEAN) ! WRITE(*,*) ' UOSIG =',UOSIG ! WRITE(*,*) ' AORB =',AORB ! WRITE(*,*) ' RE/RECRIT=',RE/RECRIT ! WRITE(*,*) ' SWL4_tot =',SUM(SUM(RESHAPE(S,(/ NTH,NK /)),1)*DDEN/CG) !/ !/ End of W3SWL4 ----------------------------------------------------- / !/ END SUBROUTINE W3SWL4 !/ ------------------------------------------------------------------- / SUBROUTINE W3SWL6 (A, CG, WN, S, D) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | !/ | Last update : 16-Feb-2012 | !/ +-----------------------------------+ !/ !/ 29-May-2009 : Origination (w3srcxmd.ftn) ( version 3.14 ) !/ 16-Feb-2012 : Implementation ( version 4.07 ) !/ (S. Zieger) !/ ! 1. Purpose : ! ! Turbulent dissipation of narrow-banded swell as described in ! Babanin (2011, Section 7.5). ! ! Babanin 2011: Cambridge Press, 295-321, 463pp. ! ! 2. Method : ! ! S = D * A ! ! 3. Parameters : ! ! Parameter list ! ---------------------------------------------------------------- ! A¹ R.A. I Action density spectrum ! CG R.A. I Group velocities ! WN R.A. I Wavenumbers ! S¹ R.A. O Source term ! D¹ R.A. O Diagonal term of derivative ! ¹ Stored as 1-D array with dimension NTH*NK (column by column). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! IRANGE Func. W3SWLDMD ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! ! 5. Called by : ! ! Name Type Module Description ! ---------------------------------------------------------------- ! W3SRCE Subr. W3SRCEMD Source term integration. ! W3EXPO Subr. N/A Point output post-processor. ! GXEXPO Subr. N/A GrADS point output post-processor. ! ---------------------------------------------------------------- ! ! 6. Error messages : ! ! None. ! ! 7. Remarks : ! ! 8. Structure : ! ! See comments in source code. ! ! 9. Switches : ! ! !/S Enable subroutine tracing. ! ! 10. Source code : ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: GRAV USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DDEN, DTH USE W3GDATMD, ONLY: SWL6CSTB1, SWL6B1, FTE, FTWN !/T6 USE W3ODATMD, ONLY: NDST !/S USE W3SERVMD, ONLY: STRACE !/ IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list REAL, INTENT(IN) :: A(NSPEC), CG(NK), WN(NK) REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC) !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/S INTEGER, SAVE :: IENT = 0 INTEGER :: IK, ITH, IKN(NK) REAL, DIMENSION(NK) :: ABAND, KMAX, ANAR, BN, AORB, DDIS REAL :: K(NTH,NK), B1 !/ !/ ------------------------------------------------------------------- / !/ !/S CALL STRACE (IENT, 'W3SWL6') ! !/ 0) --- Initialize parameters -------------------------------------- / IKN = IRANGE(1,NSPEC,NTH) ! Index vector for array access, e.g. ! ! in form of WN(1:NK) == WN2(IKN). ABAND = SUM(RESHAPE(A,(/ NTH,NK /)),1) ! action density as function of wavenumber DDIS = 0. D = 0. B1 = SWL6B1 ! empirical constant from NAMELIST ! !/ 1) --- Choose calculation of steepness a*k ------------------------ / !/ Replace the measure of steepness with the spectral ! saturation after Banner et al. (2002) ---------------------- / K = RESHAPE(A,(/ NTH,NK /)) KMAX = MAXVAL(K,1) DO IK = 1,NK IF (KMAX(IK).LT.1.0E-34) THEN K(1:NTH,IK) = 1. ELSE K(1:NTH,IK) = K(1:NTH,IK)/KMAX(IK) END IF END DO ANAR = 1.0/( SUM(K,1) * DTH ) BN = ANAR * ( ABAND * SIG(1:NK) * DTH ) * WN**3 ! IF (.NOT.SWL6CSTB1) THEN ! !/ --- A constant value for B1 attenuates swell too strong in the !/ western central Pacific (i.e. cross swell less than 1.0m). !/ Workaround is to scale B1 with steepness a*kp, where kp is !/ the peak wavenumber. SWL6B1 remains a scaling constant, but !/ with different magnitude. --------------------------------- / IK = MAXLOC(ABAND,1) ! Index for peak ! EMEAN = SUM(ABAND * DDEN / CG) ! Total sea surface variance B1 = SWL6B1 * ( 2. * SQRT(SUM(ABAND*DDEN/CG)) * WN(IK) ) ! END IF ! !/ 2) --- Calculate the derivative term only (in units of 1/s) ------- / DO IK = 1,NK IF (ABAND(IK) .GT. 1.E-30) THEN DDIS(IK) = -(2./3.) * B1 * SIG(IK) * SQRT(BN(IK)) END IF END DO ! !/ 3) --- Apply dissipation term of derivative to all directions ----- / DO ITH = 1, NTH D(IKN+(ITH-1)) = DDIS END DO ! S = D * A ! ! WRITE(*,*) ' B1 =',B1 ! WRITE(*,*) ' DDIS_tot =',SUM(DDIS*ABAND*DDEN/CG) ! WRITE(*,*) ' EDENS_tot=',sum(aband*dden/cg) ! WRITE(*,*) ' EDENS_tot=',sum(aband*sig*dth*dsii/cg) ! WRITE(*,*) ' ' ! WRITE(*,*) ' SWL6_tot =',sum(SUM(RESHAPE(S,(/ NTH,NK /)),1)*DDEN/CG) ! !/ !/ End of W3SWL6 ----------------------------------------------------- / !/ END SUBROUTINE W3SWL6 !/ ------------------------------------------------------------------- / !/ FUNCTION IRANGE(X0,X1,DX) RESULT(IX) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | S. Zieger | !/ | FORTRAN 90 | !/ | Last update : 15-Feb-2011 | !/ +-----------------------------------+ !/ !/ 15-Feb-2011 : Origination from W3SRC6MD ( version 4.07 ) !/ (S. Zieger) !/ ! 1. Purpose : ! Generate a linear-spaced sequence of integer ! numbers. Used for array addressing (indexing). ! !/ IMPLICIT NONE INTEGER, INTENT(IN) :: X0, X1, DX INTEGER, ALLOCATABLE :: IX(:) INTEGER :: N INTEGER :: I ! N = INT(REAL(X1-X0)/REAL(DX))+1 ALLOCATE(IX(N)) DO I = 1, N IX(I) = X0+ (I-1)*DX END DO !/ END FUNCTION IRANGE !/ ------------------------------------------------------------------- / !/ END MODULE W3SWLDMD