From 124d93ae793257886dcd7a08864c45fce32a95a7 Mon Sep 17 00:00:00 2001 From: "ukmo-chris.bunney" Date: Tue, 16 May 2023 14:49:20 +0100 Subject: [PATCH 1/4] Cleaned up pre-processor directives in w3srcemd. Some code moved around to group together more logically. --- model/src/w3srcemd.F90 | 423 ++++++++++++++++++----------------------- 1 file changed, 181 insertions(+), 242 deletions(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 12ff81291..3559b884c 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -681,283 +681,252 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IK, ITH, IS, IS0, NSTEPS, NKH, NKH1,& + INTEGER :: IK, ITH, IS, IS0, NSTEPS, NKH, NKH1, & IKS1, IS1, NSPECH, IDT, IERR, NKD, ISP - INTEGER :: IOBPIP, IOBPDIP, IOBDPIP -#ifdef W3_S - INTEGER, SAVE :: IENT = 0 -#endif -#ifdef W3_NNT - INTEGER, SAVE :: NDSD = 89, NDSD2 = 88, J -#endif -#ifdef W3_NL5 - INTEGER :: QI5TSTART(2) - REAL :: QR5KURT - INTEGER, PARAMETER :: NL5_SELECT = 1 - REAL, PARAMETER :: NL5_OFFSET = 0. ! explicit dyn. -#endif - REAL :: DTTOT, FHIGH, DT, AFILT, DAMAX, AFAC,& + INTEGER :: IOBPIP, IOBPDIP, IOBDPIP + REAL :: DTTOT, FHIGH, DT, AFILT, DAMAX, AFAC,& HDT, ZWND, FP, DEPTH, TAUSCX, TAUSCY, FHIGI ! Scaling factor for SIN, SDS, SNL - REAL :: ICESCALELN, ICESCALEIN, ICESCALENL, ICESCALEDS - REAL :: EMEAN, FMEAN, AMAX, CD, Z0, SCAT, & + REAL :: ICESCALELN, ICESCALEIN, ICESCALENL, ICESCALEDS + REAL :: EMEAN, FMEAN, AMAX, CD, Z0, SCAT, & SMOOTH_ICEDISP - REAL :: WN_R(NK), CG_ICE(NK),ALPHA_LIU(NK), ICECOEF2,& - R(NK) - DOUBLE PRECISION :: ATT, ISO -#ifdef W3_ST1 - REAL :: FH1, FH2 -#endif -#ifdef W3_ST2 - REAL :: FHTRAN, DFH, FACDIA, FACPAR -#endif -#ifdef W3_ST3 - REAL :: FMEANS, FH1, FH2 -#endif -#ifdef W3_ST4 - REAL :: FMEANS, FH1, FH2, FAGE, DLWMEAN -#endif - REAL :: QCERR = 0. !/XNL2 and !/NNT -#ifdef W3_SEED - REAL :: UC, SLEV -#endif -#ifdef W3_MLIM - REAL :: HM, EM -#endif -#ifdef W3_NNT - REAL :: FACNN -#endif -#ifdef W3_T - REAL :: DTRAW -#endif - REAL :: EBAND, DIFF, EFINISH, HSTOT, PHINL, & + REAL :: WN_R(NK), CG_ICE(NK),ALPHA_LIU(NK), ICECOEF2, R(NK) + DOUBLE PRECISION :: ATT, ISO + REAL :: EBAND, DIFF, EFINISH, HSTOT, PHINL, & FMEAN1, FMEANWS, MWXINIT, MWYINIT, & FACTOR, FACTOR2, DRAT, TAUWAX, TAUWAY, & MWXFINISH, MWYFINISH, A1BAND, B1BAND, & COSI(2) - REAL :: SPECINIT(NSPEC), SPEC2(NSPEC), FRLOCAL, JAC2 - REAL :: DAM (NSPEC), DAM2(NSPEC), WN2 (NSPEC), & + REAL :: SPECINIT(NSPEC), SPEC2(NSPEC), FRLOCAL, JAC2 + REAL :: DAM (NSPEC), DAM2(NSPEC), WN2(NSPEC), & VSLN(NSPEC), & VSIN(NSPEC), VDIN(NSPEC), & VSNL(NSPEC), VDNL(NSPEC), & VSDS(NSPEC), VDDS(NSPEC), & -#ifdef W3_ST6 - VSWL(NSPEC), VDWL(NSPEC), & + VSBT(NSPEC), VDBT(NSPEC) + REAL :: VS(NSPEC), VD(NSPEC), EB(NK) + + LOGICAL :: SHAVE + LOGICAL :: LBREAK + LOGICAL, SAVE :: FIRST = .TRUE. + LOGICAL :: PrintDeltaSmDA + REAL :: eInc1, eInc2, eVS, eVD, JAC + REAL :: DeltaSRC(NSPEC) + REAL, PARAMETER :: DTMINTOT = 0.01 + + REAL :: FOUT(NK,NTH), SOUT(NK,NTH), DOUT(NK,NTH) + REAL, SAVE :: TAUNUX, TAUNUY + LOGICAL, SAVE :: FLTEST = .FALSE., FLAGNN = .TRUE. + +#ifdef W3_OMPG + !$omp threadprivate( TAUNUX, TAUNUY) + !$omp threadprivate( FLTEST, FLAGNN ) + !$omp threadprivate( FIRST ) #endif - VSBT(NSPEC), VDBT(NSPEC), & -#ifdef W3_IC1 - VSIC(NSPEC), VDIC(NSPEC), & + + !/ + !/ ------------------------------------------------------------------- / + !/ Local parameters dependent on compile switch + !/ +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 #endif -#ifdef W3_IC2 - VSIC(NSPEC), VDIC(NSPEC), & + +#ifdef W3_NNT + INTEGER, SAVE :: NDSD = 89, NDSD2 = 88, J + REAL :: QCERR = 0. !/XNL2 and !/NNT #endif -#ifdef W3_IC3 - VSIC(NSPEC), VDIC(NSPEC), & + +#ifdef W3_NL5 + INTEGER :: QI5TSTART(2) + REAL :: QR5KURT + INTEGER, PARAMETER :: NL5_SELECT = 1 + REAL, PARAMETER :: NL5_OFFSET = 0. ! explicit dyn. #endif -#ifdef W3_IC4 - VSIC(NSPEC), VDIC(NSPEC), & + +#ifdef W3_SEED + REAL :: UC, SLEV #endif -#ifdef W3_IC5 - VSIC(NSPEC), VDIC(NSPEC), & + +#ifdef W3_MLIM + REAL :: HM, EM +#endif + +#ifdef W3_NNT + REAL :: FACNN +#endif + +#ifdef W3_T + REAL :: DTRAW #endif + +#if defined(W3_IC1) || W3_IC2 || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + REAL :: VSIC(NSPEC), VDIC(NSPEC) +#endif + #ifdef W3_DB1 - VSDB(NSPEC), VDDB(NSPEC), & + REAL :: VSDB(NSPEC), VDDB(NSPEC) #endif + #ifdef W3_TR1 - VSTR(NSPEC), VDTR(NSPEC), & + REAL :: VSTR(NSPEC), VDTR(NSPEC) #endif + #ifdef W3_BS1 - VSBS(NSPEC), VDBS(NSPEC), & + REAL :: VSBS(NSPEC), VDBS(NSPEC) #endif + #ifdef W3_REF1 - VREF(NSPEC), & + REAL :: VREF(NSPEC) #endif -#ifdef W3_IS1 - VSIR(NSPEC), VDIR(NSPEC), & + +#if defined(W3_IS1) || defined(W3_IS2) + REAL :: VSIR(NSPEC), VDIR(NSPEC) #endif + #ifdef W3_IS2 - VSIR(NSPEC), VDIR(NSPEC),VDIR2(NSPEC), & + REAL :: VDIR2(NSPEC) + DOUBLE PRECISION :: SCATSPEC(NTH) #endif + #ifdef W3_UOST - VSUO(NSPEC), VDUO(NSPEC), & + REAL :: VSUO(NSPEC), VDUO(NSPEC) #endif - VS(NSPEC), VD(NSPEC), EB(NK) -#ifdef W3_ST3 - LOGICAL :: LLWS(NSPEC) + +#ifdef W3_ST1 + REAL :: FH1, FH2 #endif -#ifdef W3_ST4 - LOGICAL :: LLWS(NSPEC) - REAL :: BRLAMBDA(NSPEC) + +#ifdef W3_ST2 + REAL :: FHTRAN, DFH, FACDIA, FACPAR #endif -#ifdef W3_IS2 - DOUBLE PRECISION :: SCATSPEC(NTH) + +#ifdef W3_ST3 + REAL :: FMEANS, FH1, FH2 #endif - REAL :: FOUT(NK,NTH), SOUT(NK,NTH), DOUT(NK,NTH) - REAL, SAVE :: TAUNUX, TAUNUY -#ifdef W3_OMPG - !$omp threadprivate( TAUNUX, TAUNUY) + +#ifdef W3_ST4 + REAL :: FMEANS, FH1, FH2, FAGE, DLWMEAN + REAL :: BRLAMBDA(NSPEC) #endif - LOGICAL, SAVE :: FLTEST = .FALSE., FLAGNN = .TRUE. -#ifdef W3_OMPG - !$omp threadprivate( FLTEST, FLAGNN ) + +#if defined(W3_ST3) || defined(W3_ST4) + LOGICAL :: LLWS(NSPEC) #endif - LOGICAL :: SHAVE - LOGICAL :: LBREAK - LOGICAL, SAVE :: FIRST = .TRUE. -#ifdef W3_OMPG - !$omp threadprivate( FIRST ) + +#ifdef W3_ST6 + REAL :: VSWL(NSPEC), VDWL(NSPEC) #endif - LOGICAL :: PrintDeltaSmDA - REAL :: eInc1, eInc2, eVS, eVD, JAC - REAL :: DeltaSRC(NSPEC) - REAL, PARAMETER :: DTMINTOT = 0.01 + #ifdef W3_PDLIB - REAL :: PreVS, FAK, DVS, SIDT, FAKS, MAXDAC + REAL :: PreVS, FAK, DVS, SIDT, FAKS, MAXDAC #endif #ifdef W3_NNT CHARACTER(LEN=17), SAVE :: FNAME = 'test_data_nnn.ww3' #endif - !/ - !/ ------------------------------------------------------------------- / - !/ + ! + !/ -- End of variable delclarations + ! #ifdef W3_S CALL STRACE (IENT, 'W3SRCE') #endif - ! + #ifdef W3_T FLTEST = .TRUE. #endif - ! - VDIO = 0. - VSIO = 0. - DEPTH = MAX ( DMIN , D_INP ) IKS1 = 1 - ICESCALELN = MAX(0.,MIN(1.,1.-ICE*ICESCALES(1))) - ICESCALEIN = MAX(0.,MIN(1.,1.-ICE*ICESCALES(2))) - ICESCALENL = MAX(0.,MIN(1.,1.-ICE*ICESCALES(3))) - ICESCALEDS = MAX(0.,MIN(1.,1.-ICE*ICESCALES(4))) #ifdef W3_IG1 - ! ! Does not integrate source terms for IG band if IGPARS(12) = 0. - ! IF (NINT(IGPARS(12)).EQ.0) IKS1 = NINT(IGPARS(5)) #endif - IS1=(IKS1-1)*NTH+1 - ! -#ifdef W3_LN0 - VSLN = 0. -#endif -#ifdef W3_LN1 - VSLN = 0. -#endif -#ifdef W3_SEED + + !! Initialise source term arrays: + VDIO = 0. + VSIO = 0. + VSBT = 0. + VDBT = 0. + +#if defined(W3_LN0) || defined(W3_LN1) || defined(W3_SEED) VSLN = 0. #endif -#ifdef W3_ST0 - VSIN = 0. - VDIN = 0. -#endif -#ifdef W3_ST3 - VSIN = 0. - VDIN = 0. -#endif -#ifdef W3_ST4 + +#if defined(W3_ST0) || defined(W3_ST3) || defined(W3_ST4) VSIN = 0. VDIN = 0. #endif -#ifdef W3_NL0 - VSNL = 0. - VDNL = 0. -#endif -#ifdef W3_NL1 +#if defined(W3_NL0) || defined(W3_NL1) VSNL = 0. VDNL = 0. #endif + #ifdef W3_TR1 VSTR = 0. VDTR = 0. #endif -#ifdef W3_ST0 - VSDS = 0. - VDDS = 0. -#endif -#ifdef W3_ST4 + +#if defined(W3_ST0) || defined(W3_ST4) VSDS = 0. VDDS = 0. #endif - VSBT = 0. - VDBT = 0. + #ifdef W3_DB1 VSDB = 0. VDDB = 0. #endif -#ifdef W3_IC1 - VSIC = 0. - VDIC = 0. -#endif -#ifdef W3_IC2 - VSIC = 0. - VDIC = 0. -#endif -#ifdef W3_IC3 - VSIC = 0. - VDIC = 0. -#endif -#ifdef W3_IC4 + +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) VSIC = 0. VDIC = 0. #endif + #ifdef W3_UOST VSUO = 0. VDUO = 0. #endif -#ifdef W3_IC5 - VSIC = 0. - VDIC = 0. -#endif - ! -#ifdef W3_IS1 + +#if defined(W3_IS1) || defined(W3_IS2) VSIR = 0. VDIR = 0. #endif + #ifdef W3_IS2 - VSIR = 0. - VDIR = 0. - VDIR2= 0. + VDIR2 = 0. #endif - ! + #ifdef W3_ST6 VSWL = 0. VDWL = 0. #endif - ! -#ifdef W3_ST0 - ZWND = 10. -#endif -#ifdef W3_ST1 - ZWND = 10. -#endif -#ifdef W3_ST2 - ZWND = ZWIND + +#if defined(W3_ST0) || defined(W3_ST1) || defined(W3_ST6) + ZWND = 10. #endif -#ifdef W3_ST4 - ZWND = ZZWND + +#if defined(W3_ST2) + ZWND = ZWIND #endif -#ifdef W3_ST6 - ZWND = 10. + +#if defined(W3_ST4) + ZWND = ZZWND #endif ! - DRAT = DAIR / DWAT + ! 1. Preparations --------------------------------------------------- * + ! + DEPTH = MAX ( DMIN , D_INP ) + DRAT = DAIR / DWAT + ICESCALELN = MAX(0.,MIN(1.,1.-ICE*ICESCALES(1))) + ICESCALEIN = MAX(0.,MIN(1.,1.-ICE*ICESCALES(2))) + ICESCALENL = MAX(0.,MIN(1.,1.-ICE*ICESCALES(3))) + ICESCALEDS = MAX(0.,MIN(1.,1.-ICE*ICESCALES(4))) + #ifdef W3_T WRITE (NDST,9000) WRITE (NDST,9001) DEPTH, U10ABS, U10DIR*RADE #endif - ! - ! 1. Preparations --------------------------------------------------- * - ! + ! 1.a Set maximum change and wavenumber arrays. ! !XP = 0.15 @@ -1080,8 +1049,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) #endif -#ifdef W3_DEBUGSRC -#ifdef W3_ST4 +#if defined(W3_DEBUGSRC) && defined(W3_ST4) IF (IX == DEBUG_NODE) THEN WRITE(740+IAPROC,*) '1: out value USTAR=', USTAR, ' USTDIR=', USTDIR WRITE(740+IAPROC,*) '1: out value EMEAN=', EMEAN, ' FMEAN=', FMEAN @@ -1090,7 +1058,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & WRITE(740+IAPROC,*) '1: out value ALPHA=', CHARN, ' FMEANWS=', FMEANWS END IF #endif -#endif #ifdef W3_ST4 CALL W3SIN4 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & @@ -1098,8 +1065,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & VSIN, VDIN, LLWS, IX, IY, BRLAMBDA ) END IF #endif -#ifdef W3_DEBUGSRC -#ifdef W3_ST4 +#if defined(W3_DEBUGSRC) && defined(W3_ST4) IF (IX == DEBUG_NODE) THEN WRITE(740+IAPROC,*) '1: U10DIR=', U10DIR, ' Z0=', Z0, ' CHARN=', CHARN WRITE(740+IAPROC,*) '1: USTAR=', USTAR, ' U10ABS=', U10ABS, ' AS=', AS @@ -1111,7 +1077,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & WRITE(740+IAPROC,*) '1: W3SIN4(min/max/sum)VDIN=', minval(VDIN), maxval(VDIN), sum(VDIN) END IF #endif -#endif #ifdef W3_ST4 CALL W3SPR4 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEAN1, WNMEAN, & @@ -1171,9 +1136,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_ST4 ! Introduces a Long & Resio (JGR2007) type dependance on wave age -#endif ! !/ST4 FAGE = FFXFA*TANH(0.3*U10ABS*FMEANWS*TPI/GRAV) -#ifdef W3_ST4 FAGE = 0. FHIGH = MAX( (FFXFM + FAGE ) * MAX(FMEAN1,FMEANWS), FFXPM / USTAR) FHIGI = FFXFA * FMEAN1 @@ -1237,14 +1200,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & VSIN, VDIN, LLWS, IX, IY, BRLAMBDA ) #endif -#ifdef W3_DEBUGSRC -#ifdef W3_ST4 +#if defined(W3_DEBUGSRC) && defined(W3_ST4) IF (IX == DEBUG_NODE) THEN WRITE(740+IAPROC,*) '2 : W3SIN4(min/max/sum)VSIN=', minval(VSIN), maxval(VSIN), sum(VSIN) WRITE(740+IAPROC,*) '2 : W3SIN4(min/max/sum)VDIN=', minval(VDIN), maxval(VDIN), sum(VDIN) END IF #endif -#endif #ifdef W3_ST6 CALL W3SIN6 ( SPEC, CG1, WN2, U10ABS, USTAR, USTDIR, CD, DAIR, & @@ -1254,16 +1215,16 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! 2.b Nonlinear interactions. ! #ifdef W3_NL1 - CALL W3SNL1 ( SPEC, CG1, WNMEAN*DEPTH, VSNL, VDNL ) + CALL W3SNL1 ( SPEC, CG1, WNMEAN*DEPTH, VSNL, VDNL ) #endif #ifdef W3_NL2 - CALL W3SNL2 ( SPEC, CG1, DEPTH, VSNL, VDNL ) + CALL W3SNL2 ( SPEC, CG1, DEPTH, VSNL, VDNL ) #endif #ifdef W3_NL3 - CALL W3SNL3 ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) + CALL W3SNL3 ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) #endif #ifdef W3_NL4 - CALL W3SNL4 ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) + CALL W3SNL4 ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) #endif #ifdef W3_NL5 CALL W3SNL5 ( SPEC, CG1, WN1, FMEAN, QI5TSTART, & @@ -1297,15 +1258,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & CALL W3SDS4 ( SPEC, WN1, CG1, USTAR, USTDIR, DEPTH, DAIR, VSDS, & VDDS, IX, IY, BRLAMBDA, WHITECAP, DLWMEAN ) #endif - -#ifdef W3_DEBUGSRC -#ifdef W3_ST4 +#if defined(W3_DEBUGSRC) && defined(W3_ST4) IF (IX == DEBUG_NODE) THEN WRITE(740+IAPROC,*) '2 : W3SDS4(min/max/sum)VSDS=', minval(VSDS), maxval(VSDS), sum(VSDS) WRITE(740+IAPROC,*) '2 : W3SDS4(min/max/sum)VDDS=', minval(VDDS), maxval(VDDS), sum(VDDS) END IF #endif -#endif #ifdef W3_ST6 CALL W3SDS6 ( SPEC, CG1, WN1, VSDS, VDDS ) @@ -1367,9 +1325,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & 8888 FORMAT (1X,I8.8,1X,I6.6,F8.1,L2,F8.2) WRITE (NDSD,ERR=801,IOSTAT=IERR) IX, IY, TIME, NSTEPS, & DTTOT, FLAGNN, DEPTH, U10ABS, U10DIR -#endif ! -#ifdef W3_NNT IF ( FLAGNN ) THEN DO IK=1, NK FACNN = TPI * SIG(IK) / CG1(IK) @@ -1449,11 +1405,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_ST6 VS(IS) = VS(IS) + VSWL(IS) #endif -#ifndef W3_PDLIB -#ifdef W3_TR1 +#if defined(W3_TR1) && !defined(W3_PDLIB) VS(IS) = VS(IS) + VSTR(IS) #endif -#endif #ifdef W3_BS1 VS(IS) = VS(IS) + VSBS(IS) #endif @@ -1465,34 +1419,30 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_ST6 VD(IS) = VD(IS) + VDWL(IS) #endif -#ifndef W3_PDLIB -#ifdef W3_TR1 +#if defined(W3_TR1) && !defined(W3_PDLIB) VD(IS) = VD(IS) + VDTR(IS) #endif -#endif #ifdef W3_BS1 VD(IS) = VD(IS) + VDBS(IS) #endif #ifdef W3_UOST VD(IS) = VD(IS) + VDUO(IS) #endif - DAMAX = MIN ( DAM(IS) , MAX ( XREL*SPECINIT(IS) , AFILT ) ) - AFAC = 1. / MAX( 1.E-10 , ABS(VS(IS)/DAMAX) ) + DAMAX = MIN ( DAM(IS) , MAX ( XREL*SPECINIT(IS) , AFILT ) ) + AFAC = 1. / MAX( 1.E-10 , ABS(VS(IS)/DAMAX) ) #ifdef W3_NL5 IF (NL5_SELECT .EQ. 1) THEN - DT = MIN ( DT , AFAC / ( MAX ( 1.E-10, & + DT = MIN ( DT , AFAC / ( MAX ( 1.E-10, & 1. + NL5_OFFSET*AFAC*MIN(0.,VD(IS)) ) ) ) ELSE #endif - DT = MIN ( DT , AFAC / ( MAX ( 1.E-10, & + DT = MIN ( DT , AFAC / ( MAX ( 1.E-10, & 1. + OFFSET*AFAC*MIN(0.,VD(IS)) ) ) ) #ifdef W3_NL5 ENDIF #endif END DO ! end of loop on IS - !VD = 0 - !VS = 0 ! DT = MAX ( 0.5, DT ) ! The hardcoded min. dt is a problem for certain cases e.g. laborotary scale problems. ! @@ -1500,11 +1450,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_T DTRAW = DT #endif - IDT = 1 + INT ( 0.99*(DTG-DTTOT)/DT ) ! number of iterations - DT = (DTG-DTTOT)/REAL(IDT) ! actualy time step - SHAVE = DT.LT.DTMIN .AND. DT.LT.DTG-DTTOT ! limiter check ... + IDT = 1 + INT ( 0.99*(DTG-DTTOT)/DT ) ! number of iterations + DT = (DTG-DTTOT)/REAL(IDT) ! actualy time step + SHAVE = DT.LT.DTMIN .AND. DT.LT.DTG-DTTOT ! limiter check ... SHAVEIO = SHAVE - DT = MAX ( DT , MIN (DTMIN,DTG-DTTOT) ) ! override dt with input time step or last time step if it is bigger ... anyway the limiter is on! + DT = MAX ( DT , MIN (DTMIN,DTG-DTTOT) ) ! override dt with input time step or last time step if it is bigger ... anyway the limiter is on! ! #ifdef W3_NL5 DT = INT(DT) * 1.0 @@ -1702,7 +1652,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & RETURN ! return everything is done for the implicit ... END IF ! srce_imp_pre -#endif !W3_PDLIB + +! --end W3_PDLIB +#endif ! #ifdef W3_T WRITE (NDST,9040) DTRAW, DT, SHAVE @@ -1757,9 +1709,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & WRITE(740+IAPROC,*) ' srce_direct : sum(VDTOT)=', sum(MIN(0. , VD)) END IF #endif - END IF - - + END IF ! srce_call .eq. srce_direct ! ! 5.b Computes ! atmos->wave flux PHIAW-------------------------------- * @@ -1789,12 +1739,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & HSTOT = HSTOT + SPEC(IS) * FACTOR END DO END DO - WHITECAP(3)=4.*SQRT(WHITECAP(3)) - HSTOT=4.*SQRT(HSTOT) - TAUWIX= TAUWIX+ TAUWX * DRAT *DT - TAUWIY= TAUWIY+ TAUWY * DRAT *DT - TAUWNX= TAUWNX+ TAUWAX * DRAT *DT - TAUWNY= TAUWNY+ TAUWAY * DRAT *DT + WHITECAP(3) = 4. * SQRT(WHITECAP(3)) + HSTOT =4.*SQRT(HSTOT) + TAUWIX = TAUWIX + TAUWX * DRAT * DT + TAUWIY = TAUWIY + TAUWY * DRAT * DT + TAUWNX = TAUWNX + TAUWAX * DRAT * DT + TAUWNY = TAUWNY + TAUWAY * DRAT * DT ! MISSING: TAIL TO BE ADDED ? ! #ifdef W3_NLS @@ -1847,9 +1797,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & FHIGH = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) NKH = MAX ( 2 , MIN ( NKH1 , & INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) -#endif ! -#ifdef W3_ST1 IF ( FLTEST ) WRITE (NDST,9060) & FH1*TPIINV, FH2*TPIINV, FHIGH*TPIINV, NKH #endif @@ -1860,9 +1808,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & DFH = FHIGH - FHTRAN NKH = MAX ( 1 , & INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHTRAN)) ) ) -#endif ! -#ifdef W3_ST2 IF ( FLTEST ) WRITE (NDST,9061) FHTRAN, FHIGH, NKH #endif ! @@ -1872,9 +1818,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & FHIGH = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) NKH = MAX ( 2 , MIN ( NKH1 , & INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) -#endif ! -#ifdef W3_ST3 IF ( FLTEST ) WRITE (NDST,9062) & FH1*TPIINV, FH2*TPIINV, FHIGH*TPIINV, NKH #endif @@ -1883,9 +1827,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! Introduces a Long & Resio (JGR2007) type dependance on wave age FAGE = FFXFA*TANH(0.3*U10ABS*FMEANWS*TPI/GRAV) FH1 = (FFXFM+FAGE) * FMEAN1 -#endif - -#ifdef W3_ST4 FH2 = FFXPM / USTAR FHIGH = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) NKH = MAX ( 2 , MIN ( NKH1 , & @@ -1900,9 +1841,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ENDIF NKH = MAX ( 2 , MIN ( NKH1 , & INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) -#endif ! -#ifdef W3_ST6 IF ( FLTEST ) WRITE (NDST,9063) FHIGH*TPIINV, NKH #endif ! @@ -1973,14 +1912,18 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_NL5 CALL TICK21(QI5TSTART, DT) #endif + IF (srce_call .eq. srce_imp_post) THEN EXIT ENDIF + IF ( DTTOT .GE. 0.9999*DTG ) THEN - ! IF (IX == DEBUG_NODE) WRITE(*,*) 'DTTOT, DTG', DTTOT, DTG + ! IF (IX == DEBUG_NODE) WRITE(*,*) 'DTTOT, DTG', DTTOT, DTG EXIT ENDIF + END DO ! INTEGRATION LOOP + #ifdef W3_DEBUGSRC IF (IX .eq. DEBUG_NODE) THEN WRITE(740+IAPROC,*) 'NSTEPS=', NSTEPS @@ -2099,13 +2042,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & R(:)=1 ! In case IC2 is defined but not IS2 ! #ifdef W3_IC1 - CALL W3SIC1 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) + CALL W3SIC1 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) #endif #ifdef W3_IS2 CALL W3SIS2 ( SPEC, DEPTH, ICE, ICEH, ICEF, ICEDMAX, IX, IY, & VSIR, VDIR, VDIR2, WN1, CG1, WN_R, CG_ICE, R ) #endif - #ifdef W3_IC2 CALL W3SIC2 ( SPEC, DEPTH, ICEH, ICEF, CG1, WN1,& IX, IY, VSIC, VDIC, WN_R, CG_ICE, ALPHA_LIU, R) @@ -2343,9 +2285,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_T 9020 FORMAT (' TEST W3SRCE : NSTEP : ',I4,' DTTOT :',F6.1) 9021 FORMAT (' TEST W3SRCE : NKH (3X) : ',2I3,I6) -#endif - ! -#ifdef W3_T 9040 FORMAT (' TEST W3SRCE : DTRAW, DT, SHAVE :',2F6.1,2X,L1) #endif ! From cc7e3e2203e06277b9dcfaa9d17221e8ae2861b5 Mon Sep 17 00:00:00 2001 From: "ukmo-chris.bunney" Date: Wed, 17 May 2023 10:03:56 +0100 Subject: [PATCH 2/4] Small update --- model/src/w3srcemd.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 3559b884c..e64e5a7f4 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -1947,9 +1947,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & 800 CONTINUE WRITE (NDSE,8000) FNAME, IERR CALL EXTCDE (1) -#endif ! -#ifdef W3_NNT 801 CONTINUE WRITE (NDSE,8001) IERR CALL EXTCDE (2) From b597ca782e0fa772fdb7e2632a1aa562a7ccf986 Mon Sep 17 00:00:00 2001 From: "ukmo-chris.bunney" Date: Wed, 17 May 2023 10:23:11 +0100 Subject: [PATCH 3/4] Removed a lot of unused variables. --- model/src/w3srcemd.F90 | 43 ++++++++++++++++++++---------------------- 1 file changed, 20 insertions(+), 23 deletions(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index e64e5a7f4..a5fa6a08a 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -494,24 +494,22 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: DWAT, srce_imp_post, srce_imp_pre, & - srce_direct, GRAV, TPI, TPIINV, LPDLIB -#ifdef W3_T - USE CONSTANTS, ONLY: RADE -#endif + srce_direct, GRAV, TPI, TPIINV USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, TH, DMIN, DTMAX, & DTMIN, FACTI1, FACTI2, FACSD, FACHFA, FACP, & XFC, XFLT, XREL, XFT, FXFM, FXPM, DDEN, & FTE, FTF, FHMAX, ECOS, ESIN, IICEDISP, & ICESCALES, IICESMOOTH - USE W3GDATMD, ONLY: FSSOURCE, optionCall - USE W3GDATMD, ONLY: B_JGS_NLEVEL, B_JGS_SOURCE_NONLINEAR, B_JGS_LIMITER -#ifdef W3_REF1 - USE W3GDATMD, ONLY: IOBP, IOBPD, IOBDP, GTYPE, UNGTYPE, REFPARS -#endif USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: NDSE, NDST, IAPROC - USE W3IDATMD, ONLY: INFLAGS2, ICEP2 + USE W3IDATMD, ONLY: INFLAGS2 USE W3DISPMD +#ifdef W3_T + USE CONSTANTS, ONLY: RADE +#endif +#ifdef W3_REF1 + USE W3GDATMD, ONLY: IOBP, IOBPD, GTYPE, UNGTYPE, REFPARS +#endif #ifdef W3_NNT USE W3ODATMD, ONLY: IAPROC, SCREEN, FNMPRE #endif @@ -639,14 +637,15 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & USE W3SERVMD, ONLY: EXTCDE #endif #ifdef W3_UOST - USE W3UOSTMD, ONLY : UOST_SRCTRMCOMPUTE + USE W3UOSTMD, ONLY: UOST_SRCTRMCOMPUTE #endif #ifdef W3_PDLIB - USE PDLIB_W3PROFSMD, ONLY : B_JAC, ASPAR_JAC, ASPAR_DIAG_SOURCES, ASPAR_DIAG_ALL - USE yowNodepool, ONLY: PDLIB_CCON, NPA, PDLIB_I_DIAG, PDLIB_JA, PDLIB_IA_P, PDLIB_SI - USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC, B_JGS_LIMITER_FUNC + USE PDLIB_W3PROFSMD, ONLY : B_JAC, ASPAR_JAC, ASPAR_DIAG_ALL + USE yowNodepool, ONLY: PDLIB_I_DIAG, PDLIB_SI + USE W3GDATMD, ONLY: B_JGS_LIMITER, FSSOURCE, optionCall + USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, B_JGS_LIMITER_FUNC USE W3WDATMD, ONLY: VA - USE W3PARALL, ONLY: ONESIXTH, ZERO, THR, IMEM, LSLOC + USE W3PARALL, ONLY: IMEM, LSLOC #endif !/ IMPLICIT NONE @@ -681,19 +680,18 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IK, ITH, IS, IS0, NSTEPS, NKH, NKH1, & - IKS1, IS1, NSPECH, IDT, IERR, NKD, ISP - INTEGER :: IOBPIP, IOBPDIP, IOBDPIP - REAL :: DTTOT, FHIGH, DT, AFILT, DAMAX, AFAC,& + INTEGER :: IK, ITH, IS, IS0, NSTEPS, NKH, NKH1, & + IKS1, IS1, NSPECH, IDT, IERR, ISP + REAL :: DTTOT, FHIGH, DT, AFILT, DAMAX, AFAC, & HDT, ZWND, FP, DEPTH, TAUSCX, TAUSCY, FHIGI ! Scaling factor for SIN, SDS, SNL REAL :: ICESCALELN, ICESCALEIN, ICESCALENL, ICESCALEDS REAL :: EMEAN, FMEAN, AMAX, CD, Z0, SCAT, & SMOOTH_ICEDISP - REAL :: WN_R(NK), CG_ICE(NK),ALPHA_LIU(NK), ICECOEF2, R(NK) + REAL :: WN_R(NK), CG_ICE(NK), ALPHA_LIU(NK), ICECOEF2, R(NK) DOUBLE PRECISION :: ATT, ISO REAL :: EBAND, DIFF, EFINISH, HSTOT, PHINL, & - FMEAN1, FMEANWS, MWXINIT, MWYINIT, & + FMEAN1, FMEANWS, & FACTOR, FACTOR2, DRAT, TAUWAX, TAUWAY, & MWXFINISH, MWYFINISH, A1BAND, B1BAND, & COSI(2) @@ -712,7 +710,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & LOGICAL :: PrintDeltaSmDA REAL :: eInc1, eInc2, eVS, eVD, JAC REAL :: DeltaSRC(NSPEC) - REAL, PARAMETER :: DTMINTOT = 0.01 REAL :: FOUT(NK,NTH), SOUT(NK,NTH), DOUT(NK,NTH) REAL, SAVE :: TAUNUX, TAUNUY @@ -819,7 +816,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_PDLIB - REAL :: PreVS, FAK, DVS, SIDT, FAKS, MAXDAC + REAL :: PreVS, DVS, SIDT, FAKS, MAXDAC #endif #ifdef W3_NNT From 4fbec92baae29f8481579201052646009a7e53ba Mon Sep 17 00:00:00 2001 From: "ukmo-chris.bunney" Date: Wed, 17 May 2023 15:20:27 +0100 Subject: [PATCH 4/4] Reinstated accidentally deleted line. --- model/src/w3srcemd.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index a5fa6a08a..676c84ebe 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -838,6 +838,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! Does not integrate source terms for IG band if IGPARS(12) = 0. IF (NINT(IGPARS(12)).EQ.0) IKS1 = NINT(IGPARS(5)) #endif + IS1=(IKS1-1)*NTH+1 !! Initialise source term arrays: VDIO = 0.