From 17a4e32e52d70e35f735caed29d27242059a56ad Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Fri, 7 Jul 2023 20:54:25 +0100 Subject: [PATCH 001/136] Bugfix - initialised VD and VS to zero in w3srcemd. (#1037) --- model/src/w3srcemd.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 11f6137a3d..4ca7d569d1 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -828,6 +828,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_T FLTEST = .TRUE. #endif + ! + VD = 0. ! VS and VD definitely need initialising. + VS = 0. ! VDIO = 0. VSIO = 0. From 2514633387d99959cb53e8ba606a1317ecf9f8fc Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Fri, 7 Jul 2023 20:55:40 +0100 Subject: [PATCH 002/136] More efficient test for binary files in matrix.comp (#1035) --- regtests/bin/matrix.comp | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/regtests/bin/matrix.comp b/regtests/bin/matrix.comp index cc3ecf20a9..0d70b1b7bd 100755 --- a/regtests/bin/matrix.comp +++ b/regtests/bin/matrix.comp @@ -5,8 +5,8 @@ # Intended for interactive running only. # # # # Hendrik L. Tolman # -# Updated by Yukino Nagai # -# June 2017 # +# Updated by Yukino Nagai # +# June 2017 # # # # Copyright 2013 National Weather Service (NWS), # # National Oceanic and Atmospheric Administration. All rights # @@ -17,6 +17,24 @@ # This script takes in one argument: the name of a test directory or 'all' # # 1. Set up + +function isbinary { + # Check if file is binary [or text] + # + # Uses `file` command to check if a file is binary or text by inspecting + # the MIME type of file. + # + # `file -i ` will return `text/` if file is a text file. + # Anything else can be considered a binary file. + # + # If your version of `file` does not accept the -i or --mime flag, you + # can also just run `file` with no flags and use `grep -i text`. + # + # The mime checking version is a bit more robust though. + + file -i $1 | grep -vq "text/" +} + # 1.a Computer/ user dependent set up if [ -z "$1" ] || [ -z "$2" ] || [ -z "$3" ] @@ -154,7 +172,7 @@ if [[ -d $file ]]; then if [[ $file == build* ]] || [[ $file == exe* ]] || [[ $file == *oasis3-mct* ]] || [[ $file == toy* ]]; then - echo "do not compare build or exe directories $file" + : # skip else #add files: files_dir=`ls $file` @@ -168,9 +186,6 @@ fi done - #Generate list of binary files in the directory - binaryfiles=`grep . -r * | grep 'Binary file' | sed -e "s/^Binary file //" -e "s/ matches$//"` - #Generate list of files to skip skipfiles="ww3_shel.out ww3_multi.out prf.*.mww3 finished ww3_systrk.out gmon.out time_count.txt oasis_make.out oasis_clean.out toy_model toy_make.out toy_clean.out build.log" @@ -186,7 +201,7 @@ if [[ -d $file ]]; then if [[ $file == build* ]] || [[ $file == exe* ]] || [[ $file == *oasis3-mct* ]] || [[ $file == toy* ]]; then - echo "do not compare build or exe directories $file" + : # skip else #add files: files_dir=`ls $file` @@ -227,7 +242,7 @@ elif [[ $file == log.* ]] || [[ $file == "output.ww3" ]] then filetype="log" - elif [[ $binaryfiles =~ (^|[[:space:]])"$file"($|[[:space:]]) ]] + elif isbinary $file then filetype="binary" else From 4d8c3156f0f4d76adde6d2dfdf1104941721bd24 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Tue, 11 Jul 2023 21:56:09 +0100 Subject: [PATCH 003/136] Tidy up of pre-processor directives and unused variables in w3srcemd.F90 (#1010) --- model/src/w3srcemd.F90 | 458 ++++++++++++++++++----------------------- 1 file changed, 195 insertions(+), 263 deletions(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 4ca7d569d1..5a79269b4f 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,286 +680,253 @@ 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 -#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 :: 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, & + 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, & - FMEAN1, FMEANWS, MWXINIT, MWYINIT, & + 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, & 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 :: 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, 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 ! - VD = 0. ! VS and VD definitely need initialising. - VS = 0. - ! - 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: + VD = 0. + VS = 0. + 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 @@ -1083,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 @@ -1093,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, & @@ -1101,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 @@ -1114,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, & @@ -1174,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 @@ -1240,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, & @@ -1257,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, & @@ -1300,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 ) @@ -1370,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) @@ -1452,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 @@ -1468,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. ! @@ -1503,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 @@ -1705,7 +1652,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & RETURN ! return everything is done for the implicit ... END IF ! srce_imp_pre -!W3_PDLIB +! --end W3_PDLIB #endif ! #ifdef W3_T @@ -1761,9 +1708,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-------------------------------- * @@ -1793,12 +1738,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 @@ -1851,9 +1796,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 @@ -1864,9 +1807,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 ! @@ -1876,9 +1817,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 @@ -1887,9 +1826,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 , & @@ -1904,9 +1840,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 ! @@ -1977,14 +1911,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 @@ -2008,9 +1946,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) @@ -2103,13 +2039,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) @@ -2347,9 +2282,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 02cb72f7b15d7384c507813a3a6569265f588491 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Fri, 14 Jul 2023 18:14:48 +0100 Subject: [PATCH 004/136] Correct typo in w3srcemd.F90 pre-processor directive. (#1039) --- model/src/w3srcemd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 5a79269b4f..6aa708bb86 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -757,7 +757,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & REAL :: DTRAW #endif -#if defined(W3_IC1) || W3_IC2 || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) REAL :: VSIC(NSPEC), VDIC(NSPEC) #endif From 1cacc436c8c1165e8d0bf80b61ec2ba1608ccf8a Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Mon, 31 Jul 2023 17:38:57 +0200 Subject: [PATCH 005/136] minor bugfix for matrix grepping on keywords (#1049) --- regtests/bin/run_cmake_test | 8 +++++--- regtests/ww3_tp2.12/info | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index e114cd72a0..ec1503c55d 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -491,7 +491,9 @@ then cp $path_build/install/bin/ww3_shel $path_e/ cp $path_build/install/bin/ww3_multi $path_e/ cp $path_build/install/bin/ww3_systrk $path_e/ - cp $path_build/install/bin/ww3_prtide $path_e/ + if [ -e $path_build/install/bin/ww3_prtide ]; then + cp $path_build/install/bin/ww3_prtide $path_e/ + fi fi else path_build=${path_build_root} @@ -1127,9 +1129,9 @@ then if [ $nml_input ] && [ ! -z "`ls ${path_i}/${prog}*.nml 2>/dev/null`" ] then - inputs_tmp=`( ls ${path_i}/${prog}${gu}*nml)` + inputs_tmp="`ls ${path_i}/${prog}${gu}*nml 2>/dev/null`" else - inputs_tmp=`( ls ${path_i}/${prog}${gu}*inp)` + inputs_tmp="`ls ${path_i}/${prog}${gu}*inp 2>/dev/null`" fi if [ ! -z "$inputs_tmp" ];then diff --git a/regtests/ww3_tp2.12/info b/regtests/ww3_tp2.12/info index e39ade75b7..622e6f5234 100644 --- a/regtests/ww3_tp2.12/info +++ b/regtests/ww3_tp2.12/info @@ -29,7 +29,7 @@ # * ww3_grid.inp (dummy grid input file, with assoc .bot, .mask, .obst) # # * partition.ww3 (raw fields of partition data, 4 time steps) # # * ww3_systrk.inp (instruction file) # -# * ww3_systrk will ABORT if endianess is incompatible with binary file! # +# * ww3_systrk will stop if endianess is incompatible with binary file! # # # # Sample run_test commands : # # (Note: mpirun commands differ by local system) # From dcafc8cb21ca96b50693b50905aed009fe7f11d3 Mon Sep 17 00:00:00 2001 From: Benoit Pouliot <51411504+benoitp-cmc@users.noreply.github.com> Date: Fri, 4 Aug 2023 16:43:46 -0400 Subject: [PATCH 006/136] Stop masking group 1 output where icec > icen (#1019) --- model/src/ww3_gint.F90 | 24 +- model/src/ww3_ounf.F90 | 720 +++++++----------- model/src/ww3_outf.F90 | 12 +- regtests/mww3_test_01/input/ww3_ounf.inp | 2 +- regtests/mww3_test_01/input/ww3_ounf.nml | 2 +- regtests/mww3_test_01/input/ww3_outf_file.inp | 2 +- regtests/mww3_test_01/input/ww3_shel.inp | 2 +- regtests/mww3_test_01/input/ww3_shel.nml | 2 +- 8 files changed, 279 insertions(+), 487 deletions(-) diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index ee1150485c..bfd2dd467b 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -1302,19 +1302,11 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & ! IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) - MAPICE = MOD(MAPST2(IY,IX),2) - MAPDRY = MOD(MAPST2(IY,IX)/2,2) - MAPLND = MOD(MAPST2(IY,IX)/4,2) - MAPMSK = MOD(MAPST2(IY,IX)/8,2) MAPINT = MOD(MAPST2(IY,IX)/16,2) - MAPST2(IY,IX) = MAPST2(IY,IX) - MAPICE - 2*MAPDRY - 4*MAPLND & - - 8*MAPMSK - ACTIVE = (MAPICE .NE. 1 .AND. MAPDRY .NE. 1) ! IF ( MAPINT .EQ. 0 ) THEN ! ! Initial loop to determine status map - ! Initialize by setting it to be ice free and wet ! MAPICE = 0 MAPDRY = 0 @@ -1361,8 +1353,8 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & IF ( NMAPDRY .GT. 50 ) MAPDRYT = 1 IF ( NMAPLND .GT. 50 ) MAPLNDT = 1 IF ( NMAPMSK .GT. 50 ) MAPMSKT = 1 - ACTIVE = (MAPICET .NE. 1 .AND. MAPDRYT .NE. 1 .AND. & - MAPLNDT .NE. 1 .AND. MAPMSKT .NE. 1) + ! Allow use of grid with ice or dry point. Allow merge of group 1 output + ACTIVE = (MAPLNDT .NE. 1 .AND. MAPMSKT .NE. 1) IF ( ACTIVE ) THEN USEGRID(IG) = .TRUE. SUMGRD = SUMGRD+1 @@ -1572,7 +1564,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & ! ! Group 1 variables ! - IF ( FLOGRD(1,1) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,1) ) THEN IF ( WADATS(IGRID)%DW(GSEA) .NE. UNDEF ) THEN SUMWT1(1) = SUMWT1(1) + WT IF ( DWAUX .EQ. UNDEF ) THEN @@ -1583,7 +1575,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,2) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,2) ) THEN IF ( WADATS(IGRID)%CX(GSEA) .NE. UNDEF ) THEN SUMWT1(2) = SUMWT1(2) + WT IF ( CXAUX .EQ. UNDEF ) THEN @@ -1609,7 +1601,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,4) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,4) ) THEN IF ( WADATS(IGRID)%AS(GSEA) .NE. UNDEF ) THEN SUMWT1(4) = SUMWT1(4) + WT IF ( ASAUX .EQ. UNDEF ) THEN @@ -1620,7 +1612,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,5) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,5) ) THEN IF ( WDATAS(IGRID)%WLV(GSEA) .NE. UNDEF ) THEN SUMWT1(5) = SUMWT1(5) + WT IF ( WLVAUX .EQ. UNDEF ) THEN @@ -1642,7 +1634,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,7) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,7) ) THEN IF ( WDATAS(IGRID)%BERG(GSEA) .NE. UNDEF ) THEN SUMWT1(7) = SUMWT1(7) + WT IF ( BERGAUX .EQ. UNDEF ) THEN @@ -1666,7 +1658,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - IF ( FLOGRD(1,9) .AND. ACTIVE ) THEN + IF ( FLOGRD(1,9) ) THEN IF ( WDATAS(IGRID)%RHOAIR(GSEA) .NE. UNDEF ) THEN SUMWT1(9) = SUMWT1(9) + WT IF ( RHOAIRAUX .EQ. UNDEF ) THEN diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index 0a2cadfcae..b77f9a9f96 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -1596,7 +1596,10 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ! Wave energy flux ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN - CGE=CGE*0.001 ! from W / m to kW / m + DO ISEA=1, NSEA + IF ( CGE(ISEA) .NE. UNDEF ) & + CGE(ISEA) = 0.001 * CGE(ISEA) ! from W / m to kW / m + END DO CALL S2GRID(CGE(1:NSEA), X1) ! ! Wind to wave energy flux @@ -2551,39 +2554,31 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IVAR=IVAR1+I IF (COORDTYPE.EQ.1) THEN IF (NCVARTYPE.EQ.2) THEN - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF - CALL CHECK_ERR(IRET) + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) + ELSE #endif - ELSE ! SMCGRD - IRET=NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) ELSE - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF - CALL CHECK_ERR(IRET) + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) + ELSE #endif - ELSE ! SMCGRD - IRET=NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) END IF @@ -2648,19 +2643,16 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ELSE ! If it is spherical coordinate IF (FLAGLL) THEN - IF(SMCGRD) THEN #ifdef W3_SMC - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_INQ_DIMID (NCID, 'seapoint', DIMID(2)) - ELSE - IRET=NF90_INQ_DIMID (NCID, 'longitude', DIMID(2)) - IRET=NF90_INQ_DIMID (NCID, 'latitude', DIMID(3)) - ENDIF -#endif + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_INQ_DIMID (NCID, 'seapoint', DIMID(2)) ELSE +#endif IRET=NF90_INQ_DIMID (NCID, 'longitude', DIMID(2)) IRET=NF90_INQ_DIMID (NCID, 'latitude', DIMID(3)) - ENDIF ! SMCGRD +#ifdef W3_SMC + ENDIF +#endif IRET=NF90_INQ_VARID (NCID, 'longitude', VARID(1)) IRET=NF90_INQ_VARID (NCID, 'latitude', VARID(2)) ! If it is cartesian coordinate @@ -2705,36 +2697,30 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IVAR=IVAR1+I IF (COORDTYPE.EQ.1) THEN IF (NCVARTYPE.EQ.2) THEN - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF -#endif + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) ELSE +#endif IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) ELSE - IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE - ! SMC Regridded file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - ENDIF -#endif + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) ELSE +#endif IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) END IF @@ -2849,263 +2835,171 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! NFIELD=3 IF (NCVARTYPE.EQ.2) THEN IF ( NFIELD.EQ.3 ) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MXX(IX,IY) = MFILL + MYY(IX,IY) = MFILL + MXY(IX,IY) = MFILL + ELSE + MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) + MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC + ENDIF +#endif + ! NFIELD=2 + ELSE IF (NFIELD.EQ.2 ) THEN + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL - MXY(IX,IY) = MFILL ELSE - MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) - MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) + MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) + MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) +#ifdef W3_SMC ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. X1(IX,IY) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - MXY(IX,IY) = MFILL - ELSE - MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) - MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) - END IF - END DO - END DO - - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! NFIELD=2 - ELSE IF (NFIELD.EQ.2 ) THEN - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN -#ifdef W3_SMC + ! EXTRADIM=1 + ELSE + START(3+1-COORDTYPE)=0 + DO IK=I1F,I2F + START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL ELSE - MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) + MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) + MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MXY(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. XX(IX,IY) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - ELSE - !PRINT*,XX(IX,IY),XY(IX,IY) - !STOP - MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(3+1-COORDTYPE)=0 - DO IK=I1F,I2F - START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 - - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - ELSE - MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) - MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MXY(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - ELSE - MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) - MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - ENDIF ! SMCGRD END DO END IF ! EXTRADIM ! NFIELD=1 ELSE ! EXTRADIM=0 IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MX1(IX,IY) = MFILL + ELSE + MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + END IF + END DO + END DO #ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) +#ifdef W3_SMC + ENDIF +#endif + ! EXTRADIM=1 + ELSE + START(3+1-COORDTYPE)=0 + DO IK=I1F,I2F + START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN MX1(IX,IY) = MFILL ELSE - MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MX1(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.X1(IX,IY) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(3+1-COORDTYPE)=0 - DO IK=I1F,I2F - START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 - - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD END DO END IF ! EXTRADIM END IF ! NFIELD @@ -3114,258 +3008,171 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ELSE IF ( NFIELD.EQ.3 ) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MXXR(IX,IY) = MFILLR + MYYR(IX,IY) = MFILLR + MXYR(IX,IY) = MFILLR + ELSE + MXXR(IX,IY) = X1(IX,IY) + MYYR(IX,IY) = X2(IX,IY) + MXYR(IX,IY) = XY(IX,IY) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC + ENDIF +#endif + ! NFIELD=2 + ELSE IF (NFIELD.EQ.2 ) THEN + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXXR(IX,IY) = MFILLR MYYR(IX,IY) = MFILLR - MXYR(IX,IY) = MFILLR ELSE - MXXR(IX,IY) = X1(IX,IY) - MYYR(IX,IY) = X2(IX,IY) - MXYR(IX,IY) = XY(IX,IY) + MXXR(IX,IY) = XX(IX,IY) + MYYR(IX,IY) = XY(IX,IY) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) +#ifdef W3_SMC ENDIF #endif - ELSE ! IF(SMCGRD) - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. X1(IX,IY) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - MXYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = X1(IX,IY) - MYYR(IX,IY) = X2(IX,IY) - MXYR(IX,IY) = XY(IX,IY) - END IF - END DO - END DO - - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! NFIELD=2 - ELSE IF (NFIELD.EQ.2 ) THEN - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN -#ifdef W3_SMC + ! EXTRADIM=1 + ELSE + START(4-COORDTYPE)=0 + DO IK=I1F,I2F + START(4-COORDTYPE)=START(4-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN MXXR(IX,IY) = MFILLR MYYR(IX,IY) = MFILLR ELSE - MXXR(IX,IY) = XX(IX,IY) - MYYR(IX,IY) = XY(IX,IY) + MXXR(IX,IY) = XXK(IX,IY,IK) + MYYR(IX,IY) = XYK(IX,IY,IK) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MXXR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MYYR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. XX(IX,IY) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = XX(IX,IY) - MYYR(IX,IY) = XY(IX,IY) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(4-COORDTYPE)=0 - DO IK=I1F,I2F - START(4-COORDTYPE)=START(4-COORDTYPE)+1 - - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = XXK(IX,IY,IK) - MYYR(IX,IY) = XYK(IX,IY,IK) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XXK(IX,IY,IK) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = XXK(IX,IY,IK) - MYYR(IX,IY) = XYK(IX,IY,IK) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - ENDIF ! SMCGRD END DO END IF ! EXTRADIM ! NFIELD=1 ELSE ! EXTRADIM=0 IF (EXTRADIM.EQ.0) THEN - IF (SMCGRD) THEN + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MX1R(IX,IY) = MFILLR + ELSE + MX1R(IX,IY) = X1(IX,IY) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC + ENDIF +#endif + ! EXTRADIM=1 + ELSE + START(4-COORDTYPE)=0 + DO IK=I1F,I2F + START(4-COORDTYPE)=START(4-COORDTYPE)+1 DO IX=IX1, IXN DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( X1(IX,IY) .EQ. UNDEF ) THEN + IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN MX1R(IX,IY) = MFILLR ELSE - MX1R(IX,IY) = X1(IX,IY) + MX1R(IX,IY) = XK(IX,IY,IK) END IF END DO END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) call CHECK_ERR(IRET) ELSE +#endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + MX1R(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) call CHECK_ERR(IRET) - ENDIF -#endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.X1(IX,IY) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = X1(IX,IY) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD - ! EXTRADIM=1 - ELSE - START(4-COORDTYPE)=0 - DO IK=I1F,I2F - START(4-COORDTYPE)=START(4-COORDTYPE)+1 - IF (SMCGRD) THEN #ifdef W3_SMC - DO IX=IX1, IXN - DO IY=IY1, IYN - ! TODO: Find some other way to access MAPSTA - IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = XK(IX,IY,IK) - END IF - END DO - END DO - IF(SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - ENDIF + ENDIF #endif - ELSE ! IF SMCGRD - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR.XK(IX,IY,IK) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = XK(IX,IY,IK) - END IF - END DO - END DO - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) - CALL CHECK_ERR(IRET) - END IF ! SMCGRD END DO END IF ! EXTRADIM END IF ! NFIELD @@ -3510,21 +3317,18 @@ SUBROUTINE W3CRNC (NCFILE, NCID, DIMID, DIMLN, VARID, & ! IF (GTYPE.NE.UNGTYPE) THEN IF (FLAGLL) THEN - IF (SMCGRD) THEN #ifdef W3_SMC - IF(SMCOTYPE .EQ. 1) THEN - ! Flat seapoints file - IRET = NF90_DEF_DIM(NCID, 'seapoint', dimln(2), DIMID(2)) - ELSE - ! Regular gridded file: - IRET = NF90_DEF_DIM(NCID, 'longitude', dimln(2), DIMID(2)) - IRET = NF90_DEF_DIM(NCID, 'latitude', dimln(3), DIMID(3)) - ENDIF -#endif + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + ! Flat seapoints file + IRET = NF90_DEF_DIM(NCID, 'seapoint', dimln(2), DIMID(2)) ELSE - IRET = NF90_DEF_DIM(NCID, 'longitude', DIMLN(2), DIMID(2)) - IRET = NF90_DEF_DIM(NCID, 'latitude', DIMLN(3), DIMID(3)) - ENDIF ! SMCGRD +#endif + ! Regular gridded file: + IRET = NF90_DEF_DIM(NCID, 'longitude', dimln(2), DIMID(2)) + IRET = NF90_DEF_DIM(NCID, 'latitude', dimln(3), DIMID(3)) +#ifdef W3_SMC + ENDIF +#endif ELSE IRET = NF90_DEF_DIM(NCID, 'x', DIMLN(2), DIMID(2)) IRET = NF90_DEF_DIM(NCID, 'y', DIMLN(3), DIMID(3)) diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index e4c1affedd..c055c92094 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -2365,8 +2365,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ! DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .GT. 0 .AND. & - X1(IX,IY) .NE. UNDEF ) THEN + IF ( X1(IX,IY) .NE. UNDEF ) THEN NINGRD = NINGRD + 1 XMIN = MIN ( XMIN , X1(IX,IY) ) XMAX = MAX ( XMAX , X1(IX,IY) ) @@ -2455,8 +2454,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) IF ( FLTRI ) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. & - XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL MXY(IX,IY) = MFILL @@ -2495,8 +2493,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) IF ( FLTWO .OR. FLDIR ) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. & - XX(IX,IY) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL ELSE @@ -2535,8 +2532,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ELSE DO IX=IX1, IXN DO IY=IY1, IYN - IF ( MAPSTA(IY,IX) .LE. 0 .OR. & - X1(IX,IY) .EQ. UNDEF ) THEN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN MX1(IX,IY) = MFILL ELSE MX1(IX,IY) = NINT(X1(IX,IY)/FSC) diff --git a/regtests/mww3_test_01/input/ww3_ounf.inp b/regtests/mww3_test_01/input/ww3_ounf.inp index 55b74a100a..f78b0e667b 100644 --- a/regtests/mww3_test_01/input/ww3_ounf.inp +++ b/regtests/mww3_test_01/input/ww3_ounf.inp @@ -11,7 +11,7 @@ $ file for a full documentation of field output options. Namelist type $ selection is used here (for alternative F/T flags, see ww3_shel.inp). $ N - HS + HS ICE $ $--------------------------------------------------------------------- $ $ Output type 4 [3,4] (version netCDF) diff --git a/regtests/mww3_test_01/input/ww3_ounf.nml b/regtests/mww3_test_01/input/ww3_ounf.nml index 5a92a0cb59..b6a115a7f7 100644 --- a/regtests/mww3_test_01/input/ww3_ounf.nml +++ b/regtests/mww3_test_01/input/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '19680606 000000' FIELD%TIMESTRIDE = '3600' FIELD%TIMECOUNT = '999' - FIELD%LIST = 'HS' + FIELD%LIST = 'HS ICE' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 / diff --git a/regtests/mww3_test_01/input/ww3_outf_file.inp b/regtests/mww3_test_01/input/ww3_outf_file.inp index 6d909ff539..db8c14716d 100644 --- a/regtests/mww3_test_01/input/ww3_outf_file.inp +++ b/regtests/mww3_test_01/input/ww3_outf_file.inp @@ -6,7 +6,7 @@ $ 19680606 000000 3600 999 $ N - HS + HS ICE $ 3 0 1 999 1 999 1 1 diff --git a/regtests/mww3_test_01/input/ww3_shel.inp b/regtests/mww3_test_01/input/ww3_shel.inp index 1585f747ee..ecc5118003 100644 --- a/regtests/mww3_test_01/input/ww3_shel.inp +++ b/regtests/mww3_test_01/input/ww3_shel.inp @@ -18,7 +18,7 @@ $ 19680606 000000 450 19680607 000000 $ N - HS FP DP + HS FP DP ICE $ 19680606 000000 450 19680607 000000 100.E3 100.E3 'point_A' diff --git a/regtests/mww3_test_01/input/ww3_shel.nml b/regtests/mww3_test_01/input/ww3_shel.nml index f9a586f539..903cef0c88 100644 --- a/regtests/mww3_test_01/input/ww3_shel.nml +++ b/regtests/mww3_test_01/input/ww3_shel.nml @@ -22,7 +22,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS FP DP' + TYPE%FIELD%LIST = 'HS FP DP ICE' TYPE%POINT%FILE = '../input/points.list' / From 2715a9e78d92a358dd7b7f3f5d463522615d430b Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 7 Aug 2023 10:33:16 -0400 Subject: [PATCH 007/136] Doxygen documentation added, 8th subset.(#1046) --- model/src/gx_outf.F90 | 42 +++ model/src/gx_outp.F90 | 28 ++ model/src/w3canomd.F90 | 608 ++++++++++++++++++++++++++++++++++------- model/src/w3parall.F90 | 162 ++++++++++- model/src/w3pro1md.F90 | 66 +++++ model/src/w3pro2md.F90 | 80 ++++++ model/src/w3pro3md.F90 | 104 +++++++ model/src/w3ref1md.F90 | 46 +++- model/src/w3sbt1md.F90 | 43 +++ model/src/w3sbt4md.F90 | 61 +++++ model/src/w3sbt8md.F90 | 58 +++- model/src/w3sbt9md.F90 | 68 +++++ model/src/w3sdb1md.F90 | 43 +++ 13 files changed, 1303 insertions(+), 106 deletions(-) diff --git a/model/src/gx_outf.F90 b/model/src/gx_outf.F90 index 4c25b44259..c8ab00e384 100644 --- a/model/src/gx_outf.F90 +++ b/model/src/gx_outf.F90 @@ -1,5 +1,37 @@ +!> @file +!> @brief Generate GrADS input files from raw WAVEWATCH data file. +!> +!> @author H. L. Tolman +!> @author A. Chawla +!> @author J.H.G.M. Alves +!> @date 22-Mar-2021 +!> #include "w3macros.h" + !/ ------------------------------------------------------------------- / +!> +!> @brief Generate GrADS input files from raw WAVEWATCH data file. +!> +!> @details +!> Data is read from the grid output file out_grd.ww3 (raw data) +!> and from the file gx_outf.inp ( NDSI, output requests ). +!> Model definition and raw data files are read using WAVEWATCH III +!> subroutines. +!> +!> Output files are ww3.ctl and ww3.grads. The output files +!> contains a land-sea map, followed by requested fields. See the +!> control file for the names of the fields. +!> +!> @author H. L. Tolman +!> @author A. Chawla +!> @author J.H.G.M. Alves +!> @date 22-Mar-2021 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> PROGRAM GXOUTF !/ !/ +-----------------------------------+ @@ -740,6 +772,16 @@ PROGRAM GXOUTF !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Perform actual output for GrADS postprocessing. + !> + !> @param[in] NX Grid dimensions. + !> @param[in] NY Grid dimensions. + !> @param[in] NSEA Number of sea points. + !> + !> @author H. L. Tolman + !> @date 22-Mar-2021 + !> SUBROUTINE GXEXGO ( NX, NY, NSEA ) !/ !/ +-----------------------------------+ diff --git a/model/src/gx_outp.F90 b/model/src/gx_outp.F90 index 63b525485d..d34fdbaa72 100644 --- a/model/src/gx_outp.F90 +++ b/model/src/gx_outp.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief Post-processing of point output for GrADS post-processing. +!> +!> @author H. L. Tolman +!> @author J.H. Alves +!> @author F. Ardhuin +!> @date 27-Aug-2015 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Post-processing of point output for GrADS post-processing. +!> +!> @author H. L. Tolman +!> @author J.H. Alves +!> @author F. Ardhuin +!> @date 27-Aug-2015 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> PROGRAM GXOUTP !/ !/ +-----------------------------------+ @@ -539,6 +561,12 @@ PROGRAM GXOUTP !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Perform actual point output. + !> + !> @author H. L. Tolman + !> @date 16-Jul-2012 + !> SUBROUTINE GXEXPO !/ !/ +-----------------------------------+ diff --git a/model/src/w3canomd.F90 b/model/src/w3canomd.F90 index de287eb857..5395853f27 100644 --- a/model/src/w3canomd.F90 +++ b/model/src/w3canomd.F90 @@ -1,5 +1,25 @@ +!> @file +!> @brief Calculation of the second order correction to the surface +!> gravity wave spectrum. +!> +!> @author P.A.E.M. Janssen +!> @date 21-Aug-2014 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Calculation of the second order correction to the surface +!> gravity wave spectrum. +!> +!> @author P.A.E.M. Janssen +!> @date 21-Aug-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3CANOMD !/ !/ +-----------------------------------+ @@ -117,6 +137,18 @@ MODULE W3CANOMD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Adds second order spectrum on top of first order spectrum. + !> + !> @param[inout] E Energy density spectrum (1-D), f-theta. + !> @param[in] DEPTH Mean water depth. + !> @param[in] WN Wavenumbers. + !> @param[in] CG Group velocities. + !> @param[in] IACTION Action density spectrum (1-D). + !> + !> @author F. Ardhuin + !> @date 19-Oct-2012 + !> SUBROUTINE W3ADD2NDORDER(E,DEPTH,WN,CG,IACTION) !/ !/ +-----------------------------------+ @@ -313,6 +345,25 @@ END SUBROUTINE W3ADD2NDORDER !----------------------------------------------------------------------- ! + !> + !> @brief Determines second order spectrum. + !> + !> @param[in] F1 2-D free wave spectrum + !> @param[out] F3 2-D spectrum including 2nd-order correction + !> @param[in] NFRE number of frequencies + !> @param[in] NANG number of directions + !> @param[in] FR frequencies + !> @param[in] DFIM frequency increment + !> @param[in] TH directional array + !> @param[in] DELTH directional increment + !> @param[in] DPTH depth array + !> @param[in] SIGM mapping indicator + !> @param[in] NFREH + !> @param[in] NANGH + !> + !> @author Peter Janssen + !> @date NA + !> SUBROUTINE CAL_SEC_ORDER_SPEC(F1,F3,NFRE,NANG,FR,DFIM,TH,DELTH, & DPTH,SIGM, NFREH, NANGH) ! @@ -649,6 +700,23 @@ END SUBROUTINE CAL_SEC_ORDER_SPEC ! !-------------------------------------------------------------------- ! + !> + !> @brief Computes tables for second order spectrum in frequency space. + !> + !> @param NFRE number of frequencies + !> @param NANG number of directions + !> @param NDEPTH number of entries in the depth table + !> @param DEPTHA + !> @param OMSTART start frequency + !> @param FRAC fractional increase in frequency space + !> @param XMR inverse of thinning factor in frequency space + !> @param DFDTH product of increment in frequency and direction + !> @param OMEGA angular frequency array + !> @param TH direction array + !> + !> @author NA + !> @date NA + !> SUBROUTINE TABLES_2ND(NFRE,NANG,NDEPTH,DEPTHA,OMSTART,FRAC,XMR,& DFDTH,OMEGA,TH) ! @@ -821,6 +889,35 @@ END SUBROUTINE TABLES_2ND ! !-------------------------------------------------------------------- ! + !> + !> @brief Computes second order spectrum in frequency space. + !> + !> @param F1 2D free wave spectrum (input) + !> @param F3 bound waves spectrum (output) + !> @param NFRE number of frequencies + !> @param NANG number of directions + !> @param NMAX maximum index corresponds to twice the cut-off frequency + !> + !> @param NDEPTH number of entries in depth table + !> @param DEPTHA start value depth array + !> @param DEPTHD increment depth array + !> @param OMSTART start value angular frequency array + !> @param FRAC fractional increase in frequency space + !> @param MR thinning factor in frequency space + !> @param OMEGA angular frequency array + !> @param DEPTH depth array + !> @param AKMEAN mean wavenumber array + !> @param TA table for minus interactions + !> @param TB table for plus interactions + !> @param TC_QL table for quasi-linear interactions + !> @param TT_4M table for stokes frequency correction + !> @param TT_4P table for stokes frequency correction + !> @param IM_P table for wavenumber m2 plus + !> @param IM_M table for wavenumber m2 min + !> + !> @author NA + !> @date NA + !> SUBROUTINE SECSPOM(F1,F3,NFRE,NANG,NMAX,NDEPTH,& DEPTHA,DEPTHD,OMSTART,FRAC,MR,DFDTH,OMEGA,& DEPTH,AKMEAN,TA,TB,TC_QL,TT_4M,TT_4P,& @@ -1035,14 +1132,28 @@ SUBROUTINE SECSPOM(F1,F3,NFRE,NANG,NMAX,NDEPTH,& ! RETURN END SUBROUTINE SECSPOM + ! - ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A(XI,XJ,THI,THJ) - ! - !----------------------------------------------------------------------- + !> + !> @brief Gives nonlinear transfer coefficient for three wave interactions + !> interactions of gravity waves in the ideal case of no current. Determines + !> the minus interaction coefficients. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param THI + !> @param THJ + !> @returns A + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A(XI,XJ,THI,THJ) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A(XI,XJ,THI,THJ) + ! + !----------------------------------------------------------------------- ! !*** *A* DETERMINES THE MINUS INTERACTIONS. ! @@ -1100,10 +1211,24 @@ REAL FUNCTION A(XI,XJ,THI,THJ) RETURN END FUNCTION A ! - !*** *REAL FUNCTION* *B(XI,XJ,THI,THJ) - ! - !----------------------------------------------------------------------- + !> + !> @brief Gives nonlinear transfer coefficient for three wave interactions + !> interactions of gravity waves in the ideal case of no current. Determines + !> the plus interaction coefficients. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param THI + !> @param THJ + !> @returns B + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B(XI,XJ,THI,THJ) + !*** *REAL FUNCTION* *B(XI,XJ,THI,THJ) + ! + !----------------------------------------------------------------------- ! !*** *B* DETERMINES THE PLUS INTERACTION COEFFICIENTS. ! @@ -1160,12 +1285,24 @@ REAL FUNCTION B(XI,XJ,THI,THJ) RETURN END FUNCTION B ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *C_QL(XK0,XK1,TH0,TH1) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determine contribution by quasi-linear terms. + !> + !> @param XK0 + !> @param XK1 + !> @param TH0 + !> @param TH1 + !> @returns C_QL + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION C_QL(XK0,XK1,TH0,TH1) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *C_QL(XK0,XK1,TH0,TH1) + ! + !----------------------------------------------------------------------- ! !*** *A* DETERMINES THE QUASI-LINEAR TERM. ! @@ -1212,12 +1349,27 @@ END FUNCTION C_QL ! ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *VPLUS(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the second-order transfer coefficient + !> for three wave interactions of gravity waves. + !> + !> @param XI wave numbers + !> @param XJ wave numbers + !> @param XK wave numbers + !> @param THI wave direction + !> @param THJ wave direction + !> @param THK wave direction + !> @returns VPLUS + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION VPLUS(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *VPLUS(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *VPLUS* DETERMINES THE SECOND-ORDER TRANSFER COEFFICIENT ! FOR THREE WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1288,12 +1440,27 @@ REAL FUNCTION VPLUS(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION VPLUS ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *VMIN(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the second-order transfer coefficient for + !> three wave interactions of gravity waves. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param XK wave number + !> @param THI wave direction + !> @param THJ wave direction + !> @param THK wave direction + !> @returns VMIN + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION VMIN(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *VMIN(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *VMIN* DETERMINES THE SECOND-ORDER TRANSFER COEFFICIENT FOR ! THREE WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1364,12 +1531,29 @@ REAL FUNCTION VMIN(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION VMIN ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *U(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the third-order transfer coefficient for four + !> wave interactions of gravity waves. + !> + !> @param XI wave number + !> @param XJ wave number + !> @param XK wave number + !> @param XL wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns U + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION U(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *U(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *U* DETERMINES THE THIRD-ORDER TRANSFER COEFFICIENT FOR FOUR ! WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1438,12 +1622,29 @@ REAL FUNCTION U(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION U ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *W2(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the contribution of the direct four-wave + !> interactions of gravity waves of the type A_2^*A_3A_4. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns W2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION W2(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *W2(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *W2* DETERMINES THE CONTRIBUTION OF THE DIRECT FOUR-WAVE ! INTERACTIONS OF GRAVITY WAVES OF THE TYPE @@ -1490,12 +1691,29 @@ REAL FUNCTION W2(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION W2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *V2(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the contribution of the virtual + !> four-wave interactions of gravity waves. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns V2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION V2(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *V2(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *V2* DETERMINES THE CONTRIBUTION OF THE VIRTUAL ! FOUR-WAVE INTERACTIONS OF GRAVITY WAVES. @@ -1624,12 +1842,29 @@ REAL FUNCTION V2(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION V2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *W1(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the nonlinear transfer coefficient for four wave + !> interactions of gravity waves of the type A_2A_3A_4. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns W1 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION W1(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *W1(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *W1* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR FOUR ! WAVE INTERACTIONS OF GRAVITY WAVES OF THE TYPE @@ -1683,10 +1918,29 @@ REAL FUNCTION W1(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION W1 ! - !*** *REAL FUNCTION* *W4(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Determines the nonlinear transfer coefficient for four wave + !> interactions of gravity waves of the type A_^*A_3^*A_4^*. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns W4 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION W4(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *W4(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *W4* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR FOUR ! WAVE INTERACTIONS OF GRAVITY WAVES of the type @@ -1741,13 +1995,29 @@ REAL FUNCTION W4(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION W4 - ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B3(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + + !> + !> @brief Weights of the A_2^*A_3^*A_4 part of the canonical transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B3 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B3(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *B3(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B3* WEIGHTS OF THE A_2^*A_3^*A_4 PART OF THE ! CANONICAL TRANSFORMATION. @@ -1858,12 +2128,29 @@ REAL FUNCTION B3(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION B3 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B4(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Weights of the A_2^*A_3^*A_4^* part of the canonical + !> transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B4 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B4(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *B4(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B4* WEIGHTS OF THE A_2^*A_3^*A_4^* PART OF THE CANONICAL ! TRANSFORMATION. @@ -1954,12 +2241,29 @@ REAL FUNCTION B4(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION B4 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B1(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Weights of the A_2A_3A_4 part of the canonical + !> transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B1 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B1(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *B1(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B1* WEIGHTS OF THE A_2A_3A_4 PART OF THE CANONICAL ! TRANSFORMATION. @@ -2055,15 +2359,30 @@ REAL FUNCTION B1(XI,XJ,XK,XL,THI,THJ,THK,THL) ) +W1(RI,RJ,RK,RL,THI,THJ,THK,THL) ) RETURN END FUNCTION B1 - ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *B2(XI,XJ,XK,XL,THI,THJ,THK,THL) - ! - !----------------------------------------------------------------------- + !> + !> @brief Weights of the A_2^*A_3A_4 part of the canonical + !> transformation. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param XL Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @param THL + !> @returns B2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION B2(XI,XJ,XK,XL,THI,THJ,THK,THL) + !----------------------------------------------------------------------- ! + !*** *REAL FUNCTION* *B2(XI,XJ,XK,XL,THI,THJ,THK,THL) + ! + !----------------------------------------------------------------------- ! !*** *B2* WEIGHTS OF THE A_2^*A_3A_4 PART OF THE CANONICAL ! TRANSFORMATION. @@ -2155,12 +2474,26 @@ REAL FUNCTION B2(XI,XJ,XK,XL,THI,THJ,THK,THL) RETURN END FUNCTION B2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A1(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Auxiliary second-order coefficient. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @returns A1 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A1(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A1(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *A1* AUXILIARY SECOND-ORDER COEFFICIENT. ! @@ -2215,12 +2548,26 @@ REAL FUNCTION A1(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION A1 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A2(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Auxiliary second-order function. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @returns A2 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A2(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A2(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *A2* AUXILIARY SECOND-ORDER FUNCTION. ! @@ -2259,12 +2606,26 @@ REAL FUNCTION A2(XI,XJ,XK,THI,THJ,THK) RETURN END FUNCTION A2 ! - !----------------------------------------------------------------------- - ! - !*** *REAL FUNCTION* *A3(XI,XJ,XK,THI,THJ,THK) - ! - !----------------------------------------------------------------------- + !> + !> @brief Auxiliary second-order function. + !> + !> @param XI Wave number + !> @param XJ Wave number + !> @param XK Wave number + !> @param THI + !> @param THJ + !> @param THK + !> @returns A3 + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION A3(XI,XJ,XK,THI,THJ,THK) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *A3(XI,XJ,XK,THI,THJ,THK) + ! + !----------------------------------------------------------------------- ! !*** *A3* AUXILIARY SECOND-ORDER FUNCTION. ! @@ -2317,14 +2678,23 @@ REAL FUNCTION A3(XI,XJ,XK,THI,THJ,THK) END FUNCTION A3 ! - !----------------------------------------------------------------------- - ! - ! - !*** *REAL FUNCTION* *OMEG(X)* - ! - !----------------------------------------------------------------------- - ! + !> + !> @brief Determines the dispersion relation for gravity + !> waves. + !> + !> @param X Wave number + !> @returns OMEG + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION OMEG(X) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *OMEG(X)* + ! + !----------------------------------------------------------------------- + ! ! !*** *OMEG* DETERMINES THE DISPERSION RELATION FOR GRAVITY ! WAVES. @@ -2366,15 +2736,21 @@ REAL FUNCTION OMEG(X) RETURN END FUNCTION OMEG ! - ! - !----------------------------------------------------------------------- - ! - ! - !*** *REAL FUNCTION* *VG(X)* - ! - !----------------------------------------------------------------------- - ! + !> + !> @brief Determines the group velocity for gravity- waves. + !> + !> @param X Wave number + !> @returns VG + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION VG(X) + !----------------------------------------------------------------------- + ! + !*** *REAL FUNCTION* *VG(X)* + ! + !----------------------------------------------------------------------- ! !*** *VG* DETERMINES THE GROUP VELOCITY FOR GRAVITY- WAVES. ! @@ -2416,6 +2792,16 @@ REAL FUNCTION VG(X) RETURN END FUNCTION VG !--------------------------------------------------------------------- + !> + !> @brief Gives the wavenumber. + !> + !> @param OM + !> @param BETA + !> @returns AKI + !> + !> @author Peter Janssen + !> @date NA + !> REAL FUNCTION AKI(OM,BETA) ! This function gives the wavenumber ... !--------------------------------------------------------------------- @@ -2444,6 +2830,18 @@ REAL FUNCTION AKI(OM,BETA) RETURN END FUNCTION AKI ! + !> + !> @brief NA. + !> + !> @param XI + !> @param XJ + !> @param THI + !> @param THJ + !> @returns VABS + !> + !> @author NA + !> @date NA + !> REAL FUNCTION VABS(XI,XJ,THI,THJ) ! !--------------------------------------------------------------------- @@ -2462,6 +2860,18 @@ REAL FUNCTION VABS(XI,XJ,THI,THJ) RETURN END FUNCTION VABS ! + !> + !> @brief NA. + !> + !> @param XI + !> @param XJ + !> @param THI + !> @param THJ + !> @returns VDIR + !> + !> @author NA + !> @date NA + !> REAL FUNCTION VDIR(XI,XJ,THI,THJ) ! !--------------------------------------------------------------------- diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index 798e989cbd..e2aba9b529 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -1,3 +1,24 @@ +!> @file +!> @brief Parallel routines for implicit solver. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 01-Jun-2018 +!> + +!/ ------------------------------------------------------------------- / +!> +!> @brief Parallel routines for implicit solver. +!> +!> @author Aron Roland +!> @author Mathieu Dutour-Sikiric +!> @date 01-Jun-2018 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PARALL !/ !/ +-----------------------------------+ @@ -76,6 +97,15 @@ MODULE W3PARALL REAL, PARAMETER :: THR = TINY(1.0) CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief NA + !> + !> @param[out] eTime + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE WAV_MY_WTIME(eTime) !/ ------------------------------------------------------------------- / !/ @@ -157,6 +187,15 @@ SUBROUTINE WAV_MY_WTIME(eTime) !/ END SUBROUTINE WAV_MY_WTIME !/ ------------------------------------------------------------------- / + !> + !> @brief Print timings. + !> + !> @param[in] string + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PRINT_MY_TIME(string) !/ !/ +-----------------------------------+ @@ -232,6 +271,17 @@ SUBROUTINE PRINT_MY_TIME(string) !/ END SUBROUTINE PRINT_MY_TIME !/ ------------------------------------------------------------------- / + !> + !> @brief Compute refraction part in matrix. + !> + !> @param[in] ISEA + !> @param[in] DTG + !> @param[out] CAD + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) !/ !/ +-----------------------------------+ @@ -382,6 +432,19 @@ SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) END SUBROUTINE PROP_REFRACTION_PR1 !/ ------------------------------------------------------------------- / ! + !> + !> @brief Compute refraction part in matrix alternative approach. + !> + !> @param[in] IP + !> @param[in] ISEA + !> @param[in] DTG + !> @param[out] CAD + !> @param[in] DoLimiter + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) !/ !/ +-----------------------------------+ @@ -529,6 +592,19 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) !/ END SUBROUTINE PROP_REFRACTION_PR3 !/ ------------------------------------------------------------------- / + !> + !> @brief Compute frequency shift in matrix. + !> + !> @param[in] IP + !> @param[in] ISEA + !> @param[out] CAS + !> @param[out] DMM + !> @param[in] DTG + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) !/ !/ +-----------------------------------+ @@ -668,6 +744,19 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) !/ END SUBROUTINE PROP_FREQ_SHIFT !/ ------------------------------------------------------------------- / + !> + !> @brief Compute frequency shift alternative approach. + !> + !> @param[in] IP + !> @param[in] ISEA + !> @param[out] CWNB_M2 + !> @param[out] DWNI_M2 + !> @param[in] DTG + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) !/ !/ +-----------------------------------+ @@ -813,6 +902,16 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) !/ END SUBROUTINE PROP_FREQ_SHIFT_M2 !/ ------------------------------------------------------------------- / + !> + !> @brief Sync global local arrays. + !> + !> @param[in] IMOD + !> @param[in] IsMulti + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) !/ !/ +-----------------------------------+ @@ -927,6 +1026,16 @@ SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) !/ END SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY !/ ....................----------------------------------------------- / + !> + !> @brief Setup NSEAL, NSEALM in context of PDLIB. + !> + !> @param[out] NSEALout + !> @param[out] NSEALMout + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) !/ !/ +-----------------------------------+ @@ -1039,6 +1148,17 @@ SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) !/ END SUBROUTINE SET_UP_NSEAL_NSEALM !/ ------------------------------------------------------------------- / + !> + !> @brief Set JSEA for all schemes. + !> + !> @param[in] ISEA + !> @param[out] JSEA + !> @param[out] ISPROC + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/ ------------------------------------------------------------------- / !/ @@ -1136,6 +1256,17 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/ END SUBROUTINE INIT_GET_JSEA_ISPROC !/ ------------------------------------------------------------------- / + !> + !> @brief Set belongings of JSEA in context of PDLIB. + !> + !> @param[in] ISEA + !> @param[out] JSEA + !> @param[out] IBELONG + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) !/ ------------------------------------------------------------------- / !/ @@ -1253,6 +1384,16 @@ SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) !/ END SUBROUTINE GET_JSEA_IBELONG !/ ------------------------------------------------------------------- / + !> + !> @brief Set ISEA for all schemes. + !> + !> @param[out] ISEA + !> @param[in] JSEA + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) !/ ------------------------------------------------------------------- / !/ @@ -1359,12 +1500,25 @@ SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) !/ End of INIT_GET_ISEA ------------------------------------------------ / !/ END SUBROUTINE INIT_GET_ISEA - !********************************************************************** - !* An array of size (NSEA) is send but only the (1:NSEAL) values * - !* are correct. The program synchonizes everything on all nodes. * - !********************************************************************** + + !> + !> @brief Sync global array in context of PDLIB. + !> + !> @details An array of size (NSEA) is send but only the (1:NSEAL) values + !> are correct. The program synchonizes everything on all nodes. + !> + !> @param[inout] TheVar + !> + !> @author Aron Roland + !> @author Mathieu Dutour-Sikiric + !> @date 01-Jun-2018 + !> SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) !/ ------------------------------------------------------------------- / + !********************************************************************** + !* An array of size (NSEA) is send but only the (1:NSEAL) values * + !* are correct. The program synchonizes everything on all nodes. * + !********************************************************************** !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | diff --git a/model/src/w3pro1md.F90 b/model/src/w3pro1md.F90 index 16db903565..f8b498833c 100644 --- a/model/src/w3pro1md.F90 +++ b/model/src/w3pro1md.F90 @@ -1,5 +1,25 @@ +!> @file +!> @brief Bundles routines for first order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 05-Jun-2018 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Bundles routines for first order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 05-Jun-2018 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PRO1MD !/ !/ +-----------------------------------+ @@ -76,6 +96,14 @@ MODULE W3PRO1MD !/ ------------------------------------------------------------------- / CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the first order upstream scheme. + !> + !> @param MAPSTA Status map + !> + !> @author H. L. Tolman + !> @date 06-Dec-2010 + !> SUBROUTINE W3MAP1 ( MAPSTA ) !/ !/ +-----------------------------------+ @@ -258,6 +286,19 @@ SUBROUTINE W3MAP1 ( MAPSTA ) !/ END SUBROUTINE W3MAP1 !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in physical space for a given spectral component. + !> + !> @param[in] ISP Number of spectral bin (IK-1)*NTH+ITH + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[inout] FIELD Wave action spectral densities on full grid. + !> @param[in] VGX Speed of grid. + !> @param[in] VGY Speed of grid. + !> + !> @author H. L. Tolman + !> @date 29-May-2014 + !> SUBROUTINE W3XYP1 ( ISP, DTG, MAPSTA, FIELD, VGX, VGY ) !/ !/ +-----------------------------------+ @@ -828,6 +869,31 @@ SUBROUTINE W3XYP1 ( ISP, DTG, MAPSTA, FIELD, VGX, VGY ) !/ END SUBROUTINE W3XYP1 !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in spectral space. + !> + !> @param[inout] ISEA Number of sea points. + !> @param[inout] FACTH Factor in propagation velocity. + !> @param[inout] FACK Factor in propagation velocity. + !> @param[inout] CTHG0 Factor in great circle refracftion term. + !> @param[inout] CG Local group velocities. + !> @param[inout] WN Local wavenumbers. + !> @param[inout] DEPTH Depth. + !> @param[inout] DDDX Depth gradients. + !> @param[inout] DDDY Depth gradients. + !> @param[inout] CX Local group velocities. + !> @param[inout] CY Local group velocities. + !> @param[inout] DCXDX Current gradients. + !> @param[inout] DCXDY Current gradients. + !> @param[inout] DCYDX Current gradients. + !> @param[inout] DCYDY Current gradients. + !> @param[inout] DCDX Phase speed gradients. + !> @param[inout] DCDY Phase speed gradients. + !> @param[inout] VA Spectrum. + !> + !> @author H. L. Tolman + !> @date 20-Dec-2004 + !> SUBROUTINE W3KTP1 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DEPTH, & DDDX, DDDY, CX, CY, DCXDX, DCXDY, DCYDX, & DCYDY, DCDX, DCDY, VA ) diff --git a/model/src/w3pro2md.F90 b/model/src/w3pro2md.F90 index 4ae31f242a..a23f893efa 100644 --- a/model/src/w3pro2md.F90 +++ b/model/src/w3pro2md.F90 @@ -1,5 +1,26 @@ +!> @file +!> @brief Bundles routines for third order porpagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 29-May-2014 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / + +!> +!> @brief Bundles routines for third order porpagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 29-May-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PRO2MD !/ !/ +-----------------------------------+ @@ -105,6 +126,12 @@ MODULE W3PRO2MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the ULTIMATE QUICKEST scheme. + !> + !> @author H. L. Tolman + !> @date 09-Nov-2005 + !> SUBROUTINE W3MAP2 !/ !/ @@ -464,6 +491,20 @@ SUBROUTINE W3MAP2 !/ END SUBROUTINE W3MAP2 !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in physical space for a given spectral component. + !> + !> @param[in] ISP Number of spectral bin (IK-1)*NTH+ITH. + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[in] MAPFS Storage map. + !> @param[inout] VQ Field to propagate. + !> @param[in] VGX + !> @param[in] VGY + !> + !> @author H. L. Tolman + !> @date 29-May-2014 + !> SUBROUTINE W3XYP2 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) !/ !/ +-----------------------------------+ @@ -1219,6 +1260,45 @@ SUBROUTINE W3XYP2 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) END SUBROUTINE W3XYP2 !/ !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in spectral space. + !> + !> @details Third order QUICKEST scheme with ULTIMATE limiter. + !> + !> + !> As with the spatial propagation, the two spaces are considered + !> independently, but the propagation is performed in a 2-D space. + !> Compared to the propagation in physical space, the directions + !> represent a closed space and are therefore comparable to the + !> longitudinal or 'X' propagation. The wavenumber space has to be + !> extended to allow for boundary treatment. Using a simple first + !> order boundary treatment at both sided, two points need to + !> be added. This implies that the spectrum needs to be extended, + !> shifted and rotated, as is performed using MAPTH2 as set + !> in W3MAP3. + !> + !> @param[in] ISEA Number of sea point. + !> @param[in] FACTH Factor in propagation velocity. + !> @param[in] FACK Factor in propagation velocity. + !> @param[in] CTHG0 Factor in great circle refracftion term. + !> @param[in] CG Local group velocities. + !> @param[in] WN Local wavenumbers. + !> @param[in] DEPTH Depth. + !> @param[in] DDDX Depth gradient. + !> @param[in] DDDY Depth gradient. + !> @param[in] CX Current component. + !> @param[in] CY Current component. + !> @param[in] DCXDX Current gradients. + !> @param[in] DCXDY Current gradients. + !> @param[in] DCYDX Current gradients. + !> @param[in] DCYDY Current gradients. + !> @param[in] DCDX Phase speed gradient. + !> @param[in] DCDY Phase speed gradient. + !> @param[inout] VA Spectrum. + !> + !> @author H. L. Tolman + !> @date 01-Jul-2013 + !> SUBROUTINE W3KTP2 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DEPTH, & DDDX, DDDY, CX, CY, DCXDX, DCXDY, & DCYDX, DCYDY, DCDX, DCDY, VA ) diff --git a/model/src/w3pro3md.F90 b/model/src/w3pro3md.F90 index 157b9be099..96396a7a43 100644 --- a/model/src/w3pro3md.F90 +++ b/model/src/w3pro3md.F90 @@ -1,5 +1,25 @@ +!> @file +!> @brief Bundles routines for third order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 27-May-2014 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Bundles routines for third order propagation scheme in single +!> module. +!> +!> @author H. L. Tolman +!> @date 27-May-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3PRO3MD !/ !/ +-----------------------------------+ @@ -110,6 +130,12 @@ MODULE W3PRO3MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the ULTIMATE QUICKEST scheme. + !> + !> @author H. L. Tolman + !> @date 01-Apr-2008 + !> SUBROUTINE W3MAP3 !/ !/ +-----------------------------------+ @@ -488,6 +514,13 @@ SUBROUTINE W3MAP3 !/ END SUBROUTINE W3MAP3 !/ ------------------------------------------------------------------- / + !> + !> @brief Generate 'map' arrays for the ULTIMATE QUICKEST scheme to combine + !> GSE alleviation with obstructions. + !> + !> @author H. L. Tolman + !> @date 17-Dec-2004 + !> SUBROUTINE W3MAPT !/ !/ +-----------------------------------+ @@ -588,6 +621,20 @@ SUBROUTINE W3MAPT !/ END SUBROUTINE W3MAPT !/ ------------------------------------------------------------------- / + !> + !> @brief Propagation in phyiscal space for a given spectral component. + !> + !> @param[in] ISP Number of spectral bin (IK-1)*NTH+ITH. + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[in] MAPFS Storage map. + !> @param[inout] VQ Field to propagate. + !> @param[in] VGX Speed of grid. + !> @param[in] VGY Speed of grid. + !> + !> @author H. L. Tolman + !> @date 27-May-2014 + !> SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) !/ !/ +-----------------------------------+ @@ -1419,6 +1466,46 @@ SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) !/ END SUBROUTINE W3XYP3 !/ ------------------------------------------------------------------- / +!> +!> @brief Propagation in spectral space. +!> +!> @details Third order QUICKEST scheme with ULTIMATE limiter. +!> +!> As with the spatial propagation, the two spaces are considered +!> independently, but the propagation is performed in a 2-D space. +!> Compared to the propagation in physical space, the directions +!> represent a closed space and are therefore comparable to the +!> longitudinal or 'X' propagation. The wavenumber space has to be +!> extended to allow for boundary treatment. Using a simple first +!> order boundary treatment at both sided, two points need to +!> be added. This implies that the spectrum needs to be extended, +!> shifted and rotated, as is performed using MAPTH2 as set +!> in W3MAP3. +!> +!> @param[in] ISEA Number of sea point. +!> @param[in] FACTH Factor in propagation velocity. +!> @param[in] FACK Factor in propagation velocity. +!> @param[in] CTHG0 Factor in great circle refracftion term. +!> @param[in] CG Local group velocities. +!> @param[in] WN Local wavenumbers. +!> @param[in] DW Depth. +!> @param[in] DDDX Depth gradients. +!> @param[in] DDDY Depth gradients. +!> @param[in] CX Current components. +!> @param[in] CY Current components. +!> @param[in] DCXDX Current gradients. +!> @param[in] DCXDY Current gradients. +!> @param[in] DCYDX Current gradients. +!> @param[in] DCYDY Current gradients. +!> @param[in] DCDX Phase speed gradients. +!> @param[in] DCDY Phase speed gradients. +!> @param[inout] VA Spectrum. +!> @param[out] CFLTHMAX +!> @param[out] CFLKMAX +!> +!> @author H. L. Tolman +!> @date 01-Jul-2013 +!> SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & DDDX, DDDY, CX, CY, DCXDX, DCXDY, & DCYDX, DCYDY, DCDX, DCDY, VA, CFLTHMAX, CFLKMAX ) @@ -1863,6 +1950,23 @@ SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & !/ END SUBROUTINE W3KTP3 !/ ------------------------------------------------------------------- / + !> + !> @brief Computes the maximum CFL number for spatial advection. + !> + !> @details Used for diagnostic purposes (Could be used to define a + !> local time step ...). + !> + !> @param[in] ISEA Index of grid point. + !> @param[in] DTG Total time step. + !> @param[in] MAPSTA Grid point status map. + !> @param[in] MAPFS Storage map. + !> @param[inout] CFLXYMAX Maximum CFL number for XY propagation. + !> @param[in] VGX Speed of grid. + !> @param[in] VGY Speed of grid. + !> + !> @author F. Ardhuin + !> @date 31-Oct-2010 + !> SUBROUTINE W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX, VGX, VGY ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3ref1md.F90 b/model/src/w3ref1md.F90 index 795bdce207..df184faf17 100644 --- a/model/src/w3ref1md.F90 +++ b/model/src/w3ref1md.F90 @@ -1,4 +1,24 @@ +!> @file +!> @brief This module computes shoreline reflection, and +!> unresolved islands and iceberg reflections. +!> +!> @author F. Ardhuin +!> @date 27-Jun-2014 +!> + !/ ------------------------------------------------------------------- / +!> +!> @brief This module computes shoreline reflection, and +!> unresolved islands and iceberg reflections. +!> +!> @author F. Ardhuin +!> @date 27-Jun-2014 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3REF1MD !/ !/ +-----------------------------------+ @@ -64,6 +84,30 @@ MODULE W3REF1MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Computes coastal and iceberg/island reflections and adds free IG energy. + !> + !> @param[inout] A Action density spectrum (1-D). + !> @param[in] CG Group velocities. + !> @param[in] WN Wavenumbers. + !> @param[in] EMEAN + !> @param[in] FMEAN + !> @param[in] DEPTH Mean water depth. + !> @param[in] CX1 + !> @param[in] CY1 + !> @param[in] REFLC + !> @param[in] REFLD + !> @param[in] TRNX + !> @param[in] TRNY + !> @param[in] BERG + !> @param[in] DT + !> @param[in] IX + !> @param[in] IY + !> @param[out] S Source term (1-D version). + !> + !> @author F. Ardhuin + !> @date 11-Jun-2014 + !> SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & TRNX, TRNY, BERG, DT, IX, IY, JSEA, S) !/ @@ -104,7 +148,7 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & ! ! Parameter list ! ---------------------------------------------------------------- - ! A R.A. I Action density spectrum (1-D) + ! A R.A. I Action density spectrum (1-D) ! CG R.A. I Group velocities. ! WN R.A. I Wavenumbers. ! DEPTH Real I Mean water depth. diff --git a/model/src/w3sbt1md.F90 b/model/src/w3sbt1md.F90 index fdc675ff3d..bf17eafa18 100644 --- a/model/src/w3sbt1md.F90 +++ b/model/src/w3sbt1md.F90 @@ -1,5 +1,23 @@ +!> @file +!> @brief JONSWAP bottom friction routine. +!> +!> @author H. L. Tolman +!> @date 29-May-2009 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief JONSWAP bottom friction routine. +!> +!> @author H. L. Tolman +!> @date 29-May-2009 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT1MD !/ !/ +-----------------------------------+ @@ -42,6 +60,31 @@ MODULE W3SBT1MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Bottom friction source term according to the empirical JONSWAP + !> formulation. + !> + !> @verbatim + !> 2 GAMMA / CG \ SBTC1 / \ . + !> Sbt = ---------- | ------- - 0.5 | E = ----- | ... | E (1) + !> GRAV DEPTH \ SI/WN / DEPTH \ / + !> + !> Where GAMMA = -0.038 m2/s3 (JONSWAP) + !> = -0.067 m2/s3 (Bouws and Komen 1983) + !> + !> In the routine, the constant 2 GAMMA / GRAV = SBTC1. + !> @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[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> + !> @author H. L. Tolman + !> @date 29-May-2009 + !> SUBROUTINE W3SBT1 (A, CG, WN, DEPTH, S, D) !/ !/ +-----------------------------------+ diff --git a/model/src/w3sbt4md.F90 b/model/src/w3sbt4md.F90 index 3291930f1f..1d0e3a8d7a 100644 --- a/model/src/w3sbt4md.F90 +++ b/model/src/w3sbt4md.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief SHOWEX bottom friction source term (Ardhuin et al 2003). +!> +!> @author F. Ardhuin +!> @author J. Lepesqueur +!> @date 14-Mar-2012 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief SHOWEX bottom friction source term (Ardhuin et al. 2003). +!> +!> @details Using a subgrid depth parameterization based on Tolman (CE 1995). +!> +!> @author F. Ardhuin +!> @author J. Lepesqueur +!> @date 14-Mar-2012 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT4MD !/ !/ +-----------------------------------+ @@ -114,6 +136,12 @@ MODULE W3SBT4MD !/ ------------------------------------------------------------------- / + !> + !> @brief Initialization for bottom friction source term routine. + !> + !> @author F. Ardhuin + !> @date 14-Mar-2012 + !> SUBROUTINE INSBT4 !/ !/ +-----------------------------------+ @@ -202,6 +230,15 @@ SUBROUTINE INSBT4 !/ END SUBROUTINE INSBT4 ! ---------------------------------------------------------------------- + + !> + !> @brief Tabulation of ERF function, which is used in bottom friction subgrid modeling. + !> + !> @details Initialization for source term routine. + !> + !> @author J. Lepesqueur + !> @date 14-Mar-2012 + !> SUBROUTINE TABU_ERF !/ !/ +-----------------------------------+ @@ -276,6 +313,30 @@ END SUBROUTINE TABU_ERF !/ ------------------------------------------------------------------- / !/ ------------------------------------------------------------------- / + !> + !> @brief Computes the SHOWEX bottom friction with movable bed effects. + !> + !> @details Uses a Gaussian distribution for friction factors, and estimates + !> the contribution of rippled and non-rippled fractions based on the + !> bayesian approach of Tolman (1995). + !> + !> @param[in] A Action density spectrum. + !> @param[in] CG Group velocities. + !> @param[in] WN Wavenumbers. + !> @param[in] DEPTH Water depth. + !> @param[in] D50 Median grain size. + !> @param[in] PSIC Critical Shields parameter. + !> @param[out] TAUBBL Components of stress leaking to the bottom. + !> @param[inout] BEDFORM Ripple parameters (roughness and wavelength). + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative. + !> @param[in] IX Spatial grid index. + !> @param[in] IY Spatial grid index. + !> + !> @author F. Ardhuin + !> @author J. Lepesqueur + !> @date 15-Mar-2012 + !> SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) !/ !/ +-----------------------------------+ diff --git a/model/src/w3sbt8md.F90 b/model/src/w3sbt8md.F90 index f598c2fbe7..c56b57f0e1 100644 --- a/model/src/w3sbt8md.F90 +++ b/model/src/w3sbt8md.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief Contains routines for computing dissipation by viscous fluid mud using +!> Dalrymple and Liu (1978) "Thin Model". +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Contains routines for computing dissipation by viscous fluid mud using +!> Dalrymple and Liu (1978) "Thin Model". +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT8MD !/ !/ +-----------------------------------+ @@ -70,6 +92,22 @@ MODULE W3SBT8MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Compute dissipation by viscous fluid mud using Dalrymple and Liu (1978). + !> + !> @details "Thin Model" (adapted from Erick Rogers code by Mark Orzech, NRL). + !> + !> @param[in] AC Action density spectrum (1-D). + !> @param[in] H_WDEPTH Mean water depth. + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> @param[in] IX + !> @param[in] IY + !> + !> @author M. Orzech + !> @author W. E. Rogers + !> @date 21-Nov-2013 + !> SUBROUTINE W3SBT8(AC,H_WDEPTH,S,D,IX,IY) !/ !/ +-----------------------------------+ @@ -454,7 +492,15 @@ SUBROUTINE W3SBT8(AC,H_WDEPTH,S,D,IX,IY) END SUBROUTINE W3SBT8 !/ ------------------------------------------------------------------- / - + !> + !> @brief Complex hyperbolic sin (sinh). + !> + !> @param[in] C + !> @param[out] CS + !> + !> @author NA + !> @date NA + !> SUBROUTINE CSINH(C,CS) COMPLEX, INTENT(IN) :: C COMPLEX, INTENT(OUT) :: CS @@ -465,7 +511,15 @@ SUBROUTINE CSINH(C,CS) END SUBROUTINE CSINH !/ ------------------------------------------------------------------- / - + !> + !> @brief Complex hyperbolic cos (cosh). + !> + !> @param[in] C + !> @param[out] CC + !> + !> @author NA + !> @date NA + !> SUBROUTINE CCOSH(C,CC) COMPLEX, INTENT(IN) :: C COMPLEX, INTENT(OUT) :: CC diff --git a/model/src/w3sbt9md.F90 b/model/src/w3sbt9md.F90 index 217a549773..9ad6fd3454 100644 --- a/model/src/w3sbt9md.F90 +++ b/model/src/w3sbt9md.F90 @@ -1,5 +1,27 @@ +!> @file +!> @brief Contains routines for computing dissipation by viscous fluid mud using +!> Ng (2000). +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Contains routines for computing dissipation by viscous fluid +!> mud using Ng (2000). +!> +!> @author M. Orzech +!> @author W. E. Rogers +!> @date 21-Nov-2013 +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SBT9MD !/ !/ +-----------------------------------+ @@ -78,6 +100,21 @@ MODULE W3SBT9MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Compute dissipation by viscous fluid mud using Ng (2000) + !> (adapted from Erick Rogers code by Mark Orzech, NRL). + !> + !> @param[in] AC Action density. + !> @param[in] H_WDEPTH Mean water depth. + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> @param[in] IX + !> @param[in] IY + !> + !> @author M. Orzech + !> @author W. E. Rogers + !> @date 21-Nov-2013 + !> SUBROUTINE W3SBT9(AC,H_WDEPTH,S,D,IX,IY) !/ !/ +-----------------------------------+ @@ -369,6 +406,26 @@ SUBROUTINE W3SBT9(AC,H_WDEPTH,S,D,IX,IY) END SUBROUTINE W3SBT9 !/ ------------------------------------------------------------------- / + !> + !> @brief Compute dissipation by viscous fluid mud using Ng (2000). + !> + !> @details Adapted from Erick Rogers code by Mark Orzech, NRL. + !> + !> @param[in] SIGMA Radian frequency (rad). + !> @param[in] H_WDEPTH Water depth, denoted "h" in Ng (m). + !> @param[in] DTILDE Normalized mud depth. + !> @param[in] ZETA The ratio of stokes' boundary layer. + !> @param[in] SBLTM Sbltm is what you get if you calculate sblt using + !> the viscosity of the mud + !> @param[in] GAMMA The gamma used in Ng page 238, density(water)/density(mud). + !> @param[in] WK Unmuddy wavenumber. + !> @param[out] WKDR Muddy wavenumber. + !> @param[out] DISS Dissipation rate. + !> + !> @author E. Rogers + !> @author M. Orzech + !> @date 21-Nov-2013 + !> SUBROUTINE NG(SIGMA,H_WDEPTH,DTILDE,ZETA,SBLTM,GAMMA,WK,WKDR,DISS) !/ !/ +-----------------------------------+ @@ -500,6 +557,17 @@ SUBROUTINE NG(SIGMA,H_WDEPTH,DTILDE,ZETA,SBLTM,GAMMA,WK,WKDR,DISS) END SUBROUTINE NG !/ ------------------------------------------------------------------- / + !> + !> @brief NA + !> + !> @param[in] KWAVE + !> @param[in] H_WDEPTH + !> @param[in] SND2 + !> @param[out] ND + !> + !> @author NA + !> @date NA + !> SUBROUTINE CALC_ND(KWAVE,H_WDEPTH,SND2,ND) !/ ------------------------------------------------------------------- / diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index af3e65c7a8..c297e85221 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -1,5 +1,26 @@ +!> @file +!> @brief Dummy slot for bottom friction source term. +!> +!> @author J. H. Alves +!> @author H. L. Tolman +!> @date 29-May-2009 +!> + #include "w3macros.h" !/ ------------------------------------------------------------------- / +!> +!> @brief Dummy slot for bottom friction source term. +!> +!> @author J. H. Alves +!> @author H. L. Tolman +!> @date 29-May-2009 +!> +!> +!> @copyright Copyright 2009-2022 National Weather Service (NWS), +!> National Oceanic and Atmospheric Administration. All rights +!> reserved. WAVEWATCH III is a trademark of the NWS. +!> No unauthorized use without permission. +!> MODULE W3SDB1MD !/ !/ +-----------------------------------+ @@ -50,6 +71,28 @@ MODULE W3SDB1MD !/ CONTAINS !/ ------------------------------------------------------------------- / + !> + !> @brief Compute depth-induced breaking using Battjes and Janssen bore + !> model approach. + !> + !> @details Note that the Miche criterion can influence wave growth. + !> + !> @param[in] IX Local grid number + !> @param[in] A Action density spectrum (1-D). + !> @param[inout] DEPTH Mean water depth. + !> @param[inout] EMEAN Mean wave energy. + !> @param[inout] FMEAN Mean wave frequency. + !> @param[inout] WNMEAN Mean wave number. + !> @param[in] CG + !> @param[out] LBREAK + !> @param[out] S Source term (1-D version). + !> @param[out] D Diagonal term of derivative (1-D version). + !> + !> @author J. H. Alves + !> @author H. L. Tolman + !> @author A. Roland + !> @date 08-Jun-2018 + !> SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) !/ !/ +-----------------------------------+ From b810a89456b4befd7f225672dec216f46115aa9f Mon Sep 17 00:00:00 2001 From: Ghazal-Mohammadpour <124626872+Ghazal-Mohammadpour@users.noreply.github.com> Date: Fri, 11 Aug 2023 09:16:20 -0400 Subject: [PATCH 008/136] NC4 ,F90 ,XX0 switches removed from ww3_tp2.19 regtest (#1054) --- regtests/ww3_tp2.19/input_Case1A/switch_PDLIB | 2 +- regtests/ww3_tp2.19/input_Case1B/switch_PDLIB | 2 +- regtests/ww3_tp2.19/input_Case1C/switch_PDLIB | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB index 173947fdd1..0ffd8565f8 100644 --- a/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB +++ b/regtests/ww3_tp2.19/input_Case1A/switch_PDLIB @@ -1 +1 @@ -F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 + PDLIB METIS NOGRB DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB index 173947fdd1..0ffd8565f8 100644 --- a/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB +++ b/regtests/ww3_tp2.19/input_Case1B/switch_PDLIB @@ -1 +1 @@ -F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 + PDLIB METIS NOGRB DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB b/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB index ec5c352884..20fbedfede 100644 --- a/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB +++ b/regtests/ww3_tp2.19/input_Case1C/switch_PDLIB @@ -1 +1 @@ -F90 PDLIB METIS NOGRB NC4 DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 + PDLIB METIS NOGRB DIST MPI PR3 UQ FLX0 LN0 ST0 NL0 BT0 DB1 TR1 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 SEC1 O0 O1 O2 O3 O4 O5 O6 O7 From 991daf8bae2966e3527122f3d0a2cc0ae616ed0d Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Sat, 2 Sep 2023 13:07:44 -0400 Subject: [PATCH 009/136] CI: Fix for Intel scripts. GNU scripts updated. (#1064) --- .github/workflows/gnu.yml | 12 ++++++------ .github/workflows/intel.yml | 31 ++++++++++++++++--------------- model/ci/spack_gnu.yaml | 3 ++- model/ci/spack_intel.yaml | 11 ++++++----- 4 files changed, 30 insertions(+), 27 deletions(-) diff --git a/.github/workflows/gnu.yml b/.github/workflows/gnu.yml index d1aa0e967d..d28d1bb5b5 100644 --- a/.github/workflows/gnu.yml +++ b/.github/workflows/gnu.yml @@ -7,7 +7,7 @@ concurrency: cancel-in-progress: true env: - cache_key: gnu8 + cache_key: gnu11 CC: gcc-10 FC: gfortran-10 CXX: g++-10 @@ -24,14 +24,14 @@ jobs: steps: - name: checkout-ww3 if: steps.cache-env.outputs.cache-hit != 'true' - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: path: ww3 # Cache spack, OASIS, and compiler # No way to flush Action cache, so key may have # appended - name: cache-env id: cache-env - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: | spack @@ -45,7 +45,7 @@ jobs: run: | # Install NetCDF, ESMF, g2, etc using Spack sudo apt install cmake - git clone -c feature.manyFiles=true https://github.com/spack/spack.git + git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git source spack/share/spack/setup-env.sh spack env create ww3-gnu ww3/model/ci/spack_gnu.yaml spack env activate ww3-gnu @@ -77,13 +77,13 @@ jobs: steps: - name: checkout-ww3 - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: path: ww3 - name: cache-env id: cache-env - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: | spack diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index c40f3265e9..700553ceac 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -8,7 +8,7 @@ concurrency: # Set I_MPI_CC/F90 so Intel MPI wrapper uses icc/ifort instead of gcc/gfortran env: - cache_key: intel7 + cache_key: intel10 CC: icc FC: ifort CXX: icpc @@ -16,18 +16,18 @@ env: I_MPI_F90: ifort # Split into a dependency build step, and a WW3 build step which -# builds multiple switches in a matrix. The setup is run once and +# builds multiple switches in a matrix. The setup is run once and # the environment is cached so each build of WW3 can share the dependencies. jobs: setup: - runs-on: ubuntu-20.04 + runs-on: ubuntu-20.04 steps: - name: checkout-ww3 if: steps.cache-env.outputs.cache-hit != 'true' - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: path: ww3 @@ -35,7 +35,7 @@ jobs: # No way to flush Action cache, so key may have # appended - name: cache-env id: cache-env - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: | spack @@ -51,7 +51,7 @@ jobs: sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update - sudo apt-get install intel-oneapi-mpi-devel intel-oneapi-openmp intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic + sudo apt-get install intel-oneapi-dev-utilities intel-oneapi-mpi-devel intel-oneapi-openmp intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic # Build WW3 spack environment - name: install-dependencies-with-spack @@ -59,18 +59,19 @@ jobs: run: | # Install NetCDF, ESMF, g2, etc using Spack . /opt/intel/oneapi/setvars.sh - sudo mv /usr/local /usrlocal_renamed - sudo apt install cmake - git clone -c feature.manyFiles=true https://github.com/spack/spack.git + git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git source spack/share/spack/setup-env.sh ln -s $(realpath $(which gcc)) spack/lib/spack/env/intel/gcc # spack/make bug in ESMF spack env create ww3-intel ww3/model/ci/spack_intel.yaml spack env activate ww3-intel spack compiler find - spack external find cmake + sudo apt install cmake + spack external find spack add intel-oneapi-mpi + spack config add "packages:all:require:['%intel']" spack concretize spack install --dirty -v --fail-fast + spack clean --all - name: build-oasis if: steps.cache-env.outputs.cache-hit != 'true' @@ -91,17 +92,17 @@ jobs: strategy: matrix: switch: [Ifremer1, NCEP_st2, NCEP_st4, ite_pdlib, NCEP_st4sbs, NCEP_glwu, OASACM, UKMO, MULTI_ESMF] - runs-on: ubuntu-20.04 + runs-on: ubuntu-20.04 steps: - name: checkout-ww3 - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: path: ww3 - name: cache-env id: cache-env - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: | spack @@ -116,8 +117,8 @@ jobs: source spack/share/spack/setup-env.sh spack env activate ww3-intel cd ww3 - export CC=mpicc - export FC=mpif90 + export CC=mpiicc + export FC=mpiifort export OASISDIR=${GITHUB_WORKSPACE}/work_oasis3-mct mkdir build && cd build if [[ ${{ matrix.switch }} == "MULTI_ESMF" ]]; then diff --git a/model/ci/spack_gnu.yaml b/model/ci/spack_gnu.yaml index 5f1ca3a476..d2c16711aa 100644 --- a/model/ci/spack_gnu.yaml +++ b/model/ci/spack_gnu.yaml @@ -13,7 +13,8 @@ spack: - g2@3.4.5 - bacio@2.4.1 - w3emc@2.9.2 - - esmf@8.1.1~pio~pnetcdf~xerces + - parallelio@2.5.9+fortran~pnetcdf + - esmf@8.4.2~debug~xerces+external-parallelio view: true concretizer: unify: when_possible diff --git a/model/ci/spack_intel.yaml b/model/ci/spack_intel.yaml index ee09d8827b..c571da825d 100644 --- a/model/ci/spack_intel.yaml +++ b/model/ci/spack_intel.yaml @@ -5,16 +5,17 @@ spack: providers: mpi: [intel-oneapi-mpi] specs: + - netcdf-c@4.7.4~dap + - netcdf-fortran@4.5.3 + - bacio@2.4.1 + - g2@3.4.5 - metis@5.1.0~shared - parmetis@4.0.3~shared - scotch@7.0.1+mpi+metis~shared - - netcdf-c@4.7.4~dap - - netcdf-fortran@4.5.3 - jasper@2.0.32 - - g2@3.4.5 - - bacio@2.4.1 - w3emc@2.9.2 - - esmf@8.1.1~pio~pnetcdf~xerces + - parallelio@2.5.9+fortran~pnetcdf + - esmf@8.4.2~debug~xerces+external-parallelio - intel-oneapi-mpi %intel view: true concretizer: From 6b9edfa746704ac51d94ca7a58a50fb347611a08 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 14 Sep 2023 14:56:08 +0200 Subject: [PATCH 010/136] correct the computation of QP parameter, add QKK output parameter, change UST scale factor (#1050) --- manual/eqs/output.tex | 15 +++++-- manual/manual.bib | 10 +++++ model/inp/ww3_shel.inp | 9 ++-- model/nml/ww3_multi.nml | 4 +- model/nml/ww3_shel.nml | 9 ++-- model/src/w3adatmd.F90 | 19 ++++++-- model/src/w3initmd.F90 | 52 +++++++++++++++++----- model/src/w3iogomd.F90 | 37 +++++++++++---- model/src/w3iorsmd.F90 | 6 +-- model/src/w3odatmd.F90 | 3 +- model/src/w3ounfmetamd.F90 | 15 ++++++- model/src/ww3_ounf.F90 | 7 ++- model/src/ww3_outf.F90 | 15 ++++++- model/tools/bash/ww3_multi_inp2nml.sh | 4 +- model/tools/bash/ww3_shel_inp2nml.sh | 13 +++--- regtests/ww3_tp2.15/input_rho/ww3_ounf.inp | 2 +- regtests/ww3_tp2.15/input_rho/ww3_ounf.nml | 2 +- regtests/ww3_tp2.15/input_rho/ww3_outf.inp | 2 +- regtests/ww3_tp2.15/input_rho/ww3_shel.inp | 2 +- regtests/ww3_tp2.15/input_rho/ww3_shel.nml | 2 +- regtests/ww3_tp2.6/input/ww3_ounf.inp | 2 +- regtests/ww3_tp2.6/input/ww3_ounf.nml | 2 +- regtests/ww3_tp2.6/input/ww3_outf.inp | 2 +- regtests/ww3_tp2.6/input/ww3_shel.inp | 2 +- regtests/ww3_tp2.6/input/ww3_shel.nml | 2 +- 25 files changed, 173 insertions(+), 65 deletions(-) diff --git a/manual/eqs/output.tex b/manual/eqs/output.tex index 1f512b16ab..bfa7e0b5a3 100644 --- a/manual/eqs/output.tex +++ b/manual/eqs/output.tex @@ -12,9 +12,9 @@ \subsection{~Output parameters} \label{sub:outpars} in \para\ref{sec:ww3shel}. That input file also provides a list of flags indicating if output parameters are available in different field output file types (ASCII, grib, igrads, NetCDF). -For any details on how these parameters are computed, the user may read the code of the {\code w3iogo} routine, in the {\code w3iogomd.ftn} module. +For any details on how these parameters are computed, the user may read the code of the {\code w3iogo} routine, in the {\code w3iogomd.F90} module. -Selection of field outputs in {\code ww3\_shel.inp} is most easily performed by providing a list of the +Selection of field outputs in {\code ww3\_shel.nml} or {\code ww3\_shel.inp} is most easily performed by providing a list of the requested parameters, for example, {\textbf HS DIR SPR} will request the calculation of significant wave height, mean direction and directional spread. These will thus be stored in the {\code out\_grd.XX} file and can be post-processed, for example in NetCDF using {\code ww3\_ouf}. Examples are given in \para\ref{sec:ww3multi} and \para\ref{sec:ww3ounf}. The names for these namelists are the bold names below, for example \textbf{HS}. @@ -26,6 +26,9 @@ \subsection{~Output parameters} \label{sub:outpars} file extensions, NetCDF variable names and namelist-based selection (see also \para\ref{sec:ww3ounf}), and the long parameter name/definition. +When the result is not overly sensitive to the contribution of the unresolved part of the spectrum (for $f WADATS(IMOD)%MSCX MSCY => WADATS(IMOD)%MSCY MSCD => WADATS(IMOD)%MSCD + QKK => WADATS(IMOD)%QKK ! DTDYN => WADATS(IMOD)%DTDYN FCUT => WADATS(IMOD)%FCUT @@ -3231,6 +3241,7 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) MSCX => WADATS(IMOD)%XMSCX MSCY => WADATS(IMOD)%XMSCY MSCD => WADATS(IMOD)%XMSCD + QKK => WADATS(IMOD)%XQKK ! DTDYN => WADATS(IMOD)%XDTDYN FCUT => WADATS(IMOD)%XFCUT diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 3c6907f519..2d5eacc339 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -639,23 +639,23 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, IF (FSTOTALIMP .and. .NOT. LPDLIB) THEN WRITE(NDSE,*) 'IMPTOTAL is selected' WRITE(NDSE,*) 'But PDLIB is not' - CALL FLUSH(NDSE) - STOP + CALL FLUSH(NDSE) + STOP ELSE IF (FSTOTALEXP .and. .NOT. LPDLIB) THEN WRITE(NDSE,*) 'EXPTOTAL is selected' WRITE(NDSE,*) 'But PDLIB is not' - CALL FLUSH(NDSE) - STOP + CALL FLUSH(NDSE) + STOP END IF #ifdef W3_PDLIB IF (B_JGS_BLOCK_GAUSS_SEIDEL .AND. .NOT. B_JGS_USE_JACOBI) THEN WRITE(NDSE,*) 'B_JGS_BLOCK_GAUSS_SEIDEL is used but the Jacobi solver is not choosen' WRITE(NDSE,*) 'Please set JGS_USE_JACOBI .eqv. .true.' - CALL FLUSH(NDSE) - STOP + CALL FLUSH(NDSE) + STOP ENDIF #endif - + ! ! 1.c Open files without unpacking MDS ,,, ! @@ -1303,10 +1303,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, END DO !Li END DO #ifdef W3_DEBUGSTP - WRITE(740+IAPROC,*) 'w3initmd 1: max/min(WLVeff)=', max_val, min_val - FLUSH(740+IAPROC) - max_val = 0 - min_val = 0 + WRITE(740+IAPROC,*) 'w3initmd 1: max/min(WLVeff)=', max_val, min_val + FLUSH(740+IAPROC) + max_val = 0 + min_val = 0 #endif DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) @@ -2147,7 +2147,7 @@ SUBROUTINE W3MPIO ( IMOD ) STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, & HCMAXD, QP, PTHP0, PQP, PPE, PGW, PSW, & PTM1, PT1, PT2, PEP, WBT, CX, CY, & - TAUOCX, TAUOCY, WNMEAN + TAUOCX, TAUOCY, WNMEAN, QKK #endif #ifdef W3_MPI @@ -3394,6 +3394,20 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI END IF ! + IF ( FLGRDALL( 8, 6) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_SEND_INIT (QKK (1),NSEALM , MPI_REAL, IROOT, & + IT, MPI_COMM_WAVE, IRQGO(IH), IERR) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/06', IROOT, IT, IRQGO(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 IT = IT + 1 @@ -4627,6 +4641,20 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI END IF ! + IF ( FLGRDALL( 8, 6) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (QKK (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/06', IFROM, IT, IRQGO2(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 IT = IT + 1 diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 451192d53e..a6ef03325e 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1123,6 +1123,9 @@ SUBROUTINE W3FLDTOIJ(FLD, I, J, IAPROC, NAPOUT, NDSEN) CASE('QP') I = 8 J = 5 + CASE('QKK') + I = 8 + J = 6 ! ! Group 9 ! @@ -1294,7 +1297,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TH2M, STH2M, HSIG, STMAXE, STMAXD, & HCMAXE, HMAXE, HCMAXD, HMAXD, USSP, QP, PQP,& PTHP0, PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & - WBT + WBT, QKK USE W3ODATMD, ONLY: NDST, UNDEF, IAPROC, NAPROC, NAPFLD, & ICPRT, DTPRT, WSCUT, NOSWLL, FLOGRD, FLOGR2,& NOGRP, NGRPP @@ -1353,7 +1356,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) STMAXDL(NSEAL), TLPHI(NSEAL), & WL02X(NSEAL), WL02Y(NSEAL), & ALPXT(NSEAL), ALPYT(NSEAL), & - ALPXY(NSEAL), SCREST(NSEAL) + ALPXY(NSEAL), SCREST(NSEAL), & + QK1(NSEAL), QK2(NSEAL) REAL USSCO, FT1 REAL, SAVE :: HSMIN = 0.01 LOGICAL :: FLOLOC(NOGRP,NGRPP) @@ -1429,6 +1433,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TLPHI = 0. STMAXEL = 0. STMAXDL = 0. + QK2 = 0. ! HS = UNDEF WLM = UNDEF @@ -1445,6 +1450,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ALPXY = UNDEF ALPXT = UNDEF ALPYT = UNDEF + QKK = UNDEF THMP = UNDEF T02P = UNDEF SCREST = UNDEF @@ -1481,6 +1487,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ABXY = 0. ABYX = 0. ABST = 0. + QK1 = 0. ! ! 2.b Integrate energy in band ! @@ -1506,6 +1513,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) IF (ITH.LE.NTH/2) THEN ABST(JSEA) = ABST(JSEA) + & A(ITH,IK,JSEA)*A(ITH+NTH/2,IK,JSEA) + QK1 (JSEA) = QK1(JSEA) + (A(ITH,IK,JSEA)+A(ITH+NTH/2,IK,JSEA))**2 END IF CALL INIT_GET_ISEA(ISEA, JSEA) FACTOR = MAX ( 0.5 , CG(IK,ISEA)/SIG(IK)*WN(IK,ISEA) ) @@ -1532,8 +1540,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) FACTOR = DDEN(IK) / CG(IK,ISEA) - EBD(IK,JSEA) = AB(JSEA) * FACTOR - ET(JSEA) = ET(JSEA) + EBD(IK,JSEA) + EBD(IK,JSEA) = AB(JSEA) * FACTOR ! this is E(f)*df + ET (JSEA) = ET (JSEA) + EBD(IK,JSEA) #ifdef W3_IG1 IF (IK.EQ.NINT(IGPARS(5))) HSIG(JSEA) = 4*SQRT(ET(JSEA)) #endif @@ -1541,7 +1549,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) EWN(JSEA) = EWN(JSEA) + EBD(IK,JSEA) / WN(IK,ISEA) ETR(JSEA) = ETR(JSEA) + EBD(IK,JSEA) / SIG(IK) ET1(JSEA) = ET1(JSEA) + EBD(IK,JSEA) * SIG(IK) - EET1(JSEA) = EET1(JSEA)+ EBD(IK,JSEA)**2 * SIG(IK) + ! EET1(JSEA) = EET1(JSEA)+ EBD(IK,JSEA)**2 * SIG(IK) + EET1(JSEA) = EET1(JSEA)+ EBD(IK,JSEA)**2 * SIG(IK)/DSII(IK) ET02(JSEA) = ET02(JSEA)+ EBD(IK,JSEA) * SIG(IK)**2 ETX(JSEA) = ETX(JSEA) + ABX(JSEA) * FACTOR ETY(JSEA) = ETY(JSEA) + ABY(JSEA) * FACTOR @@ -1550,6 +1559,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TUSY(JSEA) = TUSY(JSEA) + ABY(JSEA)*FACTOR & *GRAV*WN(IK,ISEA)/SIG(IK) ETXX(JSEA) = ETXX(JSEA) + ABX2(JSEA) * FACTOR* WN(IK,ISEA)**2 + ! NB: QK1 (JSEA) = QK1(JSEA) + A(ITH,IK,JSEA)**2 + QK2 (JSEA) = QK2 (JSEA) + QK1(JSEA) * FACTOR* SIG(IK) /WN(IK,ISEA) ETYY(JSEA) = ETYY(JSEA) + ABY2(JSEA) * FACTOR* WN(IK,ISEA)**2 ETXY(JSEA) = ETXY(JSEA) + ABYX(JSEA) * FACTOR* WN(IK,ISEA)**2 IF (SIG(IK)*0.5*(1+XFR).LT.0.4*TPI) THEN @@ -1932,13 +1943,13 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ! 3.b Add tail ! ( DTH * SIG absorbed in FTxx ) - EBAND = AB(JSEA) / CG(NK,ISEA) + EBAND = AB(JSEA) / CG(NK,ISEA) ! EBAND is E(sigma)/sigma for the last frequency band ET (JSEA) = ET (JSEA) + FTE * EBAND EWN(JSEA) = EWN(JSEA) + FTWL * EBAND ETF(JSEA) = ETF(JSEA) + GRAV * FTTR * EBAND ! this is the integral of CgE in deep water ETR(JSEA) = ETR(JSEA) + FTTR * EBAND ET1(JSEA) = ET1(JSEA) + FT1 * EBAND - EET1(JSEA)= ET1(JSEA) + FT1 * EBAND**2 + ! EET1(JSEA)= EET1(JSEA) + FT1 * EBAND**2 : this was not correct. Actually tail may not be needed for Qp. ET02(JSEA)= ET02(JSEA)+ EBAND* 0.5 * SIG(NK)**4 * DTH ETX(JSEA) = ETX(JSEA) + FTE * ABX(JSEA) / CG(NK,ISEA) ETY(JSEA) = ETY(JSEA) + FTE * ABY(JSEA) / CG(NK,ISEA) @@ -1980,12 +1991,15 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) END IF #endif IF ( ET(JSEA) .GT. 1.E-7 ) THEN - QP(JSEA) = ( 2. / ET(JSEA)**2 ) * EET1(JSEA) * TPIINV**2 + QP(JSEA) = ( 2. / ET(JSEA)**2 ) * EET1(JSEA) WLM(JSEA) = EWN(JSEA) / ET(JSEA) * TPI T0M1(JSEA) = ETR(JSEA) / ET(JSEA) * TPI THS(JSEA) = RADE * SQRT ( MAX ( 0. , 2. * ( 1. - SQRT ( & MAX(0.,(ETX(JSEA)**2+ETY(JSEA)**2)/ET(JSEA)**2) ) ) ) ) IF ( THS(JSEA) .LT. 0.01*RADE*DTH ) THS(JSEA) = 0. + ! NB: QK1 (JSEA) = QK1(JSEA) + A(ITH,IK,JSEA)**2 + ! QK2 (JSEA) = QK2 (JSEA) + QK1(JSEA) * FACTOR* SIG(IK) /WN(IK,ISEA) + QKK (JSEA) = SQRT(0.5*QK2 (JSEA))/ET(JSEA) ELSE WLM(JSEA) = 0. T0M1(JSEA) = TPI / SIG(NK) @@ -2495,7 +2509,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) CFLXYMAX, CFLTHMAX, CFLKMAX, P2SMS, US3D, & TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, TAUICE,& STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& - USSP, TAUOCX, TAUOCY + USSP, TAUOCX, TAUOCY, QKK !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & @@ -2871,6 +2885,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) IF ( FLOGRD( 8, 3) ) MSSD (ISEA) = UNDEF IF ( FLOGRD( 8, 4) ) MSCD (ISEA) = UNDEF IF ( FLOGRD( 8, 5) ) QP (ISEA) = UNDEF + IF ( FLOGRD( 8, 6) ) QKK (ISEA) = UNDEF ! IF ( FLOGRD( 9, 1) ) DTDYN (ISEA) = UNDEF IF ( FLOGRD( 9, 2) ) FCUT (ISEA) = UNDEF @@ -3225,6 +3240,8 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) WRITE ( NDSOG ) MSCD(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) QP(1:NSEA) + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + WRITE ( NDSOG ) QKK(1:NSEA) ! ! Section 9) ! @@ -3557,6 +3574,8 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) MSCD(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QP(1:NSEA) + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QKK(1:NSEA) ! ! Section 9) ! diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 3bd2aa4ea7..05f7e91633 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -628,7 +628,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! Original non-server version writing of spectra ! IF ( .NOT.IOSFLG .OR. (NAPROC.EQ.1.AND.NAPRST.EQ.1) ) THEN -#ifdef W3_MPI +#ifdef W3_MPI DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 @@ -637,7 +637,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF END DO -#else +#else DO JSEA=1, NSEA ISEA = JSEA NREC = ISEA + 2 @@ -646,7 +646,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF END DO -#endif +#endif ! ! I/O server version writing of spectra ( !/MPI ) ! diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 408f36fe69..4fc29eab96 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -887,13 +887,14 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) ! ! 8) Spectrum parameters ! - NOGE(8) = 5 + NOGE(8) = 6 ! IDOUT( 8, 1) = 'Mean square slopes ' IDOUT( 8, 2) = 'Phillips tail const' IDOUT( 8, 3) = 'Slope direction ' IDOUT( 8, 4) = 'Tail slope direction' IDOUT( 8, 5) = 'Goda peakedness parm' + IDOUT( 8, 6) = 'kxky-peakdness ' ! IDOUT( 8, 3) = 'Lx-Ly mean wvlength' ! IDOUT( 8, 4) = 'Surf grad correl XT' ! IDOUT( 8, 5) = 'Surf grad correl YT' diff --git a/model/src/w3ounfmetamd.F90 b/model/src/w3ounfmetamd.F90 index 44704c375e..a4a58d079f 100644 --- a/model/src/w3ounfmetamd.F90 +++ b/model/src/w3ounfmetamd.F90 @@ -3291,7 +3291,7 @@ SUBROUTINE DEFAULT_META() ! IFI=5, IFJ=1, UST META => GROUP(5)%FIELD(1)%META ! First component - META(1)%FSC = 0.01 + META(1)%FSC = 0.001 META(1)%ENAME = '.ust' META(1)%UNITS = 'm s-1' META(1)%VARNM='uust' @@ -3956,6 +3956,19 @@ SUBROUTINE DEFAULT_META() META(1)%VARNC='Goda wave peakedness parameter' META(1)%VMIN = 0 META(1)%VMAX = 32 + ! IFI=8, IFJ=6, QKK + META => GROUP(8)%FIELD(6)%META + META(1)%FSC = 0.05 + META(1)%UNITS = 'm/rad' + META(1)%ENAME = '.qkk' + META(1)%VARNM='qkk' + META(1)%VARNL='k-peakedness' + !META(1)%VARNS='sea_surface_wave_peakedness' + META(1)%VARNS='' + META(1)%VARNG='wavenumber_peakedness' + META(1)%VARNC='2D wavenumber peakedness' + META(1)%VMIN = 0 + META(1)%VMAX = 1600 ! !---------- GROUP 9 ---------------- ! diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index b77f9a9f96..22ffd72dcd 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -65,6 +65,7 @@ PROGRAM W3OUNF !/ 02-Feb-2021 : Make default global meta optional ( version 7.12 ) !/ 22-Mar-2021 : New coupling fields output ( version 7.12 ) !/ 02-Sep-2021 : Added coordinates attribute ( version 7.12 ) + !/ 14-Feb-2023 : Added QKK output ( version 7.12 ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -192,7 +193,7 @@ PROGRAM W3OUNF CFLTHMAX, CFLXYMAX, CFLKMAX, TAUICE, PHICE, & STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& P2SMS, EF, US3D, TH1M, STH1M, TH2M, STH2M, & - WN, USSP, WBT, WNMEAN + WN, USSP, WBT, WNMEAN, QKK USE W3ODATMD, ONLY: NDSO, NDSE, SCREEN, NOGRP, NGRPP, IDOUT, & UNDEF, FLOGRD, FNMPRE, NOSWLL, NOGE ! @@ -1958,6 +1959,10 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN CALL S2GRID(QP, X1) ! + ! k bandwidth + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + CALL S2GRID(QKK, X1) + ! ! Dynamic time step ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN DO ISEA=1, NSEA diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index c055c92094..96f2751c81 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -159,7 +159,7 @@ PROGRAM W3OUTF ABA, ABD, UBA, UBD, SXX, SYY, SXY, USERO, & PHS, PTP, PLP, PDIR, PSI, PWS, PWST, PNR, & PTM1, PT1, PT2, PEP, TAUOCX, TAUOCY, & - PTHP0, PQP, PSW, PPE, PGW, QP, & + PTHP0, PQP, PSW, PPE, PGW, QP, QKK, & TAUOX, TAUOY, TAUWIX,BHD, & TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & @@ -2196,7 +2196,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN FLONE = .TRUE. - FSC = 0.01 + FSC = 0.001 UNITS = '1' ENAME = '.qp' IF ( ITYPE .EQ. 4 ) THEN @@ -2205,6 +2205,17 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, QP, MAPSF, X1 ) ENDIF ! + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + FLONE = .TRUE. + FSC = 0.05 + UNITS = '1' + ENAME = '.qkk' + IF ( ITYPE .EQ. 4 ) THEN + XS1 = QKK + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, QKK, MAPSF, X1 ) + ENDIF + ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. FSC = 0.1 diff --git a/model/tools/bash/ww3_multi_inp2nml.sh b/model/tools/bash/ww3_multi_inp2nml.sh index aa9afd4972..c616282d34 100755 --- a/model/tools/bash/ww3_multi_inp2nml.sh +++ b/model/tools/bash/ww3_multi_inp2nml.sh @@ -705,13 +705,13 @@ cat >> $nmlfile << EOF ! ! * the detailed list of field names is given in model/nml/ww3_shel.nml : ! DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 -! HS LM T02 T0M1 T01 FP DIR SPR DP HIG +! HS LM T02 T0M1 T01 FP DIR SPR DP HIG MXE MXES MXH MXHC SDMH SDMHC WBT TP WNM ! EF TH1M STH1M TH2M STH2M WN ! PHS PTP PLP PDIR PSPR PWS PDP PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR ! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS ! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC USP TOC ! ABR UBR BED FBB TBB -! MSS MSC WL02 AXT AYT AXY +! MSS MSC MSD MCD QP QKK ! DTD FC CFX CFD CFK ! U1 U2 ! diff --git a/model/tools/bash/ww3_shel_inp2nml.sh b/model/tools/bash/ww3_shel_inp2nml.sh index 7798abf206..619002aa87 100755 --- a/model/tools/bash/ww3_shel_inp2nml.sh +++ b/model/tools/bash/ww3_shel_inp2nml.sh @@ -878,7 +878,7 @@ cat >> $nmlfile << EOF ! T T 2 1 HS HS Wave height. ! T T 2 2 WLM LM Mean wave length. ! T T 2 3 T02 T02 Mean wave period (Tm0,2). -! T T 2 4 TM10 TM10 Mean wave period (Tm-1,0). +! T T 2 4 TM10 T0M1 Mean wave period (Tm-1,0). ! T T 2 5 T01 T01 Mean wave period (Tm0,1). ! T T 2 6 FP0 FP Peak frequency. ! T T 2 7 THM DIR Mean wave direction. @@ -893,6 +893,7 @@ cat >> $nmlfile << EOF ! T T 2 16 HCMAXD SDMHC St Dev of MXHC (STE) ! F T 2 17 WBT WBT Domiant wave breaking probability bT ! F F 2 18 FP0 TP Peak period (from peak freq) +! F F 2 19 WNMEAN WNM Mean wavenumber ! ------------------------------------------------- ! 3 Spectral Parameters (first 5) ! ------------------------------------------------- @@ -912,7 +913,7 @@ cat >> $nmlfile << EOF ! T T 4 5 PSI PSPR Partitioned mean directional spread. ! T T 4 6 PWS PWS Partitioned wind sea fraction. ! T T 4 7 PTHP0 PDP Peak wave direction of partition. -! T T 4 8 PQP PQP Goda peakdedness parameter of partition. +! T T 4 8 PQP PQP Goda peakedness parameter of partition. ! T T 4 9 PPE PPE JONSWAP peak enhancement factor of partition. ! T T 4 10 PGW PGW Gaussian frequency width of partition. ! T T 4 11 PSW PSW Spectral width of partition. @@ -965,10 +966,10 @@ cat >> $nmlfile << EOF ! ------------------------------------------------- ! F F 8 1 MSS[X,Y] MSS Mean square slopes ! F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail -! F F 8 3 WL02[X,Y] WL02 East/X North/Y mean wavelength compon -! F F 8 4 ALPXT AXT Correl sea surface gradients (x,t) -! F F 8 5 ALPYT AYT Correl sea surface gradients (y,t) -! F F 8 6 ALPXY AXY Correl sea surface gradients (x,y) +! F F 8 3 MSSD MSD Slope direction +! F F 8 4 MSCD MCD Tail slope direction +! F F 8 5 QP QP Goda peakedness parameter +! F F 8 6 QKK QKK Wavenumber peakedness ! ------------------------------------------------- ! 9 Numerical diagnostics ! ------------------------------------------------- diff --git a/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp b/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp index 9e9b2c300d..564610663d 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp +++ b/regtests/ww3_tp2.15/input_rho/ww3_ounf.inp @@ -3,7 +3,7 @@ $ ----------------------------------------- 20140309 000000 900. 9999 $ N -HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC +HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK $ $ 3 4 diff --git a/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml b/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml index 848d2ec924..d4e8c91515 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml +++ b/regtests/ww3_tp2.15/input_rho/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '20140309 000000' FIELD%TIMESTRIDE = '900.' FIELD%TIMECOUNT = '9999' - FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC' + FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 / diff --git a/regtests/ww3_tp2.15/input_rho/ww3_outf.inp b/regtests/ww3_tp2.15/input_rho/ww3_outf.inp index 666f36966f..05e04c291b 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_outf.inp +++ b/regtests/ww3_tp2.15/input_rho/ww3_outf.inp @@ -3,7 +3,7 @@ $ ----------------------------------------- 20140309 000000 3600. 37 $ N -HS DIR DP T02 FP STMAXE STMAXD HMAXE HCMAXE HMAXD HCMAXD +HS DIR DP T02 FP STMAXE STMAXD HMAXE HCMAXE HMAXD HCMAXD QP QKK $ 3 0 1 43 1 42 1 1 diff --git a/regtests/ww3_tp2.15/input_rho/ww3_shel.inp b/regtests/ww3_tp2.15/input_rho/ww3_shel.inp index c436305e80..ce4d900113 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_shel.inp +++ b/regtests/ww3_tp2.15/input_rho/ww3_shel.inp @@ -31,7 +31,7 @@ $ A A W C C C C B B E B B X W O U S S S 2 S S $ W W A C F H M R R D B B Y O C S S S C S 1 2 $ --------------------------------------------------------------- N - HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC + HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK 20140310 000000 3600 20140310 060000 12.5088 45.3138 'AA ' 0.0 0.0 'STOPSTRING' diff --git a/regtests/ww3_tp2.15/input_rho/ww3_shel.nml b/regtests/ww3_tp2.15/input_rho/ww3_shel.nml index 5fb0fd0a28..fc0277a123 100644 --- a/regtests/ww3_tp2.15/input_rho/ww3_shel.nml +++ b/regtests/ww3_tp2.15/input_rho/ww3_shel.nml @@ -24,7 +24,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC' + TYPE%FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK' TYPE%POINT%FILE = '../input_rho/points.list' / diff --git a/regtests/ww3_tp2.6/input/ww3_ounf.inp b/regtests/ww3_tp2.6/input/ww3_ounf.inp index c4d51a66c7..d2bde30b6a 100644 --- a/regtests/ww3_tp2.6/input/ww3_ounf.inp +++ b/regtests/ww3_tp2.6/input/ww3_ounf.inp @@ -13,7 +13,7 @@ $ file for a full documentation of field output options. Namelist type $ selection is used here (for alternative F/T flags, see ww3_shel.inp). $ N - HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD + HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK $ $--------------------------------------------------------------------- $ $ netCDF version [3,4] diff --git a/regtests/ww3_tp2.6/input/ww3_ounf.nml b/regtests/ww3_tp2.6/input/ww3_ounf.nml index 658dd2525a..7b344cc1cf 100644 --- a/regtests/ww3_tp2.6/input/ww3_ounf.nml +++ b/regtests/ww3_tp2.6/input/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '20100801 000000' FIELD%TIMESTRIDE = '10' FIELD%TIMECOUNT = '3600' - FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD' + FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK' FIELD%PARTITION = '0 1 2' FIELD%SAMEFILE = F FIELD%TYPE = 4 diff --git a/regtests/ww3_tp2.6/input/ww3_outf.inp b/regtests/ww3_tp2.6/input/ww3_outf.inp index 70dc9974c5..86c1115ff9 100644 --- a/regtests/ww3_tp2.6/input/ww3_outf.inp +++ b/regtests/ww3_tp2.6/input/ww3_outf.inp @@ -7,7 +7,7 @@ $ $ $ Request flags identifying fields as in ww3_shel input and section 2.4 fo the manual. N -HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD +HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK $ $ Output type ITYPE [0,1,2,3] $ diff --git a/regtests/ww3_tp2.6/input/ww3_shel.inp b/regtests/ww3_tp2.6/input/ww3_shel.inp index ecdf1bc3ad..2bd59dc2c9 100644 --- a/regtests/ww3_tp2.6/input/ww3_shel.inp +++ b/regtests/ww3_tp2.6/input/ww3_shel.inp @@ -60,7 +60,7 @@ $ Output request flags identifying fields as in ww3_shel input and $ section 2.4 of the manual. $ N -HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD +HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK $ $---------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.6/input/ww3_shel.nml b/regtests/ww3_tp2.6/input/ww3_shel.nml index f27f0b1612..3518049f26 100644 --- a/regtests/ww3_tp2.6/input/ww3_shel.nml +++ b/regtests/ww3_tp2.6/input/ww3_shel.nml @@ -22,7 +22,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD' + TYPE%FIELD%LIST = 'HS LM T02 T01 T0M1 UST CHA CGE DTD FC CFX CFD QP QKK' TYPE%POINT%FILE = '../input/points.list' / From 8589d12a46c3824891fd43f372a98e2732e2c220 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 21 Sep 2023 14:49:08 +0200 Subject: [PATCH 011/136] correct issue with ww3_multi when requesting restart2 and using nml file instead of inp file (#1070) --- model/src/wminitmd.F90 | 157 ++++++++---------- model/src/ww3_ounf.F90 | 3 + regtests/bin/matrix.base | 2 + regtests/bin/matrix_cmake_datarmor | 1 + regtests/bin/run_cmake_test | 26 +-- regtests/ww3_tp2.3/input/namelists_GARDEN.nml | 2 +- regtests/ww3_tp2.3/input/ww3_grid.inp | 2 +- .../ww3_ufs1.1/input_unstr/namelists_a.nml | 2 +- .../ww3_ufs1.1/input_unstr/namelists_b.nml | 2 +- 9 files changed, 89 insertions(+), 108 deletions(-) diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 293b74848f..ac9d0036fa 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -3499,6 +3499,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & !/ Add ESMF override for STIME & ETIME ( version 6.02 ) !/ (T. J. Campbell, NRL) !/ 15-May-2018 : Update namelist ( version 6.05 ) + !/ 28-Oct-2020 : Add SMCTYPE for SMC sub-grid. JGLi ( version 7.13 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) !/ ! 1. Purpose : @@ -3518,8 +3519,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IDST Int. I Unit number for test output. ! IDSE Int. I Unit number for error output. ! IFNAME Char I File name for input file. - ! MPI_COMM Int. I MPI communicator to be used. - ! PREAMB Char I File name preamble (optiona). + ! MPI_COMM Int. I MPI communicator to be used. + ! PREAMB Char I File name preamble (optional). ! ---------------------------------------------------------------- ! ! 4. Subroutines used : @@ -3726,11 +3727,11 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif USE W3WDATMD, ONLY: TIME USE W3ADATMD, ONLY: WADATS - USE W3IDATMD, ONLY: INFLAGS1, INPUTS, IINIT, & - JFIRST, INFLAGS2 + USE W3IDATMD, ONLY: INFLAGS1, INFLAGS2, INPUTS, IINIT, & + JFIRST USE W3ODATMD, ONLY: NOGRP, NGRPP, FLOUT, TONEXT, FLBPI, & FLBPO, NFBPO, NBI, NDS, IAPROC, & - NAPFLD, NAPPNT, NAPTRK, NAPBPT, & + NAPFLD, NAPPNT, NAPTRK, NAPBPT, & NAPPRT, NAPROC, FNMPRE, OUTPTS, NDST, NDSE, & NOPTS, IOSTYP, UNIPTS, UPPROC, DTOUT, & TOLAST, NOTYPE @@ -4099,12 +4100,13 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & - FLG2(NOGRP,NRGRD) & - ,OUTFF(7,0:NRGRD)) + FLG2(NOGRP,NRGRD),OUTFF(7,0:NRGRD)) ! MDS = -1 MDSF = -1 FLGR2 = .FALSE. + FLG2 = .FALSE. + LPRT = .FALSE. IPRT = 0 ! ! ... Fixed and recycleable unit numbers. @@ -4148,9 +4150,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! sources, and from communication rather than ! files. ! - ALLOCATE ( INAMES(2*NRGRD,-7:9), MNAMES(-NRINP:2*NRGRD), & - TMPRNK(2*NRGRD), TMPGRP(2*NRGRD), NINGRP(2*NRGRD), & - RP1(2*NRGRD), RPN(2*NRGRD), BCDTMP(NRGRD+1:2*NRGRD)) + ALLOCATE ( INAMES(2*NRGRD,-7:9), MNAMES(-NRINP:2*NRGRD), & + TMPRNK(2*NRGRD), TMPGRP(2*NRGRD), NINGRP(2*NRGRD), & + RP1(2*NRGRD), RPN(2*NRGRD), BCDTMP(NRGRD+1:2*NRGRD) ) ALLOCATE ( GRANK(NRGRD), GRGRP(NRGRD), USEINP(NRINP) ) ALLOCATE ( CPLINP(NRINP) ) GRANK = -1 @@ -4615,31 +4617,39 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! DO I=1, NRGRD IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSS,950) TRIM(MNAMES(NRGRD+I)) - NOTYPE = 6 - + NOTYPE = 8 + ! OTYPE 1 READ(NML_OUTPUT_DATE(I)%FIELD%START, *) ODAT(1,I), ODAT(2,I) READ(NML_OUTPUT_DATE(I)%FIELD%STRIDE, *) ODAT(3,I) READ(NML_OUTPUT_DATE(I)%FIELD%STOP, *) ODAT(4,I), ODAT(5,I) READ(NML_OUTPUT_DATE(I)%FIELD%OUTFFILE, *) OUTFF(1,I) + ! OTYPE 2 READ(NML_OUTPUT_DATE(I)%POINT%START, *) ODAT(6,I), ODAT(7,I) READ(NML_OUTPUT_DATE(I)%POINT%STRIDE, *) ODAT(8,I) READ(NML_OUTPUT_DATE(I)%POINT%STOP, *) ODAT(9,I), ODAT(10,I) READ(NML_OUTPUT_DATE(I)%POINT%OUTFFILE, *) OUTFF(2,I) + ! OTYPE 3 READ(NML_OUTPUT_DATE(I)%TRACK%START, *) ODAT(11,I), ODAT(12,I) READ(NML_OUTPUT_DATE(I)%TRACK%STRIDE, *) ODAT(13,I) READ(NML_OUTPUT_DATE(I)%TRACK%STOP, *) ODAT(14,I), ODAT(15,I) + ! OTYPE 4 READ(NML_OUTPUT_DATE(I)%RESTART%START, *) ODAT(16,I), ODAT(17,I) READ(NML_OUTPUT_DATE(I)%RESTART%STRIDE, *) ODAT(18,I) READ(NML_OUTPUT_DATE(I)%RESTART%STOP, *) ODAT(19,I), ODAT(20,I) - READ(NML_OUTPUT_DATE(I)%RESTART2%START, *) ODAT(36,I), ODAT(37,I) - READ(NML_OUTPUT_DATE(I)%RESTART2%STRIDE, *) ODAT(38,I) - READ(NML_OUTPUT_DATE(I)%RESTART2%STOP, *) ODAT(39,I), ODAT(40,I) + !OTYPE 5 READ(NML_OUTPUT_DATE(I)%BOUNDARY%START, *) ODAT(21,I), ODAT(22,I) READ(NML_OUTPUT_DATE(I)%BOUNDARY%STRIDE, *) ODAT(23,I) READ(NML_OUTPUT_DATE(I)%BOUNDARY%STOP, *) ODAT(24,I), ODAT(25,I) + !OTYPE 6 READ(NML_OUTPUT_DATE(I)%PARTITION%START, *) ODAT(26,I), ODAT(27,I) READ(NML_OUTPUT_DATE(I)%PARTITION%STRIDE, *) ODAT(28,I) READ(NML_OUTPUT_DATE(I)%PARTITION%STOP, *) ODAT(29,I), ODAT(30,I) + !OTYPE 7 + ! for coupling but not implemented yet + !OTYPE 8 + READ(NML_OUTPUT_DATE(I)%RESTART2%START, *) ODAT(36,I), ODAT(37,I) + READ(NML_OUTPUT_DATE(I)%RESTART2%STRIDE, *) ODAT(38,I) + READ(NML_OUTPUT_DATE(I)%RESTART2%STOP, *) ODAT(39,I), ODAT(40,I) ! set the time stride at 0 or more ODAT(3,I) = MAX ( 0 , ODAT(3,I) ) @@ -4852,6 +4862,10 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ! ... End of output type selecttion ELSE IF ! + ELSE IF ( J .EQ. 8 ) THEN + ! + ! 5.i Type 8: checkpoint files (no additional data) + ! END IF ! ! ... End of IF in 5.b @@ -4861,45 +4875,6 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ... End of loop J on NOTYPE in 5.a ! END DO - !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx - ! Checkpoint - J=8 - !OUTPTS(I)%FLOUT(8)=.FALSE. - IF ( ODAT(5*(J-1)+3,I) .NE. 0 ) THEN - !OUTPTS(I)%FLOUT(8)=.TRUE. - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & - WRITE (MDSS,951) J, IDOTYP(J) - TTIME(1) = ODAT(5*(J-1)+1,I) - TTIME(2) = ODAT(5*(J-1)+2,I) - CALL STME21 ( TTIME , DTME21 ) - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & - WRITE (MDSS,952) DTME21 - TTIME(1) = ODAT(5*(J-1)+4,I) - TTIME(2) = ODAT(5*(J-1)+5,I) - CALL STME21 ( TTIME , DTME21 ) - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & - WRITE (MDSS,953) DTME21 - TTIME(1) = 0 - TTIME(2) = 0 - DTTST = REAL ( ODAT(5*(J-1)+3,I) ) - CALL TICK21 ( TTIME , DTTST ) - CALL STME21 ( TTIME , DTME21 ) - IF ( ( ODAT(5*(J-1)+1,I) .NE. ODAT(5*(J-1)+4,I) .OR. & - ODAT(5*(J-1)+2,I) .NE. ODAT(5*(J-1)+5,I) ) .AND. & - MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN - DO II=1, 18 - IF ( DTME21(II:II).NE.'0' .AND. & - DTME21(II:II).NE.'/' .AND. & - DTME21(II:II).NE.' ' .AND. & - DTME21(II:II).NE.':' ) EXIT - DTME21(II:II) = ' ' - END DO - WRITE (MDSS,954) DTME21(1:19) - END IF - !ELSE - !OUTPTS(I)%FLOUT(8) = .FALSE. - END IF - !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ! ! ... End of loop I on NRGRD in 5.a ! @@ -5015,16 +4990,17 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IF ( IOSTYP .GT. 1 ) THEN DO I=1, NRGRD + ! FIELD IF ( ODAT( 3,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 + ! TRACK IF ( ODAT(13,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 + ! PARTITION IF ( ODAT(28,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 - !xxx - ! Checkpoint - IF ( ODAT(38,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 - !xxx + ! POINT .OR. RESTART .OR. BOUNDARY IF ( ODAT( 8,I) .GT. 0 .OR. ODAT(18,I) .GT. 0 .OR. & - ODAT(23,I) .GT. 0 ) & - NDPOUT(I) = NDPOUT(I) + 1 + ODAT(23,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 + ! RESTART2 + IF ( ODAT(38,I) .GT. 0 ) NDPOUT(I) = NDPOUT(I) + 1 IF ( IOSTYP .EQ. 2 ) NDPOUT(I) = MIN ( 1 , NDPOUT(I) ) END DO END IF @@ -5437,11 +5413,12 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ..... Model initialization ! IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) WRITE (MDSS,982) - ! - CALL W3INIT ( I, .TRUE., MNAMES(I), MDS(:,I), NTRACE(:,I), ODAT(:,I), & + + CALL W3INIT ( I, .TRUE., MNAMES(I), MDS(:,I), NTRACE(:,I), & + ODAT(:,I), & FLGRD(:,:,I),FLGR2(:,:,I),FLGD(:,I),FLG2(:,I), & OT2(I)%NPTS, OT2(I)%X, OT2(I)%Y, OT2(I)%PNAMES, & - IPRT(:,I), LPRT(I), MPI_COMM_LOC ) + IPRT(:,I), LPRT(I), MPI_COMM_LOC) ! ! ..... Finalize I/O file hook up ! @@ -5533,6 +5510,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) WRITE (MDSS,983) CALL W3SETI ( I, MDSE, MDST ) ! + !!Li Stop modifying GTYPE from input forcing file. JGLi08Apr2021. + JJJ = GTYPE + ! ! ..... regular input files ! DO J=JFIRST, 6 @@ -5540,9 +5520,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IDINP(I,J) = IDSTR(J) IF ( INPMAP(I,J) .LT. 0 ) CYCLE CALL W3FLDO ('READ', IDINP(I,J), MDSF(I,J), MDST, MDSE2,& - NX, NY, GTYPE, IERR, MNAMES(I), & + !!Li NX, NY, GTYPE, IERR, MNAMES(I), & + NX, NY, JJJ, IERR, MNAMES(I), & TRIM(FNMPRE) ) IF ( IERR .NE. 0 ) GOTO 2080 + ! + !!Li Print a warning message when GTYPE not matching forcing field one. + IF ( (JJJ .NE. GTYPE) .AND. (IMPROC .EQ. NMPSC2) ) & + WRITE (MDSE, *) ' *** Warning: grid', I, ' GTYPE=', & + GTYPE, ' not matching field', J, ' grid type', JJJ + ! IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) & WRITE (MDSS,985) IDFLDS(J) ELSE @@ -5606,8 +5593,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( J.EQ.6 ) ALLOCATE ( WADATS(I)%RA0(NSEA) , & WADATS(I)%RAI(NSEA) ) ! - END IF - END DO + END IF ! IF ( INPMAP(I,J) .NE. 0 ) THEN + END DO ! DO J=JFIRST, 9 ! INFLAGS1 = TFLAGS CALL W3SETI ( I, MDSE, MDST ) @@ -5626,34 +5613,20 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END DO ! - ! Checkpoint - J=8 - OUTPTS(I)%FLOUT(8)=.FALSE. - IF ( ODAT(5*(J-1)+3,I) .NE. 0 ) THEN - OUTPTS(I)%FLOUT(8)=.TRUE. - ELSE - OUTPTS(I)%FLOUT(8)=.FALSE. - ENDIF - - IF ( FLOUT(J) ) THEN - IF ( TOUTP(1,I) .EQ. -1 ) THEN - TOUTP(:,I) = TONEXT(:,J) - ELSE - DTTST = DSEC21 ( TOUTP(:,I), TONEXT(:,J) ) - IF ( DTTST .LT. 0. ) TOUTP(:,I) = TONEXT(:,J) - ENDIF - END IF - ! - ! GRSTAT(I) = 0 TSYNC(:,I) = TIME(:) ! +#ifdef W3_SMC + ! Check GTYPE values after initialization + IF ( IMPROC .EQ. NMPERR ) WRITE(MDSE,*) "GRID IMPROC GTYPE", & + I, IMPROC, GRIDS(I)%GTYPE +#endif + ! #ifdef W3_T WRITE (MDST,9082) GRSTAT(I), TOUTP(:,I), TSYNC(:,I) #endif ! - END DO ! DO I=1, NRGRD - + END DO !! 8.a I-NRGRD loop ! #ifdef W3_MPI CALL MPI_BARRIER (MPI_COMM_MWAVE,IERR_MPI) @@ -5725,7 +5698,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & MPI_COMM_BCT, IERR_MPI ) IF ( MPI_COMM_GRD .EQ. MPI_COMM_NULL ) & GSU = W3GSUC( .FALSE., FLAGLL, ICLOSE, & - XGRD, YGRD) + XGRD, YGRD ) CALL MPI_BCAST ( DXDP, NX*NY, MPI_REAL, 0, & MPI_COMM_BCT, IERR_MPI ) CALL MPI_BCAST ( DXDQ, NX*NY, MPI_REAL, 0, & @@ -5854,7 +5827,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! DO I=1, NRGRD DO J=JFIRST, 9 - IF ( INPMAP(I,J) .LT. 0 ) IDINP(I,J) = IDINP( INPMAP(I,J),J) + IF ( INPMAP(I,J).LT.0 .AND. INPMAP(I,J).NE.-999) IDINP(I,J) = IDINP( INPMAP(I,J),J) + !IF ( INPMAP(I,J) .LT. 0 ) IDINP(I,J) = IDINP( INPMAP(I,J),J) IF ( INPMAP(I,J) .GT. 0 ) IDINP(I,J) = IDINP(-INPMAP(I,J),J) END DO END DO @@ -5983,7 +5957,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 8.c.3 Relation to same ranked grids ! #ifdef W3_SMC - !! Check whether there is a SMC grid group. JGLi12Apr2021 + !! Check whether there is a SMC grid group. JGLi12Apr2021 NGRPSMC = 0 DO JJ=1, NRGRP J = 0 @@ -6173,7 +6147,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( TSTOUT ) CALL WMUDMP ( MDST, 0 ) ! DEALLOCATE ( MDS, NTRACE, ODAT, FLGRD, FLGR2, FLGD, FLG2, INAMES,& - MNAMES ) + MNAMES & + ,OUTFF ) ! #ifdef W3_MPI CALL MPI_BARRIER ( MPI_COMM_MWAVE, IERR_MPI ) diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index 22ffd72dcd..f6a928e31f 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -1978,14 +1978,17 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ! Maximum CFL for spatial advection ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 CALL S2GRID(CFLXYMAX, X1) ! ! Maximum CFL for direction advection ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 CALL S2GRID(CFLTHMAX, X1) ! ! Maximum CFL for frequency advection ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 CALL S2GRID(CFLKMAX, X1) ! ! User defined... diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index a273372a94..88e7ee8352 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -2152,11 +2152,13 @@ # Global unstr case # Domain Decomposition Explicit fi + if [ "$ufs" = 'y' ] && [ "$pdlib" = 'y' ] && [ "$dist" = 'y' ]; then echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_a -g a -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body # Domain Decomposition Block Explicit echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_b -g b -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body # Domain Decomposition Implicit echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_c -g c -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body + fi #Test of UFS applications with ww3_multi_esmf and grib2 output if [ "$ufs" = 'y' ] && [ "$esmf" = 'y' ] && [ "$grib" = 'y' ] diff --git a/regtests/bin/matrix_cmake_datarmor b/regtests/bin/matrix_cmake_datarmor index f8ffaaa630..4e635f3c2c 100755 --- a/regtests/bin/matrix_cmake_datarmor +++ b/regtests/bin/matrix_cmake_datarmor @@ -112,6 +112,7 @@ main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" echo " export NETCDF_CONFIG=/home/datawork-wave/NETCDF2019/${COMP}/bin/nc-config" >> matrix.head echo " export NetCDF_ROOT=/home/datawork-wave/NETCDF2019/${COMP}" >> matrix.head echo " export METIS_PATH=/home/datawork-wave/PARMETIS2019/${COMP}" >> matrix.head + echo " export SCOTCH_PATH=/home/datawork-wave/LIB/SCOTCH/v7.0.3/${COMP}" >> matrix.head echo " export WW3_PARCOMPN=4" >> matrix.head echo " export G2_LIB4=/home/datawork-wave/NCEPLIBS/${COMP}/g2-3.4.5/lib64/libg2_4.a" >> matrix.head echo " export BACIO_LIB4=/home/datawork-wave/NCEPLIBS/${COMP}/bacio-2.4.1/lib/libbacio_4.a" >> matrix.head diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index ec1503c55d..a349240d80 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -628,7 +628,7 @@ then fi # link conf file - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then \rm -f $prog.nml \ln -s $ifile $prog.nml @@ -654,7 +654,7 @@ then if [ $multi -eq 2 ] then mv mod_def.ww3 mod_def.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -752,7 +752,7 @@ then then mv restart.ww3 restart.$g \rm -f mod_def.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -851,7 +851,7 @@ then then mv nest.ww3 nest.$g \rm -f mod_def.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -950,7 +950,7 @@ then then mv nest.ww3 nest.$g \rm -f mod_def.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1054,7 +1054,7 @@ then then \rm -f mod_def.ww3 mv $otype.ww3 $otype.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1178,7 +1178,7 @@ then then \rm -f mod_def.ww3 mv $otype.ww3 $otype.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1301,7 +1301,7 @@ then then \rm -f mod_def.ww3 mv $otype.ww3 $otype.$g - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1445,7 +1445,7 @@ then \rm -f PET*.ESMF_LogFile \rm -f ww3_esmf.rc \cp -f ${path_i}/ww3_esmf.rc ww3_esmf.rc - if [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ ! -z "`basename ${ifile} | grep -o nml`" ] then echo "WAV_input_file_name: $prog.nml" >> ww3_esmf.rc fi @@ -1754,7 +1754,7 @@ do then \rm -f mod_def.ww3 \rm -f out_grd.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1821,7 +1821,7 @@ do then \rm -f mod_def.ww3 \rm -f out_grd.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -1989,7 +1989,7 @@ do then \rm -f mod_def.ww3 \rm -f out_pnt.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi @@ -2125,7 +2125,7 @@ do if [ $multi -eq 2 ] then \rm -f track_o.ww3 - if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] + if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log fi diff --git a/regtests/ww3_tp2.3/input/namelists_GARDEN.nml b/regtests/ww3_tp2.3/input/namelists_GARDEN.nml index 04b929ca1a..b8533dddaa 100644 --- a/regtests/ww3_tp2.3/input/namelists_GARDEN.nml +++ b/regtests/ww3_tp2.3/input/namelists_GARDEN.nml @@ -1,4 +1,4 @@ -&OUTS E3D=1 / +&OUTS E3D=1, TH1MF=1, STH1MF=1 / &PRO2 DTIME=345600. / &PRO3 WDTHTH=1.50, WDTHCG=1.50 / END OF NAMELISTS diff --git a/regtests/ww3_tp2.3/input/ww3_grid.inp b/regtests/ww3_tp2.3/input/ww3_grid.inp index 9be443dbb0..3a42713071 100644 --- a/regtests/ww3_tp2.3/input/ww3_grid.inp +++ b/regtests/ww3_tp2.3/input/ww3_grid.inp @@ -16,7 +16,7 @@ $ $ $ Activated up to one line per namelist !! $ - &OUTS E3D=1 / + &OUTS E3D=1, TH1MF=1, STH1MF=1 / $ &PRO2 DTIME= 0. / $ &PRO2 DTIME=172800. / &PRO2 DTIME=345600. / diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml index 584405f2f2..e28a03245d 100644 --- a/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_a.nml @@ -31,7 +31,7 @@ SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, SDSBRF1 = 0.50, SDSBRFDF = 0, SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ +WHITECAPWIDTH = 0.30/ &SBT1 GAMMA = -0.6700E-01 / &SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / &PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml index 292ffc5f77..8d1c72eda1 100644 --- a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml @@ -51,7 +51,7 @@ SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, SDSBRF1 = 0.50, SDSBRFDF = 0, SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ +WHITECAPWIDTH = 0.30/ &SBT1 GAMMA = -0.6700E-01 / &SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / &PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / From 7bbdaca7f452b23a52c3a609b03e82204653dc5e Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Fri, 22 Sep 2023 20:28:10 +0200 Subject: [PATCH 012/136] correct calendar for track netcdf output (#1079) --- model/src/ww3_trnc.F90 | 42 +++++++++++++-------- regtests/ww3_tp2.2/input/track_i.ww3 | 10 ++--- regtests/ww3_tp2.2/input/ww3_multi.inp | 14 +++---- regtests/ww3_tp2.2/input/ww3_multi.nml | 11 +++--- regtests/ww3_tp2.2/input/ww3_ounf.inp | 2 +- regtests/ww3_tp2.2/input/ww3_ounf.nml | 2 +- regtests/ww3_tp2.2/input/ww3_ounp.inp | 2 +- regtests/ww3_tp2.2/input/ww3_ounp.nml | 2 +- regtests/ww3_tp2.2/input/ww3_outf.inp | 2 +- regtests/ww3_tp2.2/input/ww3_outp_spec.inp | 2 +- regtests/ww3_tp2.2/input/ww3_outp_tab51.inp | 2 +- regtests/ww3_tp2.2/input/ww3_outp_tab52.inp | 2 +- regtests/ww3_tp2.2/input/ww3_outp_tab53.inp | 2 +- regtests/ww3_tp2.2/input/ww3_shel.inp | 24 ++++++------ regtests/ww3_tp2.2/input/ww3_shel.nml | 16 ++++---- regtests/ww3_tp2.2/input/ww3_trnc.inp | 2 +- regtests/ww3_tp2.2/input/ww3_trnc.nml | 2 +- 17 files changed, 76 insertions(+), 63 deletions(-) diff --git a/model/src/ww3_trnc.F90 b/model/src/ww3_trnc.F90 index b26d0d642a..c2049751c6 100644 --- a/model/src/ww3_trnc.F90 +++ b/model/src/ww3_trnc.F90 @@ -47,6 +47,7 @@ PROGRAM W3TRNC ! ---------------------------------------------------------------- ! W3NMOD Subr. W3GDATMD Set number of model. ! W3NOUT Subr. W3ODATMD Set number of model for output. + ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. ! ---------------------------------------------------------------- ! ! 5. Called by : @@ -70,13 +71,14 @@ PROGRAM W3TRNC !/ ------------------------------------------------------------------- / USE CONSTANTS - USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR + USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR, GNAME USE W3ODATMD, ONLY : W3NOUT, W3SETO, FNMPRE USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif USE W3TIMEMD + USE W3IOGRMD, ONLY: W3IOGR ! USE W3ODATMD, ONLY: NDSO, NDSE ! @@ -91,7 +93,7 @@ PROGRAM W3TRNC TYPE(NML_TRACK_T) :: NML_TRACK TYPE(NML_FILE_T) :: NML_FILE ! - INTEGER :: NDSI, NDSINP, & + INTEGER :: NDSI, NDSINP, NDSM, & NDSOUT, NDSTRC, NTRACE, & NSPEC, IERR, MK, MTH, IT, & ILOC, ISPEC, S3, IOUT, & @@ -135,6 +137,7 @@ PROGRAM W3TRNC ! 1. IO set-up. ! NDSI = 10 + NDSM = 20 NDSINP = 11 NDSOUT = 51 ! @@ -148,11 +151,16 @@ PROGRAM W3TRNC ! WRITE (NDSO,900) ! + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! 2. Read model definition file. + ! + CALL W3IOGR ( 'READ', NDSM ) + WRITE (NDSO,920) GNAME ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 2. Read requests from input file. + ! 3. Read requests from input file. ! ! @@ -163,13 +171,13 @@ PROGRAM W3TRNC ! Read namelist CALL W3NMLTRNC (NDSI, TRIM(FNMPRE)//'ww3_trnc.nml', NML_TRACK, NML_FILE, IERR) - ! 2.1 Time setup IDTIME, DTREQ, NOUT + ! 3.1 Time setup IDTIME, DTREQ, NOUT READ(NML_TRACK%TIMESTRIDE, *) DTREQ READ(NML_TRACK%TIMECOUNT, *) NOUT READ(NML_TRACK%TIMESTART, *) TOUT(1), TOUT(2) - ! 2.2 Output type + ! 3.2 Output type NCTYPE = NML_FILE%NETCDF FILEPREFIX = NML_FILE%PREFIX S3 = NML_TRACK%TIMESPLIT @@ -189,12 +197,12 @@ PROGRAM W3TRNC WRITE (NDSO,901) COMSTR - ! 2.1 Time setup IDTIME, DTREQ, NOUT + ! 3.1 Time setup IDTIME, DTREQ, NOUT CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=806,ERR=807) TOUT, DTREQ, NOUT - ! 2.2 Output type + ! 3.2 Output type CALL NEXTLN ( COMSTR , NDSI , NDSE ) READ (NDSI,*,END=806,ERR=807) NCTYPE CALL NEXTLN ( COMSTR , NDSI , NDSE ) @@ -208,7 +216,7 @@ PROGRAM W3TRNC - ! 2.1 Time setup IDTIME, DTREQ, NOUT + ! 3.3 Time setup IDTIME, DTREQ, NOUT DTREQ = MAX ( 0. , DTREQ ) IF ( DTREQ.EQ.0. ) NOUT = 1 NOUT = MAX ( 1 , NOUT ) @@ -227,7 +235,7 @@ PROGRAM W3TRNC WRITE (NDSO,941) IDTIME, NOUT - ! 2.2 Output type + ! 3.4 Output type IF ( NCTYPE.LT.3 .OR. NCTYPE.GT.4 ) THEN WRITE (NDSE,1010) NCTYPE CALL EXTCDE ( 1 ) @@ -239,7 +247,7 @@ PROGRAM W3TRNC ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Check consistency with input file and track_o.ww3 + ! 4. Check consistency with input file and track_o.ww3 ! OPEN (NDSINP,FILE=TRIM(FNMPRE)//'track_o.ww3',form='UNFORMATTED', convert=file_endian, & STATUS='OLD',ERR=800,IOSTAT=IERR) @@ -262,7 +270,7 @@ PROGRAM W3TRNC ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 4. Time management. + ! 5. Time management. ! IOUT = 0 NCID = 0 @@ -271,7 +279,7 @@ PROGRAM W3TRNC BACKSPACE (NDSINP) - ! 4.1 Loops on track_o.ww3 to read the time and data + ! 5.1 Loops on track_o.ww3 to read the time and data DO DTEST = DSEC21 ( TIME , TOUT ) @@ -310,17 +318,17 @@ PROGRAM W3TRNC END IF - ! 4.1.1 Increments the global time counter IOUT + ! 5.1.1 Increments the global time counter IOUT IOUT = IOUT + 1 CALL STME21 ( TOUT , IDTIME ) WRITE (NDSO,971) IDTIME - ! 4.1.2 Processes the variable value for the time step IOUT + ! 5.1.2 Processes the variable value for the time step IOUT CALL W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) - ! 4.1.3 Defines the stop date + ! 5.1.3 Defines the stop date CALL T2D(TOUT,STOPDATE,IERR) WRITE(STRSTOPDATE,'(I4.4,A,4(I2.2,A),I2.2)') STOPDATE(1),'-',STOPDATE(2), & '-',STOPDATE(3),' ',STOPDATE(5),':',STOPDATE(6),':',STOPDATE(7) @@ -331,7 +339,7 @@ PROGRAM W3TRNC 444 CONTINUE - ! 4.2 Closes the netCDF file + ! 5.2 Closes the netCDF file IF (NCID.NE.0) THEN IRET = NF90_REDEF(NCID) CALL CHECK_ERR(IRET) @@ -383,6 +391,8 @@ PROGRAM W3TRNC 902 FORMAT ( ' Spectral grid size : ',I3,' by ',I3// & ' Opening file : '/ & ' -----------------------------------------------') +920 FORMAT ( ' Grid name : ',A/) + ! 940 FORMAT (/' Output time data : '/ & ' --------------------------------------------------'/ & ' First time : ',A) diff --git a/regtests/ww3_tp2.2/input/track_i.ww3 b/regtests/ww3_tp2.2/input/track_i.ww3 index ae2154a44e..e4e7fbf61e 100644 --- a/regtests/ww3_tp2.2/input/track_i.ww3 +++ b/regtests/ww3_tp2.2/input/track_i.ww3 @@ -1,6 +1,6 @@ WAVEWATCH III TRACK LOCATIONS DATA -19680606 000000 0 0 S1A -19680606 040000 1 0 S1B -19680606 060000 1 0 S1C -19680606 080000 2 0 S1D -19680606 120000 0.5 0 S1E +20220606 000000 0 0 S1A +20220606 040000 1 0 S1B +20220606 060000 1 0 S1C +20220606 080000 2 0 S1D +20220606 120000 0.5 0 S1E diff --git a/regtests/ww3_tp2.2/input/ww3_multi.inp b/regtests/ww3_tp2.2/input/ww3_multi.inp index 4d5d699e68..62f187b201 100644 --- a/regtests/ww3_tp2.2/input/ww3_multi.inp +++ b/regtests/ww3_tp2.2/input/ww3_multi.inp @@ -4,25 +4,25 @@ $ ------------------------------ $ 'ww3' 'no' 'no' 'no' 'no' 'no' 'no' 'no' 'no' 'no' 1 1 0.00 1.00 F $ - 19680606 000000 19680618 000000 + 20220606 000000 20220618 000000 $ T T $ - 19680606 000000 86400 19680618 000000 + 20220606 000000 86400 20220618 000000 $ N HS T0M1 DIR SPR $ - 19680606 000000 21600 19680618 000000 + 20220606 000000 21600 20220618 000000 0.0 0.0 'LEFT' 90.0 0.0 'CENTER' 180.0 0.0 'RIGHT' 0.0 0.0 'STOPSTRING' - 19680606 000000 3600 19680618 000000 + 20220606 000000 3600 20220618 000000 T - 19680612 000000 0 19680612 000000 - 19680606 000000 3600 19680618 000000 - 19680612 000000 0 19680612 000000 + 20220612 000000 0 20220612 000000 + 20220606 000000 3600 20220618 000000 + 20220612 000000 0 20220612 000000 $ 'the_end' 0 $ diff --git a/regtests/ww3_tp2.2/input/ww3_multi.nml b/regtests/ww3_tp2.2/input/ww3_multi.nml index 95c0f379c8..6736ed2290 100644 --- a/regtests/ww3_tp2.2/input/ww3_multi.nml +++ b/regtests/ww3_tp2.2/input/ww3_multi.nml @@ -9,7 +9,8 @@ &DOMAIN_NML DOMAIN%FLGHG1 = T DOMAIN%FLGHG2 = T - DOMAIN%STOP = '19680618 000000' + DOMAIN%START = '20220606 000000' + DOMAIN%STOP = '20220618 000000' / ! -------------------------------------------------------------------- ! @@ -37,10 +38,10 @@ ! Define output dates via OUTPUT_DATE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_DATE_NML - ALLDATE%FIELD = '19680606 000000' '86400' '19680618 000000' - ALLDATE%POINT = '19680606 000000' '21600' '19680618 000000' - ALLDATE%TRACK = '19680606 000000' '3600' '19680618 000000' - ALLDATE%BOUNDARY = '19680606 000000' '3600' '19680618 000000' + ALLDATE%FIELD = '20220606 000000' '86400' '20220618 000000' + ALLDATE%POINT = '20220606 000000' '21600' '20220618 000000' + ALLDATE%TRACK = '20220606 000000' '3600' '20220618 000000' + ALLDATE%BOUNDARY = '20220606 000000' '3600' '20220618 000000' / ! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.2/input/ww3_ounf.inp b/regtests/ww3_tp2.2/input/ww3_ounf.inp index 1d901574cf..120b78d3dd 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounf.inp +++ b/regtests/ww3_tp2.2/input/ww3_ounf.inp @@ -4,7 +4,7 @@ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), $ and number of output times. $ - 19680606 000000 10800. 100 + 20220606 000000 10800. 100 $ $ Fields requested --------------------------------------------------- $ $ diff --git a/regtests/ww3_tp2.2/input/ww3_ounf.nml b/regtests/ww3_tp2.2/input/ww3_ounf.nml index 44db63521e..07dcdd2c26 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounf.nml +++ b/regtests/ww3_tp2.2/input/ww3_ounf.nml @@ -6,7 +6,7 @@ ! Define the output fields to postprocess via FIELD_NML namelist ! -------------------------------------------------------------------- ! &FIELD_NML - FIELD%TIMESTART = '19680606 000000' + FIELD%TIMESTART = '20220606 000000' FIELD%TIMESTRIDE = '10800.' FIELD%TIMECOUNT = '100' FIELD%LIST = 'HS T01 DIR SPR' diff --git a/regtests/ww3_tp2.2/input/ww3_ounp.inp b/regtests/ww3_tp2.2/input/ww3_ounp.inp index 4816a3a7ed..2c6a2f8d2f 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounp.inp +++ b/regtests/ww3_tp2.2/input/ww3_ounp.inp @@ -4,7 +4,7 @@ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), $ and number of output times. $ - 19680606 000000 21600. 1000 + 20220606 000000 21600. 1000 $ $ Points requested --------------------------------------------------- $ $ diff --git a/regtests/ww3_tp2.2/input/ww3_ounp.nml b/regtests/ww3_tp2.2/input/ww3_ounp.nml index 29fa1897d6..e97fc6b22d 100644 --- a/regtests/ww3_tp2.2/input/ww3_ounp.nml +++ b/regtests/ww3_tp2.2/input/ww3_ounp.nml @@ -6,7 +6,7 @@ ! Define the output fields to postprocess via POINT_NML namelist ! -------------------------------------------------------------------- ! &POINT_NML - POINT%TIMESTART = '19680606 000000' + POINT%TIMESTART = '20220606 000000' POINT%TIMESTRIDE = '21600.' POINT%TIMECOUNT = '1000' POINT%LIST = '1 2 3' diff --git a/regtests/ww3_tp2.2/input/ww3_outf.inp b/regtests/ww3_tp2.2/input/ww3_outf.inp index 4b062a870f..d49b283c97 100644 --- a/regtests/ww3_tp2.2/input/ww3_outf.inp +++ b/regtests/ww3_tp2.2/input/ww3_outf.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Grid output post-processing $ ----------------------------------------- - 19680612 000000 518400. 2 + 20220612 000000 518400. 2 $ N HS T01 DIR SPR diff --git a/regtests/ww3_tp2.2/input/ww3_outp_spec.inp b/regtests/ww3_tp2.2/input/ww3_outp_spec.inp index d4c452b1fa..cb7c2ba525 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_spec.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_spec.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 1 2 diff --git a/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp b/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp index d40f4a55da..9e4c288b6e 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_tab51.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 1 -1 diff --git a/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp b/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp index 06431db5dc..3ded7db467 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_tab52.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 2 -1 diff --git a/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp b/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp index 209a605b03..0e57f1322c 100644 --- a/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp +++ b/regtests/ww3_tp2.2/input/ww3_outp_tab53.inp @@ -1,6 +1,6 @@ $ WAVEWATCH III Point output post-processing $ ------------------------------------------ - 19680606 000000 43200. 25 + 20220606 000000 43200. 25 $ 3 -1 diff --git a/regtests/ww3_tp2.2/input/ww3_shel.inp b/regtests/ww3_tp2.2/input/ww3_shel.inp index aba7af3e40..37d914fad0 100644 --- a/regtests/ww3_tp2.2/input/ww3_shel.inp +++ b/regtests/ww3_tp2.2/input/ww3_shel.inp @@ -10,31 +10,31 @@ $ ------------------------------ F F $ - 19680606 000000 - 19680606 120000 + 20220606 000000 + 20220606 120000 $ 1 $ - 19680606 000000 10800 19680608 000000 + 20220606 000000 10800 20220608 000000 $ N HS EF T01 DIR SPR $ - 19680606 000000 21600 19680608 000000 + 20220606 000000 21600 20220608 000000 0.0 0.0 'LEFT' 90.0 0.0 'CENTER' 180.0 0.0 'RIGHT' 0.0 0.0 'STOPSTRING' - 19680606 000000 14400 19680608 000000 + 20220606 000000 14400 20220608 000000 T - 19680606 000000 0 19680608 000000 - 19680606 000000 0 19680608 000000 - 19680606 000000 0 19680608 000000 + 20220606 000000 0 20220608 000000 + 20220606 000000 0 20220608 000000 + 20220606 000000 0 20220608 000000 $ - 'CUR' 19680606 030000 2.0 45. - 'WND' 19680606 000000 20.0 180. 2. - 'WND' 19680606 040000 15.0 130. 1. - 'WND' 19680606 080000 25.0 90. 3. + 'CUR' 20220606 030000 2.0 45. + 'WND' 20220606 000000 20.0 180. 2. + 'WND' 20220606 040000 15.0 130. 1. + 'WND' 20220606 080000 25.0 90. 3. 'STP' $ $ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.2/input/ww3_shel.nml b/regtests/ww3_tp2.2/input/ww3_shel.nml index 578f05f93a..32205bc57e 100644 --- a/regtests/ww3_tp2.2/input/ww3_shel.nml +++ b/regtests/ww3_tp2.2/input/ww3_shel.nml @@ -7,7 +7,8 @@ ! Define top-level model parameters via DOMAIN_NML namelist ! -------------------------------------------------------------------- ! &DOMAIN_NML - DOMAIN%STOP = '19680606 120000' + DOMAIN%START = '20220606 000000' + DOMAIN%STOP = '20220606 120000' / ! -------------------------------------------------------------------- ! @@ -30,9 +31,9 @@ ! Define output dates via OUTPUT_DATE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_DATE_NML - DATE%FIELD = '19680606 000000' '10800' '19680608 000000' - DATE%POINT = '19680606 000000' '21600' '19680608 000000' - DATE%TRACK = '19680606 000000' '14400' '19680608 000000' + DATE%FIELD = '20220606 000000' '10800' '20220608 000000' + DATE%POINT = '20220606 000000' '21600' '20220608 000000' + DATE%TRACK = '20220606 000000' '14400' '20220608 000000' / ! -------------------------------------------------------------------- ! @@ -45,23 +46,24 @@ &HOMOG_INPUT_NML HOMOG_INPUT(1)%NAME = 'CUR' - HOMOG_INPUT(1)%DATE = '19680606 030000' + HOMOG_INPUT(1)%DATE = '20220606 030000' HOMOG_INPUT(1)%VALUE1 = 2.0 HOMOG_INPUT(1)%VALUE2 = 45. HOMOG_INPUT(2)%NAME = 'WND' + HOMOG_INPUT(2)%DATE = '20220606 000000' HOMOG_INPUT(2)%VALUE1 = 20.0 HOMOG_INPUT(2)%VALUE2 = 180. HOMOG_INPUT(2)%VALUE3 = 2. HOMOG_INPUT(3)%NAME = 'WND' - HOMOG_INPUT(3)%DATE = '19680606 040000' + HOMOG_INPUT(3)%DATE = '20220606 040000' HOMOG_INPUT(3)%VALUE1 = 15.0 HOMOG_INPUT(3)%VALUE2 = 130. HOMOG_INPUT(3)%VALUE3 = 1. HOMOG_INPUT(4)%NAME = 'WND' - HOMOG_INPUT(4)%DATE = '19680606 080000' + HOMOG_INPUT(4)%DATE = '20220606 080000' HOMOG_INPUT(4)%VALUE1 = 25.0 HOMOG_INPUT(4)%VALUE2 = 90. HOMOG_INPUT(4)%VALUE3 = 3. diff --git a/regtests/ww3_tp2.2/input/ww3_trnc.inp b/regtests/ww3_tp2.2/input/ww3_trnc.inp index df60800b8e..ddfd4f403e 100755 --- a/regtests/ww3_tp2.2/input/ww3_trnc.inp +++ b/regtests/ww3_tp2.2/input/ww3_trnc.inp @@ -4,7 +4,7 @@ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), $ and number of output times. $ - 19680606 000000 3600. 100000 + 20220606 000000 3600. 100000 $ $ Output type -------------------------------------------------------- $ $ netCDF version [3,4] diff --git a/regtests/ww3_tp2.2/input/ww3_trnc.nml b/regtests/ww3_tp2.2/input/ww3_trnc.nml index e4ae8ceab0..e6847f5293 100644 --- a/regtests/ww3_tp2.2/input/ww3_trnc.nml +++ b/regtests/ww3_tp2.2/input/ww3_trnc.nml @@ -6,7 +6,7 @@ ! Define the output fields to postprocess via TRACK_NML namelist ! -------------------------------------------------------------------- ! &TRACK_NML - TRACK%TIMESTART = '19680606 000000' + TRACK%TIMESTART = '20220606 000000' TRACK%TIMESTRIDE = '3600.' / From b1356ddb28e9e5b4cc7e4d4ecb16f43e955864d3 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Tue, 10 Oct 2023 14:39:28 +0100 Subject: [PATCH 013/136] Fix missing mod_def.ww3 file in multigrid regression tests for track output (#1091) --- regtests/bin/run_cmake_test | 6 +++++- regtests/bin/run_test | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index a349240d80..206b3681d2 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -2027,7 +2027,7 @@ done # end of loop on progs case $outopt in native) out_progs="ww3_trck" ;; netcdf) out_progs="ww3_trnc" ;; - both) out_progs="ww3_trck ww3_trnc" ;; + both|all) out_progs="ww3_trck ww3_trnc" ;; *) out_progs="" ;; esac @@ -2070,6 +2070,9 @@ do then continue fi + + \ln -s mod_def.$g mod_def.ww3 + gu="_$g" fileconf="$prog${gu}" else @@ -2124,6 +2127,7 @@ do \rm -f $prog.nml if [ $multi -eq 2 ] then + \rm -f mod_def.ww3 \rm -f track_o.ww3 if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then diff --git a/regtests/bin/run_test b/regtests/bin/run_test index 7ed5ce40e7..560ab07251 100755 --- a/regtests/bin/run_test +++ b/regtests/bin/run_test @@ -2368,7 +2368,7 @@ done # end of loop on progs case $outopt in native) out_progs="ww3_trck" ;; netcdf) out_progs="ww3_trnc" ;; - both) out_progs="ww3_trck ww3_trnc" ;; + both|all) out_progs="ww3_trck ww3_trnc" ;; *) out_progs="" ;; esac @@ -2448,6 +2448,9 @@ do then continue fi + + \ln -s mod_def.$g mod_def.ww3 + gu="_$g" fileconf="$prog${gu}" else @@ -2502,6 +2505,7 @@ do \rm -f $prog.nml if [ $multi -eq 2 ] then + \rm -f mod_def.ww3 \rm -f track_o.ww3 if [ $nml_input ] && [ ! -z "`echo ${ifile} | grep -o nml`" ] then From d22b7bb95e91528f7b1759b6112a4ad2af4bfa63 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Tue, 10 Oct 2023 17:25:32 -0400 Subject: [PATCH 014/136] STAB3: fix cmake build for ST4 or ST3 (#1086) --- model/src/cmake/check_switches.cmake | 6 +++--- model/src/cmake/switches.json | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/model/src/cmake/check_switches.cmake b/model/src/cmake/check_switches.cmake index 563d529e21..d09a91c5e7 100644 --- a/model/src/cmake/check_switches.cmake +++ b/model/src/cmake/check_switches.cmake @@ -52,7 +52,7 @@ function(check_switches switches switch_files) message(FATAL_ERROR "Switch '${valid_opt}' requires '${required_switch}' to be set") endif() elseif(json_type STREQUAL "ARRAY") - string(JSON n_requires_any LENGTH ${vategory} valid-options ${j_options} requries ${i_requires}) + string(JSON n_requires_any LENGTH ${category} valid-options ${j_options} requires ${i_requires}) math(EXPR n_requires_any "${n_requires_any} - 1") # Loop over array and check that one of the switches is present @@ -70,7 +70,7 @@ function(check_switches switches switch_files) if(NOT found) message(FATAL_ERROR "Switch ${valid_opt} requires one of ${possible_values} to be set") endif() - + endif() endforeach() endif() @@ -98,7 +98,7 @@ function(check_switches switches switch_files) elseif(num_switches STREQUAL "upto2" AND n_switches_in_category GREATER 2) message(FATAL_ERROR "Too many ${category_name} switches found (max 2)") endif() - + endforeach() set(${switch_files} ${files} PARENT_SCOPE) diff --git a/model/src/cmake/switches.json b/model/src/cmake/switches.json index ca01708aff..ff2cdc9ade 100644 --- a/model/src/cmake/switches.json +++ b/model/src/cmake/switches.json @@ -264,7 +264,7 @@ }, { "name": "STAB3", - "requires": ["ST3", "ST4"] + "requires_any": ["ST3", "ST4"] } ] }, @@ -756,16 +756,16 @@ } ] }, - { - "name": "ddlib", + { + "name": "ddlib", "num_switches": "upto1", "description": "domain decomposition library", "valid-options": [ - { + { "name": "METIS", "requires": ["PDLIB"] - }, - { + }, + { "name": "SCOTCH", "requires": ["PDLIB"] } From eff6686d50a0e034cfe269731da05804f11f4c8b Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 12 Oct 2023 22:25:36 +0200 Subject: [PATCH 015/136] new feature to output out_grd.ww3, out_pnt.ww3 and mod_def.ww3 both in binary and ascii format using switch ASCII. (#1089) --- model/src/cmake/switches.json | 10 + model/src/w3gridmd.F90 | 12 +- model/src/w3initmd.F90 | 3 + model/src/w3iogomd.F90 | 395 ++++++++++++++++++- model/src/w3iogrmd.F90 | 385 +++++++++++++++++- model/src/w3iopomd.F90 | 60 ++- model/src/w3odatmd.F90 | 2 +- model/src/w3wavemd.F90 | 12 +- model/src/wminitmd.F90 | 18 + model/src/wmiopomd.F90 | 9 +- model/src/wmmdatmd.F90 | 5 + regtests/bin/matrix.base | 2 + regtests/bin/run_cmake_test | 4 + regtests/mww3_test_09/input/switch_MPI_ASCII | 1 + regtests/ww3_tp2.6/input/switch_ST4_ASCII | 1 + 15 files changed, 909 insertions(+), 10 deletions(-) create mode 100644 regtests/mww3_test_09/input/switch_MPI_ASCII create mode 100644 regtests/ww3_tp2.6/input/switch_ST4_ASCII diff --git a/model/src/cmake/switches.json b/model/src/cmake/switches.json index ff2cdc9ade..30eca480c3 100644 --- a/model/src/cmake/switches.json +++ b/model/src/cmake/switches.json @@ -813,5 +813,15 @@ "name": "B4B" } ] + }, + { + "name": "ascii", + "num_switches": "upto1", + "description": "ASCII output for binary .ww3 file", + "valid-options": [ + { + "name": "ASCII" + } + ] } ] diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 281ed7a3f7..aa618b59f7 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -586,6 +586,9 @@ MODULE W3GRIDMD IY2, J, JJ, IXR(4), IYR(4), ISEAI(4),& IST, NKI, NTHI, NRIC, NRIS, I, IDFT, & NSTAT, NBT, NLAND, NOSW, NMAPB, IMAPB +#ifdef W3_ASCII + INTEGER :: NDSMA +#endif #ifdef W3_NL2 INTEGER :: IDEPTH #endif @@ -5907,9 +5910,16 @@ SUBROUTINE W3GRID() !10. Write model definition file. ! WRITE (NDSO,999) - CALL W3IOGR ( 'WRITE', NDSM ) + CALL W3IOGR ( 'WRITE', NDSM & +#ifdef W3_ASCII + ,NDSA=NDSMA & +#endif + ) ! CLOSE (NDSM) +#ifdef W3_ASCII + CLOSE (NDSMA) +#endif ! GOTO 2222 ! diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 2d5eacc339..50f0680adb 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -239,6 +239,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! (first). ! 11: Track information file unit number. ! 12: Track output file unit number. + ! 13: Wave separation output file unit number. + ! 14: Grid output file unit number. + ! 15: Point output file unit number. ascii ! MTRACE I.A. I Array with subroutine tracing information. ! 1: Output unit number for trace. ! 2: Maximum number of trace prints. diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index a6ef03325e..2ddfa77e0c 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -2376,7 +2376,11 @@ END SUBROUTINE W3OUTG !> !> @author H. L. Tolman @date 22-Mar-2021 !> - SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) + SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & +#ifdef W3_ASCII + ,NDSOA & +#endif + ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -2535,6 +2539,9 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) INTEGER, INTENT(IN), OPTIONAL :: IMOD CHARACTER, INTENT(IN) :: INXOUT*(*) CHARACTER(LEN=15) :: TIMETAG +#ifdef W3_ASCII + INTEGER, INTENT(IN), OPTIONAL :: NDSOA +#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -2610,7 +2617,11 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) #endif IF ( WRITE ) THEN OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form ='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I)//'.txt', & + form ='FORMATTED',ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') @@ -2625,6 +2636,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) WRITE (NDSOG) & IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & UNDEF, NOSWLL +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL:', & + IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL +#endif ELSE READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, TNAME, MOGRP, MGRPP, NSEA, NX, NY, & @@ -2685,6 +2703,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) IF ( WRITE ) THEN OPEN (NDSOG,FILE=FNMPRE(:J)//TIMETAG//'.out_grd.' & //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//TIMETAG//'.out_grd.' & + //FILEXT(:I)//'.txt',form='FORMATTED',ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') @@ -2699,6 +2721,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) WRITE (NDSOG) & IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & UNDEF, NOSWLL +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL:', & + IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL +#endif ELSE READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, TNAME, MOGRP, MGRPP, NSEA, NX, NY, & @@ -2737,6 +2766,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ! IF ( WRITE ) THEN WRITE (NDSOG) TIME, FLOGRD +#ifdef W3_ASCII + WRITE (NDSOA,*) 'TIME, FLOGRD:', & + TIME, FLOGRD +#endif ELSE READ (NDSOG,END=803,ERR=802,IOSTAT=IERR) TIME, FLOGRD END IF @@ -2752,6 +2785,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) MAPTMP = MAPSTA + 8*MAPST2 WRITE (NDSOG) & ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) +#ifdef W3_ASCII + WRITE (NDSOA,*) 'MAPSTA:', & + ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) +#endif ELSE READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) @@ -2946,9 +2983,18 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ! IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) DW(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'DW:', DW(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) CX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CX:', CX(1:NSEA) +#endif WRITE ( NDSOG ) CY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CY:', CY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN DO ISEA=1, NSEA #ifdef W3_SMC @@ -2967,15 +3013,33 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (UA*cos(UD)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (UA*sin(UD)):', AUX2 +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) AS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AS:', AS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) WLV(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WLV:', WLV(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) ICE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'ICE:', ICE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) BERG(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BERG:', BERG(1:NSEA) +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 8 ) THEN DO ISEA=1, NSEA #ifdef W3_SMC @@ -2994,22 +3058,43 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (TAUA*cos(TAUADIR)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (TAUA*sin(TAUADIR)):', AUX2 +#endif ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) RHOAIR(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'RHOAIR:', RHOAIR(1:NSEA) +#endif #ifdef W3_BT4 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) SED_D50(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SED_D50:', SED_D50(1:NSEA) +#endif #endif #ifdef W3_IS2 ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 11 ) THEN WRITE (NDSOG ) ICEH(1:NSEA) +#ifdef W3_ASCII + WRITE (NDSOA,* ) 'ICEH:', ICEH(1:NSEA) +#endif ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 12 ) THEN WRITE (NDSOG ) ICEF(1:NSEA) +#ifdef W3_ASCII + WRITE (NDSOA,* ) 'ICEF:', ICEF(1:NSEA) +#endif #endif #ifdef W3_SETUP ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) ZETA_SETUP(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'ZETA_SETUP:', ZETA_SETUP(1:NSEA) +#endif #endif ! @@ -3017,94 +3102,217 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) HS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HS:', HS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) WLM(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WLM:', WLM(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) T02(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'T02:', T02(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) T0M1(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'T0M1:', T0M1(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) T01(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'T01:', T01(1:NSEA) +#endif ELSE IF ( (IFI .EQ. 2 .AND. IFJ .EQ. 6) .OR. & (IFI .EQ. 2 .AND. IFJ .EQ. 18) ) THEN ! Note: TP output is derived from FP field. WRITE ( NDSOG ) FP0(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'FP0:', FP0(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) THM(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'THM:', THM(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) THS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'THS:', THS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) THP0(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'THP0:', THP0(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) HSIG(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HSIG:', HSIG(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) STMAXE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STMAXE:', STMAXE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) STMAXD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STMAXD:', STMAXD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) HMAXE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HMAXE:', HMAXE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 14 ) THEN WRITE ( NDSOG ) HCMAXE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HCMAXE:', HCMAXE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 15 ) THEN WRITE ( NDSOG ) HMAXD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HMAXD:', HMAXD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 16 ) THEN WRITE ( NDSOG ) HCMAXD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'HCMAXD:', HCMAXD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 17 ) THEN WRITE ( NDSOG ) WBT(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WBT:', WBT(1:NSEA) +#endif ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 19 ) THEN WRITE ( NDSOG ) WNMEAN(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WNMEAN:', WNMEAN(1:NSEA) +#endif ! ! Section 3) ! ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) EF(1:NSEA,E3DF(2,1):E3DF(3,1)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'EF:', EF(1:NSEA,E3DF(2,1):E3DF(3,1)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) TH1M(1:NSEA,E3DF(2,2):E3DF(3,2)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TH1M:', TH1M(1:NSEA,E3DF(2,2):E3DF(3,2)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) STH1M(1:NSEA,E3DF(2,3):E3DF(3,3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STH1M:', STH1M(1:NSEA,E3DF(2,3):E3DF(3,3)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) TH2M(1:NSEA,E3DF(2,4):E3DF(3,4)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TH2M:', TH2M(1:NSEA,E3DF(2,4):E3DF(3,4)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) STH2M(1:NSEA,E3DF(2,5):E3DF(3,5)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'STH2M:', STH2M(1:NSEA,E3DF(2,5):E3DF(3,5)) +#endif ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 6) THEN WRITE ( NDSOG ) WN(1:NK,1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WN:', WN(1:NK,1:NSEA) +#endif ! ! Section 4) ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) PHS(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHS:', PHS(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) PTP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PTP:', PTP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) PLP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PLP:', PLP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PDIR(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PDIR:', PDIR(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) PSI(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PSI:', PSI(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) PWS(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PWS:', PWS(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) PTHP0(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PTHP0:', PTHP0(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) PQP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PQP:', PQP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) PPE(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PPE:', PPE(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) PGW(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PGW:', PGW(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) PSW(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PSW:', PSW(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) PTM1(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PTM1:', PTM1(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) PT1(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PT1:', PT1(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 14 ) THEN WRITE ( NDSOG ) PT2(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PT2:', PT2(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 15 ) THEN WRITE ( NDSOG ) PEP(1:NSEA,0:NOSWLL) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PEP:', PEP(1:NSEA,0:NOSWLL) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16 ) THEN WRITE ( NDSOG ) PWST(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PWST:', PWST(1:NSEA) +#endif ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17 ) THEN WRITE ( NDSOG ) PNR(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PNR:', PNR(1:NSEA) +#endif ! ! Section 5) ! @@ -3123,68 +3331,179 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (UST*ASF*cos(USTDIR)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (UST*ASF*sin(USTDIR)):', AUX2 +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) CHARN(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CHARN:', CHARN(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) CGE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CGE:', CGE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIAW(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHIAW:', PHIAW(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) TAUWIX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWIX:', TAUWIX(1:NSEA) +#endif WRITE ( NDSOG ) TAUWIY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWIY:', TAUWIY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) TAUWNX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWNX:', TAUWNX(1:NSEA) +#endif WRITE ( NDSOG ) TAUWNY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUWNY:', TAUWNY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(1):', WHITECAP(1:NSEA,1) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(2):', WHITECAP(1:NSEA,2) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,3) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(3):', WHITECAP(1:NSEA,3) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) WHITECAP(1:NSEA,4) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'WHITECAP(4):', WHITECAP(1:NSEA,4) +#endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) TWS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TWS:', TWS(1:NSEA) +#endif ! ! Section 6) ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) SXX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SXX:', SXX(1:NSEA) +#endif WRITE ( NDSOG ) SYY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SYY:', SYY(1:NSEA) +#endif WRITE ( NDSOG ) SXY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SXY:', SXY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) TAUOX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOX:', TAUOX(1:NSEA) +#endif WRITE ( NDSOG ) TAUOY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOY:', TAUOY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) BHD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BHD:', BHD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIOC(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHIOC:', PHIOC(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) TUSX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TUSX:', TUSX(1:NSEA) +#endif WRITE ( NDSOG ) TUSY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TUSY:', TUSY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) USSX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSX:', USSX(1:NSEA) +#endif WRITE ( NDSOG ) USSY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSY:', USSY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN WRITE ( NDSOG ) PRMS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PRMS:', PRMS(1:NSEA) +#endif WRITE ( NDSOG ) TPMS(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TPMS:', TPMS(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) US3D(1:NSEA, US3DF(2):US3DF(3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'US3D:', US3D(1:NSEA, US3DF(2):US3DF(3)) +#endif WRITE ( NDSOG ) US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'US3D+NK:', US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'P2SMS:', P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) TAUICE(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUICE(1):', TAUICE(1:NSEA,1) +#endif WRITE ( NDSOG ) TAUICE(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUICE(2):', TAUICE(1:NSEA,2) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) PHICE(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHICE:', PHICE(1:NSEA) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) USSP(1:NSEA, 1:USSPF(2)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSP:', USSP(1:NSEA, 1:USSPF(2)) +#endif WRITE ( NDSOG ) USSP(1:NSEA,NK+1:NK+USSPF(2)) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USSP:', USSP(1:NSEA,NK+1:NK+USSPF(2)) +#endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) TAUOCX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOCX:', TAUOCX(1:NSEA) +#endif WRITE ( NDSOG ) TAUOCY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUOCY:', TAUOCY(1:NSEA) +#endif ! ! Section 7) ! @@ -3199,7 +3518,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (ABA*cos(ABD)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (ABA*sin(ABD)):', AUX2 +#endif !WRITE ( NDSOG ) ABA(1:NSEA) !WRITE ( NDSOG ) ABD(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN @@ -3213,53 +3538,119 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) END IF END DO WRITE ( NDSOG ) AUX1 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX1 (UBA*cos(UBD)):', AUX1 +#endif WRITE ( NDSOG ) AUX2 +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'AUX2 (UBA*sin(UBD)):', AUX2 +#endif ! WRITE ( NDSOG ) UBA(1:NSEA) ! WRITE ( NDSOG ) UBD(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) BEDFORMS(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BEDFORMS(1):', BEDFORMS(1:NSEA,1) +#endif WRITE ( NDSOG ) BEDFORMS(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BEDFORMS(2):', BEDFORMS(1:NSEA,2) +#endif WRITE ( NDSOG ) BEDFORMS(1:NSEA,3) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'BEDFORMS(3):', BEDFORMS(1:NSEA,3) +#endif ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIBBL(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'PHIBBL:', PHIBBL(1:NSEA) +#endif ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) TAUBBL(1:NSEA,1) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUBBL(1):', TAUBBL(1:NSEA,1) +#endif WRITE ( NDSOG ) TAUBBL(1:NSEA,2) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'TAUBBL(2):', TAUBBL(1:NSEA,2) +#endif ! ! Section 8) ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) MSSX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSSX:', MSSX(1:NSEA) +#endif WRITE ( NDSOG ) MSSY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSSY:', MSSY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) MSCX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSCX:', MSCX(1:NSEA) +#endif WRITE ( NDSOG ) MSCY(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSCY:', MSCY(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) MSSD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSSD:', MSSD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) MSCD(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'MSCD:', MSCD(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) QP(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'QP:', QP(1:NSEA) +#endif ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN WRITE ( NDSOG ) QKK(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'QKK:', QKK(1:NSEA) +#endif ! ! Section 9) ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) DTDYN(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'DTDYN:', DTDYN(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN WRITE ( NDSOG ) FCUT(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'FCUT:', FCUT(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN WRITE ( NDSOG ) CFLXYMAX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CFLXYMAX:', CFLXYMAX(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) CFLTHMAX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CFLTHMAX:', CFLTHMAX(1:NSEA) +#endif ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN WRITE ( NDSOG ) CFLKMAX(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'CFLMAX:', CFLKMAX(1:NSEA) +#endif ! ! Section 10) ! ELSE IF ( IFI .EQ. 10 ) THEN WRITE ( NDSOG ) USERO(1:NSEA,IFJ) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'USER0:', USERO(1:NSEA,IFJ) +#endif ! END IF ! diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 3aa2688ab8..e96b7b7882 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -112,7 +112,11 @@ MODULE W3IOGRMD !> @author F. Ardhuin !> @date 19-Oct-2020 - SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) + SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & +#ifdef W3_ASCII + ,NDSA & +#endif + ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -209,6 +213,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ! INXOUT C*(*) I Test string for read/write, valid are: ! 'READ', 'WRITE' and 'GRID'. ! NDSM Int. I File unit number. + ! NDSA Int. I File unit number. ascii ! IMOD Int. I Model number for W3GDAT etc. ! FEXT C*(*) I File extension to be used. ! ---------------------------------------------------------------- @@ -317,6 +322,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) INTEGER, INTENT(IN), OPTIONAL :: IMOD CHARACTER, INTENT(IN) :: INXOUT*(*) CHARACTER, INTENT(IN), OPTIONAL :: FEXT*(*) +#ifdef W3_ASCII + INTEGER, INTENT(IN), OPTIONAL :: NDSA +#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -563,6 +571,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN OPEN (NDSM,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSA,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT)//'.txt', & + form='FORMATTED',ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSM,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT), & form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=800,IOSTAT=IERR) @@ -578,14 +590,38 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & FNAMEF, FNAMEI +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IDSTR, VERGRD, NX, NY, NSEA, NTH, NK, & + NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & + FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & + FNAMEF, FNAMEI:', & + IDSTR, VERGRD, NX, NY, NSEA, NTH, NK, & + NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & + FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & + FNAMEF, FNAMEI +#endif ! #ifdef W3_SMC WRITE (NDSM) NCel, NUFc, NVFc, NRLv, MRFct +#ifdef W3_ASCII + WRITE (NDSA,*) 'NCel, NUFc, NVFc, NRLv, MRFct:', & + NCel, NUFc, NVFc, NRLv, MRFct +#endif WRITE (NDSM) NGLO, NARC, NBGL, NBAC, NBSMC +#ifdef W3_ASCII + WRITE (NDSA,*) 'NGLO, NARC, NBGL, NBAC, NBSMC:', & + NGLO, NARC, NBGL, NBAC, NBSMC +#endif #endif ! WRITE (NDSM) & (NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO) +#ifdef W3_ASCII + WRITE (NDSA,*) & + '(NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO):', & + (NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO) +#endif #ifdef W3_T WRITE (NDST,9001) IDSTR, VERGRD, NX, NY, NSEA, NTH, NK, & NBI, NFBPO, 9, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & @@ -717,6 +753,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) MAPTMP = MAPSTA + 8*MAPST2 WRITE (NDSM) & GTYPE, FLAGLL, ICLOSE +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'GTYPE, FLAGLL, ICLOSE:', & + GTYPE, FLAGLL, ICLOSE +#endif ! ! Writes different kind of information depending on grid type ! @@ -725,9 +766,19 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CASE ( RLGTYPE, SMCTYPE ) WRITE (NDSM) & SX, SY, X0, Y0 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SX, SY, X0, Y0:', & + SX, SY, X0, Y0 +#endif CASE ( CLGTYPE ) WRITE (NDSM) & REAL(XGRD), REAL(YGRD) +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'REAL(XGRD), REAL(YGRD):', & + REAL(XGRD), REAL(YGRD) +#endif CASE (UNGTYPE) WRITE (NDSM) & FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & @@ -746,6 +797,41 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) B_JGS_NORM_THR, & B_JGS_NLEVEL, & B_JGS_SOURCE_NONLINEAR +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & + FSBCCFL, FSREFRACTION, FSFREQSHIFT, FSSOURCE, & + DO_CHANGE_WLV, SOLVERTHR_STP, CRIT_DEP_STP, & + NTRI,COUNTOT, COUNTRI, NNZ, & + B_JGS_TERMINATE_MAXITER, & + B_JGS_TERMINATE_DIFFERENCE, & + B_JGS_TERMINATE_NORM, & + B_JGS_LIMITER, & + B_JGS_BLOCK_GAUSS_SEIDEL, & + B_JGS_USE_JACOBI, & + B_JGS_MAXITER, & + B_JGS_PMIN, & + B_JGS_DIFF_THR, & + B_JGS_NORM_THR, & + B_JGS_NLEVEL, & + B_JGS_SOURCE_NONLINEAR:', & + FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & + FSBCCFL, FSREFRACTION, FSFREQSHIFT, FSSOURCE, & + DO_CHANGE_WLV, SOLVERTHR_STP, CRIT_DEP_STP, & + NTRI,COUNTOT, COUNTRI, NNZ, & + B_JGS_TERMINATE_MAXITER, & + B_JGS_TERMINATE_DIFFERENCE, & + B_JGS_TERMINATE_NORM, & + B_JGS_LIMITER, & + B_JGS_BLOCK_GAUSS_SEIDEL, & + B_JGS_USE_JACOBI, & + B_JGS_MAXITER, & + B_JGS_PMIN, & + B_JGS_DIFF_THR, & + B_JGS_NORM_THR, & + B_JGS_NLEVEL, & + B_JGS_SOURCE_NONLINEAR +#endif !Init COUNTCON and IOBDP to zero, it needs to be set somewhere or !removed COUNTCON=0 @@ -755,10 +841,26 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & + LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & + DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & + POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI:', & + X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & + LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & + DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & + POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI +#endif END SELECT !GTYPE ! WRITE (NDSM) & ZB, MAPTMP, MAPFS, MAPSF, TRFLAG +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZB, MAPTMP, MAPFS, MAPSF, TRFLAG:', & + ZB, MAPTMP, MAPFS, MAPSF, TRFLAG +#endif ! #ifdef W3_SMC IF( GTYPE .EQ. SMCTYPE ) THEN @@ -767,6 +869,18 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) ICLBAC WRITE (NDSM) ANGARC WRITE (NDSM) CTRNX, CTRNY, CLATF +#ifdef W3_ASCII + WRITE (NDSA,*) 'NLvCel, NLvUFc, NLvVFc:', & + NLvCel, NLvUFc, NLvVFc + WRITE (NDSA,*) 'IJKCel, IJKUFc, IJKVFc, ISMCBP:', & + IJKCel, IJKUFc, IJKVFc, ISMCBP + WRITE (NDSA,*) 'ICLBAC:', & + ICLBAC + WRITE (NDSA,*) 'ANGARC:', & + ANGARC + WRITE (NDSA,*) 'CTRNX, CTRNY, CLATF:', & + CTRNX, CTRNY, CLATF +#endif IF ( FLTEST ) THEN WRITE (NDSE,"(' NRLv, MRFct and NBSMC values are',3I9)") NRLv, MRFct, NBSMC WRITE (NDSE,"(' IJKCel, IJKUFc, IJKVFc Write for',3I9)") NCel, NUFc, NVFc @@ -776,6 +890,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #endif ! IF ( TRFLAG .NE. 0 ) WRITE (NDSM) TRNX, TRNY +#ifdef W3_ASCII + IF ( TRFLAG .NE. 0 ) WRITE (NDSA,*) 'TRNX, TRNY:', TRNX, TRNY +#endif WRITE (NDSM) & DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, FLCTH, & @@ -784,14 +901,43 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& IICEDDISP, IICEFDISP, BTBETA, & AAIRCMIN, AAIRGB +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & + FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, FLCTH, & + FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & + STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & + ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& + IICEDDISP, IICEFDISP, BTBETA, & + AAIRCMIN, AAIRGB:', & + DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & + FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, FLCTH, & + FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & + STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & + ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& + IICEDDISP, IICEFDISP, BTBETA, & + AAIRCMIN, AAIRGB +#endif WRITE(NDSM)GRIDSHIFT +#ifdef W3_ASCII + WRITE(NDSA,*)'GRIDSHIFT:', & + GRIDSHIFT +#endif #ifdef W3_SEC1 WRITE (NDSM) NITERSEC1 +#ifdef W3_ASCII + WRITE (NDSA,*) 'NITERSEC1:', & + NITERSEC1 +#endif #endif #ifdef W3_RTD !! Add rotated Polat/lon and AnglD to mod_def JGLi12Jun2012 WRITE (NDSM) PoLat, PoLon, AnglD, FLAGUNR +#ifdef W3_ASCII + WRITE (NDSA,*) 'PoLat, PoLon, AnglD, FLAGUNR:', & + PoLat, PoLon, AnglD, FLAGUNR +#endif #endif !! WRITE(NDSM) & @@ -977,6 +1123,15 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & + XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & + FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE:', & + MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & + XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & + FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE +#endif ELSE IF (.NOT.SINIT) CALL W3DIMS ( IGRD, NK, NTH, NDSE, NDST ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & @@ -999,6 +1154,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & E3DF, P2MSF, US3DF,USSPF, USSP_WN +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'E3DF, P2MSF, US3DF,USSPF, USSP_WN:', & + E3DF, P2MSF, US3DF,USSPF, USSP_WN +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & E3DF, P2MSF, US3DF,USSPF, USSP_WN @@ -1015,6 +1175,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & XBPO, YBPO, RDBPO, IPBPO, ISBPO +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'XBPO, YBPO, RDBPO, IPBPO, ISBPO:', & + XBPO, YBPO, RDBPO, IPBPO, ISBPO +#endif ELSE CALL W3DMO5 ( IGRD, NDSE, NDST, 2 ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & @@ -1040,6 +1205,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) & IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & PTMETH, PTFCUT +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & + PTMETH, PTFCUT:', & + IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & + PTMETH, PTFCUT +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & @@ -1057,37 +1229,84 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) & FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & FFACBERG, DELAB, FWTABLE +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & + FFACBERG, DELAB, FWTABLE:', & + FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & + FFACBERG, DELAB, FWTABLE +#endif #ifdef W3_RWND WRITE (NDSM) & RWINDC +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'RWINDC:', & + RWINDC +#endif #endif #ifdef W3_WCOR WRITE (NDSM) & WWCOR +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'WWCOR:', & + WWCOR +#endif #endif #ifdef W3_REF1 WRITE (NDSM) & RREF, REFPARS, REFLC, REFLD +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'RREF, REFPARS, REFLC, REFLD:', & + RREF, REFPARS, REFLC, REFLD +#endif #endif #ifdef W3_IG1 WRITE (NDSM) & IGPARS(1:12) +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IGPARS(1:12):', & + IGPARS(1:12) +#endif #endif #ifdef W3_IC2 WRITE (NDSM) & IC2PARS(1:8) +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC2PARS(1:8):', & + IC2PARS(1:8) +#endif #endif #ifdef W3_IC3 WRITE (NDSM) & IC3PARS +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC3PARS:', & + IC3PARS +#endif #endif #ifdef W3_IC4 WRITE (NDSM) & IC4PARS,IC4_KI,IC4_FC +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC4PARS,IC4_KI,IC4_FC:', & + IC4PARS,IC4_KI,IC4_FC +#endif #endif #ifdef W3_IC5 WRITE (NDSM) & IC5PARS +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'IC5PARS:', & + IC5PARS +#endif #endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & @@ -1142,6 +1361,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLX2 IF ( WRITE ) THEN WRITE (NDSM) NITTIN, CINXSI +#ifdef W3_ASCII + WRITE (NDSA,*)' NITTIN, CINXSI:', & + NITTIN, CINXSI +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) NITTIN, CINXSI END IF @@ -1152,6 +1375,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & NITTIN, CINXSI, CD_MAX, CAP_ID +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'NITTIN, CINXSI, CD_MAX, CAP_ID:', & + NITTIN, CINXSI, CD_MAX, CAP_ID +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & NITTIN, CINXSI, CD_MAX, CAP_ID @@ -1162,6 +1390,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLX4 IF ( WRITE ) THEN WRITE (NDSM) FLX4A0 +#ifdef W3_ASCII + WRITE (NDSA,*)' FLX4A0:', & + FLX4A0 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) FLX4A0 END IF @@ -1171,6 +1403,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_LN1 IF ( WRITE ) THEN WRITE (NDSM) SLNC1, FSPM, FSHF +#ifdef W3_ASCII + WRITE (NDSA,*)' SLNC1, FSPM, FSHF:', & + SLNC1, FSPM, FSHF +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SLNC1, FSPM, FSHF END IF @@ -1180,6 +1416,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_ST1 IF ( WRITE ) THEN WRITE (NDSM) SINC1, SDSC1 +#ifdef W3_ASCII + WRITE (NDSA,*)' SINC1, SDSC1:', & + SINC1, SDSC1 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SINC1, SDSC1 END IF @@ -1193,6 +1433,17 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & CDSA0, CDSA1, CDSA2, SDSALN, & CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZWIND, FSWELL, & + SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & + CDSA0, CDSA1, CDSA2, SDSALN, & + CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2:',& + ZWIND, FSWELL, & + SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & + CDSA0, CDSA1, CDSA2, SDSALN, & + CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZWIND, FSWELL, & @@ -1216,6 +1467,19 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) SSTXFTFTAIL, SSTXFTWN, & DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & FFXPM, FFXFM +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + SSWELLF, SSDSC1, WWNMEANP, WWNMEANPTAIL, SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, & + DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & + FFXPM, FFXFM:', & + ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + SSWELLF, SSDSC1, WWNMEANP, WWNMEANPTAIL, SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, & + DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & + FFXPM, FFXFM +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1246,6 +1510,33 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & DIKCUMUL, CUMULW +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & + ZZ0RAT, SSDSC, & + SSDSISO, SSDSBR, SSDSBT, SSDSBM, SSDSP, & + SSDSCOS, SSDSDTH, WWNMEANP, WWNMEANPTAIL,SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & + SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & + SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & + SSDSHCK, DELUST, DELTAIL, DELTAUW, & + DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & + DIKCUMUL, CUMULW:', & + ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & + TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & + ZZ0RAT, SSDSC, & + SSDSISO, SSDSBR, SSDSBT, SSDSBM, SSDSP, & + SSDSCOS, SSDSDTH, WWNMEANP, WWNMEANPTAIL,SSTXFTF, & + SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & + SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & + SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & + SSDSHCK, DELUST, DELTAIL, DELTAUW, & + DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & + DIKCUMUL, CUMULW +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1268,6 +1559,14 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) SIN6A0, SDS6ET, SDS6A1, SDS6A2, & SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & SIN6WS, SIN6FC +#ifdef W3_ASCII + WRITE (NDSA,*) 'SIN6A0, SDS6ET, SDS6A1, SDS6A2, & + SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & + SIN6WS, SIN6FC:', & + SIN6A0, SDS6ET, SDS6A1, SDS6A2, & + SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & + SIN6WS, SIN6FC +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SIN6A0, SDS6ET, SDS6A1, SDS6A2, & @@ -1282,6 +1581,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3:',& + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 @@ -1294,6 +1598,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) IQTPE, NLTAIL, NDPTHS WRITE (NDSM) DPTHNL +#ifdef W3_ASCII + WRITE (NDSA,*) 'IQTPE, NLTAIL, NDPTHS:', & + IQTPE, NLTAIL, NDPTHS + WRITE (NDSA,*) 'DPTHNL:', & + DPTHNL +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IQTPE, NLTAIL, NDPTHS @@ -1312,6 +1622,16 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) WRITE (NDSM) SNLL(1:SNLNQ), SNLM(1:SNLNQ), & SNLT(1:SNLNQ), SNLCD(1:SNLNQ), & SNLCS(1:SNLNQ) +#ifdef W3_ASCII + WRITE (NDSA,*) 'SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS:',& + SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS + WRITE (NDSA,*) 'SNLL(1:SNLNQ), SNLM(1:SNLNQ), & + SNLT(1:SNLNQ), SNLCD(1:SNLNQ), & + SNLCS(1:SNLNQ):', & + SNLL(1:SNLNQ), SNLM(1:SNLNQ), & + SNLT(1:SNLNQ), SNLCD(1:SNLNQ), & + SNLCS(1:SNLNQ) +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS @@ -1342,6 +1662,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_NL4 IF ( WRITE ) THEN WRITE (NDSM) ITSA, IALT +#ifdef W3_ASCII + WRITE (NDSA,*) 'ITSA, IALT:', & + ITSA, IALT +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ITSA, IALT @@ -1355,6 +1679,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CALL INSNL5 WRITE (NDSM) QR5DPT, QR5OML, QI5DIS, QI5KEV, & QI5NNZ, QI5IPL, QI5PMX +#ifdef W3_ASCII + WRITE (NDSA,*) 'QR5DPT, QR5OML, QI5DIS, QI5KEV, & + QI5NNZ, QI5IPL, QI5PMX:', & + QR5DPT, QR5OML, QI5DIS, QI5KEV, & + QI5NNZ, QI5IPL, QI5PMX +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & QR5DPT, QR5OML, QI5DIS, QI5KEV, & @@ -1369,6 +1699,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3:', & + CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 @@ -1412,6 +1747,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_BT1 IF ( WRITE ) THEN WRITE (NDSM) SBTC1 +#ifdef W3_ASCII + WRITE (NDSA,*) 'SBTC1:', SBTC1 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SBTC1 END IF @@ -1423,6 +1761,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & SBTCX, SED_D50, SED_PSIC +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SBTCX, SED_D50, SED_PSIC:', & + SBTCX, SED_D50, SED_PSIC +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SBTCX, SED_D50, SED_PSIC @@ -1436,6 +1779,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) & SDBC1, SDBC2, FDONLY +#ifdef W3_ASCII + WRITE (NDSA,*) & + 'SDBC1, SDBC2, FDONLY:', & + SDBC1, SDBC2, FDONLY +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SDBC1, SDBC2, FDONLY @@ -1448,6 +1796,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) IF ( WRITE ) THEN WRITE (NDSM) UOSTFILELOCAL, UOSTFILESHADOW, & UOSTFACTORLOCAL, UOSTFACTORSHADOW +#ifdef W3_ASCII + WRITE (NDSA,*) 'UOSTFILELOCAL, UOSTFILESHADOW, & + UOSTFACTORLOCAL, UOSTFACTORSHADOW:', & + UOSTFILELOCAL, UOSTFILESHADOW, & + UOSTFACTORLOCAL, UOSTFACTORSHADOW +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & UOSTFILELOCAL, UOSTFILESHADOW, & @@ -1464,6 +1818,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_IS1 IF ( WRITE ) THEN WRITE (NDSM) IS1C1, IS1C2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'IS1C1, IS1C2:', IS1C1, IS1C2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) IS1C1, IS1C2 END IF @@ -1472,6 +1829,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_IS2 IF ( WRITE ) THEN WRITE (NDSM) IS2PARS +#ifdef W3_ASCII + WRITE (NDSA,*) 'IS3PARS:', IS2PARS +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) IS2PARS IF ( .NOT. FLIS ) THEN @@ -1487,6 +1847,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_PR2 IF ( WRITE ) THEN WRITE (NDSM) DTME, CLATMN +#ifdef W3_ASCII + WRITE (NDSA,*) 'DTME, CLATMN:', DTME, CLATMN +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & DTME, CLATMN @@ -1498,6 +1861,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_PR3 IF ( WRITE ) THEN WRITE (NDSM) WDCG, WDTH +#ifdef W3_ASCII + WRITE (NDSA,*) 'WDCG, WDTH:', WDCG, WDTH +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & WDCG, WDTH @@ -1509,6 +1875,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_SMC IF ( WRITE ) THEN WRITE(NDSM) DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC +#ifdef W3_ASCII + WRITE(NDSA,*) 'DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC:', & + DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC @@ -1520,6 +1890,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLD1 IF ( WRITE ) THEN WRITE (NDSM) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2:', & + TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 @@ -1528,6 +1902,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) #ifdef W3_FLD2 IF ( WRITE ) THEN WRITE (NDSM) TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2:', & + TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 +#endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 @@ -1546,6 +1924,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) END IF ! CLOSE ( NDSM ) +#ifdef W3_ASCII + IF ( WRITE ) THEN + CLOSE ( NDSA ) + END IF +#endif call print_memcheck(memunit, 'memcheck_____:'//' WIOGR SECTION 9') ! RETURN diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 802685869e..d573879ce7 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -1034,7 +1034,11 @@ END SUBROUTINE W3IOPE !> !> @author H. L. Tolman @date 25-Jul-2006 !> - SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) + SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & +#ifdef W3_ASCII + ,NDSOA & +#endif + ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -1062,7 +1066,8 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) ! ---------------------------------------------------------------- ! INXOUT C*(*) I Test string for read/write, valid are: ! 'READ' and 'WRITE'. - ! NDSOP Int. I File unit number. + ! NDSOP Int. I File unit number. for binary + ! NDSOA Int. I File unit number. for ASCII ! IOTST Int. O Test indictor for reading. ! 0 : Data read. ! -1 : Past end of file. @@ -1140,6 +1145,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) !/ Parameter list !/ INTEGER, INTENT(IN) :: NDSOP +#ifdef W3_ASCII + INTEGER, INTENT(IN), OPTIONAL :: NDSOA +#endif INTEGER, INTENT(OUT) :: IOTST INTEGER, INTENT(IN), OPTIONAL :: IMOD CHARACTER, INTENT(IN) :: INXOUT*(*) @@ -1205,6 +1213,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN OPEN (NDSOP,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I)//'.txt', & + form='FORMATTED', ERR=800,IOSTAT=IERR) +#endif ELSE OPEN (NDSOP,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') @@ -1218,6 +1230,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & IDSTR, VEROPT, NK, NTH, NOPTS +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROPT, NK, NTH, NOPTS:', & + IDSTR, VEROPT, NK, NTH, NOPTS +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, MK, MTH, NOPTS @@ -1248,6 +1265,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#ifdef W3_ASCII + WRITE (NDSOA,*) & + '((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS):', & + ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) @@ -1289,6 +1311,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN OPEN (NDSOP,FILE=FNMPRE(:J)//TIMETAG//'.out_pnt.' & //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) +#ifdef W3_ASCII + OPEN (NDSOA,FILE=FNMPRE(:J)//TIMETAG//'.out_pnt.' & + //FILEXT(:I)//'.txt',form='FORMATTED', ERR=800,IOSTAT=IERR) +#endif END IF ! REWIND ( NDSOP ) @@ -1300,6 +1326,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & IDSTR, VEROPT, NK, NTH, NOPTS +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IDSTR, VEROPT, NK, NTH, NOPTS:', & + IDSTR, VEROPT, NK, NTH, NOPTS +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & IDTST, VERTST, MK, MTH, NOPTS @@ -1330,6 +1361,11 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) IF ( WRITE ) THEN WRITE (NDSOP) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#ifdef W3_ASCII + WRITE (NDSOA,*) & + '((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS):', & + ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) @@ -1349,6 +1385,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) ! IF ( WRITE ) THEN WRITE (NDSOP) TIME +#ifdef W3_ASCII + WRITE (NDSOA,*) 'TIME:', TIME +#endif ELSE READ (NDSOP,END=803,ERR=802,IOSTAT=IERR) TIME END IF @@ -1378,6 +1417,23 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD ) #endif ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I), & ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) +#ifdef W3_ASCII + WRITE (NDSOA,*) & + 'IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I):', & + IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I), & +#ifdef W3_FLX5 + 'TAUAO(I), TAUDO(I), DAIRO(I):', & + TAUAO(I), TAUDO(I), DAIRO(I), & +#endif +#ifdef W3_SETUP + 'ZET_SETO(I):', & + ZET_SETO(I), & +#endif + 'ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I):', & + ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I), & + 'ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC):', & + ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) +#endif ELSE READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I), & diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 4fc29eab96..d268793fbd 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -436,7 +436,7 @@ MODULE W3ODATMD INTEGER :: TOSNL5(2) #endif INTEGER :: TOFRST(2), TONEXT(2,8), TOLAST(2,8), & - TBPI0(2), TBPIN(2), NDS(13), OFILES(7) + TBPI0(2), TBPIN(2), NDS(15), OFILES(7) REAL :: DTOUT(8) LOGICAL :: FLOUT(8) TYPE(OTYPE1) :: OUT1 diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 6cbc7e74fa..44c80964d2 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -2567,7 +2567,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_SBS IF ( J .EQ. 1 ) THEN #endif - CALL W3IOGO( 'WRITE', NDS(7), ITEST, IMOD ) + CALL W3IOGO( 'WRITE', NDS(7), ITEST, IMOD & +#ifdef W3_ASCII + ,NDS(14) & +#endif + ) #ifdef W3_SBS ENDIF #endif @@ -2598,7 +2602,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! Gets the necessary spectral data ! CALL W3IOPE ( VA ) - CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD ) + CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD & +#ifdef W3_ASCII + ,NDS(15) & +#endif + ) END IF ! ELSE IF ( J .EQ. 3 ) THEN diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index ac9d0036fa..daea42c5c1 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -426,6 +426,9 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif #ifdef W3_MPRF USE WMMDATMD, ONLY: MDSP +#endif +#ifdef W3_ASCII + USE WMMDATMD, ONLY: MDSUPA #endif USE W3INITMD, ONLY: WWVER USE W3ODATMD, ONLY: OFILES @@ -1897,6 +1900,12 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL WMUSET ( MDSS, MDST, MDSUP, .TRUE., 'OUT', & TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II), & 'Unified point output') +#ifdef W3_ASCII + CALL WMUGET ( MDSS, MDST, MDSUPA, 'OUA' ) + CALL WMUSET ( MDSS, MDST, MDSUPA, .TRUE., 'OUA', & + TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II)//'.txt', & + 'Unified point output ascii') +#endif END IF END IF ! @@ -3750,6 +3759,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif #ifdef W3_MPRF USE WMMDATMD, ONLY: MDSP +#endif +#ifdef W3_ASCII + USE WMMDATMD, ONLY: MDSUPA #endif USE W3INITMD, ONLY: WWVER USE W3NMLMULTIMD @@ -4977,6 +4989,12 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL WMUSET ( MDSS, MDST, MDSUP, .TRUE., 'OUT', & TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II), & 'Unified point output') +#ifdef W3_ASCII + CALL WMUGET ( MDSS, MDST, MDSUPA, 'OUA' ) + CALL WMUSET ( MDSS, MDST, MDSUPA, .TRUE., 'OUA', & + TRIM(FNMPRE)//'out_pnt.'//MNAMES(0)(1:II)//'.txt', & + 'Unified point output ascii') +#endif END IF END IF ! diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index 071f7e0511..73e0365354 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -723,6 +723,9 @@ SUBROUTINE WMIOPO ( TOUT ) ICEO,ICEHO,ICEFO USE WMMDATMD, ONLY: MDST, MDSE, IMPROC, NMPROC, NMPUPT, NRGRD, & RESPEC, UPTMAP, MDSUP +#ifdef W3_ASCII + USE WMMDATMD, ONLY: MDSUPA +#endif #ifdef W3_MPI USE WMMDATMD, ONLY: MPI_COMM_MWAVE, MPI_COMM_GRD, ALLPRC, & MTAG0 @@ -1173,7 +1176,11 @@ SUBROUTINE WMIOPO ( TOUT ) ! TIME = TOUT ! - CALL W3IOPO ( 'WRITE', MDSUP, II, 0 ) + CALL W3IOPO ( 'WRITE', MDSUP, II, 0 & +#ifdef W3_ASCII + ,MDSUPA & +#endif + ) ! RETURN ! diff --git a/model/src/wmmdatmd.F90 b/model/src/wmmdatmd.F90 index e93c2cfb94..94aa7a7a97 100644 --- a/model/src/wmmdatmd.F90 +++ b/model/src/wmmdatmd.F90 @@ -74,6 +74,8 @@ MODULE WMMDATMD ! only. ! MDSP Int. Public Unit number for profiling. ! MDSUP Int. Public Unit number for unified point output. + ! MDSUPA Int. Public Unit number for unified point output. + ! ASCII ! MDSF I.A. Public Unit numbers for input files. ! ! NMPROC Int. Public Number of processors (for total multi- @@ -313,6 +315,9 @@ MODULE WMMDATMD INTEGER :: MDST = 6 !< MDST INTEGER :: MDSE = 6 !< MDSE INTEGER :: MDSUP !< MDSUP +#ifdef W3_ASCII + INTEGER :: MDSUPA !< MDSUPA +#endif INTEGER :: NMPROC = 1 !< NMPROC INTEGER :: IMPROC = 1 !< IMPROC INTEGER :: NMPLOG = 1 !< NMPLOG diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 88e7ee8352..864583358a 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -689,6 +689,7 @@ echo "$rtst -s ST0 -w work_ST0 $ww3 ww3_tp2.6" >> matrix.body echo "$rtst -s ST0 -w work_ST0 $ww3 ww3_tp2.7" >> matrix.body echo "$rtst -s ST4 -w work_ST4 $ww3 ww3_tp2.6" >> matrix.body + echo "$rtst -s ST4_ASCII -w work_ST4_ASCII $ww3 ww3_tp2.6" >> matrix.body fi if [ "$prop1D" = 'y' ] @@ -1885,6 +1886,7 @@ then echo ' ' >> matrix.body echo "$rtst -s MPI -w work_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_09" >> matrix.body + echo "$rtst -s MPI_ASCII -w work_MPI_ASCII -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_09" >> matrix.body fi # Rotated pole grid cases, (ww3_tp2.11 MPI only if requested) diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index 206b3681d2..86248bb4ed 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -654,6 +654,10 @@ then if [ $multi -eq 2 ] then mv mod_def.ww3 mod_def.$g + if [ -e mod_def.ww3.txt ] + then + mv mod_def.ww3.txt mod_def.${g}.txt + fi if [ $nml_input ] && [ ! -z "`basename ${ifile} | grep -o nml`" ] then mv $prog.nml.log ${prog}_$g.nml.log diff --git a/regtests/mww3_test_09/input/switch_MPI_ASCII b/regtests/mww3_test_09/input/switch_MPI_ASCII new file mode 100644 index 0000000000..e3d9628f0e --- /dev/null +++ b/regtests/mww3_test_09/input/switch_MPI_ASCII @@ -0,0 +1 @@ +ASCII NOGRB MPI DIST PR2 UNO SMC FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_tp2.6/input/switch_ST4_ASCII b/regtests/ww3_tp2.6/input/switch_ST4_ASCII new file mode 100644 index 0000000000..db1b70b661 --- /dev/null +++ b/regtests/ww3_tp2.6/input/switch_ST4_ASCII @@ -0,0 +1 @@ +ASCII NOGRB SHRD PR3 UQ FLX0 LN0 ST4 NL1 BT1 DB1 MLIM TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 From d148d0906a57487933a8a7e9466da8c293f962ce Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Mon, 16 Oct 2023 22:04:50 +0100 Subject: [PATCH 016/136] Update local unit number arrays (NDS, MDS) to be same size of array defined in w3odatmd (size=15). Also, defined unit numbers for NDS(14) and NDS(15). (#1098) --- model/src/w3initmd.F90 | 2 +- model/src/ww3_shel.F90 | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 50f0680adb..93218d473e 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -456,7 +456,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: IMOD, MDS(13), MTRACE(2), & + INTEGER, INTENT(IN) :: IMOD, MDS(15), MTRACE(2), & ODAT(40),NPT, IPRT(6),& MPI_COMM LOGICAL, INTENT(IN) :: IsMulti diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index d7e9790bb2..ee3464f44b 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -329,7 +329,7 @@ PROGRAM W3SHEL NDSEN, IERR, J, I, ILOOP, IPTS, NPTS, & NDTNEW, MPI_COMM = -99, & FLAGTIDE, COUPL_COMM, IH, N_TOT - INTEGER :: NDSF(-7:9), NDS(13), NTRACE(2), NDT(7:9), & + INTEGER :: NDSF(-7:9), NDS(15), NTRACE(2), NDT(7:9), & TIME0(2), TIMEN(2), TTIME(2), TTT(2), & NH(-7:10), THO(2,-7:10,NHMAX), RCLD(7:9), & NODATA(7:9), ODAT(40), IPRT(6) = 0, & @@ -600,6 +600,9 @@ PROGRAM W3SHEL NDS(11) = 22 NDS(12) = 23 NDS(13) = 34 + NDS(14) = 36 + NDS(15) = 37 + ! NTRACE(1) = NDS(3) NTRACE(2) = 10 From 66262f6222cf9736729e0f9d48f9d3c7112cb1b6 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Wed, 18 Oct 2023 14:09:26 +0100 Subject: [PATCH 017/136] Removed code referencing PHIOC in output section for PHICE in ww3_ounf (#1093) --- model/src/ww3_ounf.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index f6a928e31f..02fd0d6f8b 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -1815,9 +1815,6 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! Wave to sea ice energy flux ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - DO ISEA=1, NSEA - PHIOC(ISEA)=MIN(3000.,PHIOC(ISEA)) - END DO CALL S2GRID(PHICE(1:NSEA), X1) ! ! Partitioned surface stokes drift From 8eb35962c396267b56d569ef32a27be0d5bb1657 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 19 Oct 2023 21:14:25 +0200 Subject: [PATCH 018/136] implementation of the GQM (Gaussian Quadrature Method) to replace the DIA in NL1 or NL2. (#1083) --- manual/defs.tex | 3 + manual/eqs/NL1.tex | 140 +- manual/impl/switch.tex | 2 +- manual/manual.bib | 20 + model/inp/ww3_grid.inp | 12 + model/nml/namelists.nml | 10 + model/src/w3gdatmd.F90 | 23 + model/src/w3gridmd.F90 | 44 +- model/src/w3iogrmd.F90 | 30 +- model/src/w3snl1md.F90 | 1364 ++++++++++++++++- model/src/w3srcemd.F90 | 7 +- model/src/ww3_ounp.F90 | 7 +- model/src/ww3_outp.F90 | 6 +- model/src/ww3_trnc.F90 | 7 + regtests/bin/matrix.base | 2 + regtests/bin/matrix_cmake_datarmor | 2 +- regtests/ww3_ts1/input/namelists_ST4_T475.nml | 7 + regtests/ww3_ts1/input/namelists_ST4_T700.nml | 2 +- regtests/ww3_ts1/input/namelists_ST4_T702.nml | 12 + regtests/ww3_ts1/input/namelists_ST4_T707.nml | 13 + regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml | 225 +++ regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml | 225 +++ regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml | 225 +++ .../ww3_ts1/input_10ms/namelists_ST4_T707.nml | 14 + .../ww3_ts1/input_10ms/namelists_ST4_T713.nml | 14 + regtests/ww3_ts1/input_10ms/points.list | 1 + regtests/ww3_ts1/input_10ms/switch | 1 + regtests/ww3_ts1/input_10ms/switch_ST4 | 1 + .../ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml | 225 +++ .../ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml | 225 +++ regtests/ww3_ts1/input_10ms/ww3_ounf.nml | 29 + regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml | 48 + regtests/ww3_ts1/input_10ms/ww3_shel.nml | 54 + 33 files changed, 2942 insertions(+), 58 deletions(-) create mode 100644 regtests/ww3_ts1/input/namelists_ST4_T475.nml create mode 100644 regtests/ww3_ts1/input/namelists_ST4_T702.nml create mode 100644 regtests/ww3_ts1/input/namelists_ST4_T707.nml create mode 100644 regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml create mode 100644 regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml create mode 100644 regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml create mode 100644 regtests/ww3_ts1/input_10ms/points.list create mode 100644 regtests/ww3_ts1/input_10ms/switch create mode 100644 regtests/ww3_ts1/input_10ms/switch_ST4 create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_ounf.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_shel.nml diff --git a/manual/defs.tex b/manual/defs.tex index 1f67da7e72..5b8963fa5c 100644 --- a/manual/defs.tex +++ b/manual/defs.tex @@ -94,6 +94,9 @@ \newcommand{\cR}{{\cal R}} \newcommand{\cS}{{\cal S}} +\newcommand{\rd}{{\mathrm d}} + + \newcommand{\marbox}[1]{\marginpar{\fbox{{\small #1}}}} \newcommand{\proddefH}[3]{ diff --git a/manual/eqs/NL1.tex b/manual/eqs/NL1.tex index a6539dbe56..d9bc4c5217 100644 --- a/manual/eqs/NL1.tex +++ b/manual/eqs/NL1.tex @@ -1,58 +1,84 @@ -\vsssub -\subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec:NL1} -\vsssub - -\opthead{NL1}{\wam\ model}{H. L. Tolman} \noindent -Nonlinear wave-wave interactions can be modeled using the discrete interaction -approximation \citep[\dia,][]{art:Hea85b}. This parameterization was + + +Resonant nonlinear interactions occur between four wave components +(quadruplets) with wavenumber vector $\bk$, $\bk_1$, $\bk_2$ and $\bk_3$ are such that +% eq:resonance +\begin{equation} \left . +\begin{array}{ccc} + \bk + \bk_1 & = & \bk_2 + \bk_3 \\ + f_r + f_{r,1}& =& f_{r,2} + f_{r,3} +\end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:resonance} +\end{equation} + +Nonlinear 4-wave interaction theories were originally developed for the spectrum $F(f_r ,\theta)$. To assure the conservative nature of $S_{nl}$ for this spectrum (which can be considered as the "final product" of the model), this source term is calculated for $F(f_r,\theta)$ instead of $N(k,\theta)$, using the conversion (\ref{eq:jac_fr}). -Resonant nonlinear interactions occur between four wave components -(quadruplets) with wavenumber vector $\bk_1$ through $\bk_4$. In the \dia, it -is assumed that $\bk_1 = \bk_2$. Resonance conditions then require that -%--------------------------% -% Resonance conditions DIA % -%--------------------------% +\vsssub +\subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec:NL1} +\vsssub + +\opthead{NL1}{\wam\ model}{H. L. Tolman} + + + + In the \dia, for each component $\bk$, only 2 quadruplets configuration are +used, while there should be thousands for the full integral, and the interaction caused by these 2 quadruplets +is scaled so that it gives the right order of magnitude for the flux of energy towards low frequencies. + +Both quadruplets used the DIA use % eq:resonance \begin{equation} \left . \begin{array}{ccc} - \bk_1 + \bk_2 & = & \bk_3 + \bk_4 \\ - \sigma_2 & = & \sigma_1 \\ - \sigma_3 & = & (1+\lambda_{nl})\sigma_1 \\ - \sigma_4 & = & (1-\lambda_{nl})\sigma_1 -\end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:resonance} + \bk_1 & = & \bk\\ + f_{r,2} & = & (1+\lambda)f_{r} \\ + f_{r,3} & = & (1-\lambda)f_{r} +\end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:DIAchoice} \end{equation} -where $\lambda_{nl}$ is a constant. For these quadruplets, the contribution -$\delta S_{nl}$ to the interaction for each discrete $(f_r,\theta)$ -combination of the spectrum corresponding to $\bk_1$ is calculated as +where $\lambda$ is a constant, usually 0.25, and they only differ by the choice of the interacting angles +taking either a plus sign or a minus sign in the following +\begin{equation} \left . +\begin{array}{ccc} + \theta_{2,\pm} & = & \theta \pm \delta_{\theta,2} \\ + \theta_{3,\pm} & = & \theta \mp \delta_{\theta,3} \\ + \end{array} \:\:\: \right \rbrace \:\:\: , \label{eq:DIAangles} +\end{equation} +where $\delta_{\theta,2}$ and $\delta_{\theta,3}$ are only a function of $\lambda$ given by the geometry of +the interacting wavenumbers along the "figure of 8", namely +\begin{eqnarray} +\cos(\delta_{\theta,2})&=&(1-\lambda)^4+4-(1+\lambda)^4)/[4(1-\lambda)^2], \\ +\sin(\delta_{\theta,3})&=&\sin(\delta_{\theta,2}) (1-\lambda)^2/(1+\lambda)^2. +\end{eqnarray} + + For these quadruplets, each source term value +$S_{nl}(\bk)$ corresponding to each discrete $(f_r,\theta)$ +we compute the three contributions that correspond to the situation in which $\bk$ takes the role of $\bk$,$\bk_{2,+}$, $\bk_{2,-}$, $\bk_{3,+}$ and $\bk_{3,-}$ in the quadruplet, namely the full source term is +\begin{eqnarray} +S_{\mathrm{nl}}(\bk) &=& -2 \left[\delta S_{\mathrm{nl}}(\bk,\bk_2,\bk_3,+)+\delta S_{\mathrm{nl}}(\bk,\bk_2,\bk_3,-)\right] \nonumber \\ + & & + \delta S_{\mathrm{nl}}(\bk_4,\bk,\bk_5,+) + \delta S_{\mathrm{nl}}(\bk_6,\bk,\bk_7,-) \\ + & & + \delta S_{\mathrm{nl}}(\bk_8,\bk_9,\bk, +) + \delta S_{\mathrm{nl}}(\bk_{10},\bk_{11},\bk, -) . \label{eq:diasum} +\end{eqnarray} +with elementary contributions given by %----------------------------% % Nonlinear interactions DIA % %----------------------------% % eq:snl_dia -\begin{eqnarray} -\left ( \begin{array}{c} - \delta S_{nl,1} \\ \delta S_{nl,3} \\ \delta S_{nl,4} -\end{array} \right ) & = & D -\left ( \begin{array}{r} -2 \\ 1 \\ 1 \end{array} \right ) -C g^{-4} f_{r,1}^{11} \times \nonumber \\ -& & \left [ F_1^2 -\left ( \frac{F_3}{(1+\lambda_{nl})^4} + - \frac{F_4}{(1-\lambda_{nl})^4} \right ) - -\frac{2 F_1 F_3 F_4}{(1-\lambda_{nl}^2)^4} -\right ] \: , \label{eq:snl_dia} -\end{eqnarray} -where $F_1 = F(f_{r,1} ,\theta_1 )$ etc. and $\delta S_{nl,1} = \delta -S_{nl}(f_{r,1} ,\theta_1 )$ etc., $C$ is a proportionality constant. The -nonlinear interactions are calculated by considering a limited number of -combinations $(\lambda_{nl},C)$. In practice, only one combination is -used. Default values for different source term packages are presented in -Table~\ref{tab:snl_par}. + +\begin{equation} +\delta S_{\mathrm{nl}}(\bk,\bk_2,\bk_3,s) = \frac{C}{g^4} f_{r,1}^{11} \left [ F^2 \left ( \frac{F_{2,s}}{(1+\lambda_{nl})^4} + + \frac{F_{3,s}}{(1-\lambda_{nl})^4} \right ) - \frac{2 F F_{2,s} F_{3,s}}{(1-\lambda_{nl}^2)^4} \right] , + \label{eq:snl_dia} +\end{equation} +where $s=+$ or $s=-$ is a sign index, and the spectral densities are $F = F(f_{r} ,\theta)$, $F_{2,+} = F(f_{r,2} ,\theta + \delta_{\theta,2})$, $F_{2,-} = F(f_{r,2} ,\theta - \delta_{\theta,2})$, etc. + $C$ is a proportionality constant that was tuned to reproduce the inverse energy cascade. Default values for different source term packages are presented in Table~\ref{tab:snl_par}. +As a result, when accounting for the two quadruplet configurations, the source term at $\bk$ includes the interactions with +10 other spectral components. Besides, because $f_{r,2}$ and $f_{r,3}$ nor $\theta_{2,\pm} $ and $\theta_{3,\pm} $ fall on discretized frequencies and directions, the spectral densities are bilinearly interpolated, which involves 4 discrete spectral components for each of these 10 components. + % tab:snl_par @@ -68,7 +94,7 @@ \subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec: \caption{Default constants in \dia\ for input-dissipation packages.} \label{tab:snl_par} \botline \end{table} -This source term is developed for deep water, using the appropriate dispersion +This parameterization was developed for deep water, using the appropriate dispersion relation in the resonance conditions. For shallow water the expression is scaled by the factor $D$ (still using the deep-water dispersion relation, however) @@ -132,3 +158,37 @@ \subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec: above constants can be reset by the user in the input files of the model (see \para\ref{sub:ww3grid}). +\vsssub +\subsubsection{~$S_{nl}$: Gaussian Quadrature Method (\dia)} \label{sec:GQM} +\vsssub + +\opthead{NL1 , but with a negative IQTYPE}{TOMAWAC model, M. Benoit}{adaptation to WW3 by S. Siadatmousavi \& F. Ardhuin} + +\noindent +Changing the namelist parameter IQTYPE to a negative value replaces the +DIA parameterization with the possibility to perform an exact but fast cal- +culation of $S_{\mathrm{nl}}$ using the Gaussian Quadrature Method of \cite{Lavrenov2001}. +More details can be found in \cite{Gagnaire-Renou2009}. + + +The quadruplet configurations that are used correspond to the three integrals over $f_1$, $f_2$ and $\theta_1$, with all other frequencies and directions given by the resonance conditions (\ref{eq:resonance}) with only one ambiguity on the angle $\theta_2$ which can be defined by a sign index $s$, as in the DIA. Starting from eq. (A4) in \cite{Lavrenov2001} as writen in (2.25) of \cite{Gagnaire-Renou2009}, the source term is +\begin{equation} +S_{\mathrm{nl}}(\sigma,\theta) = 8 \sum_s \int_{\sigma_1=0}^\infty \int_{\theta_1=0}^{2 \pi} \int_{\sigma_2=0}^{(\sigma+\sigma_1)/2} T \frac{F_2 F_3 (F \sigma_1^4 + F_1 \sigma^4) - F F_1 (F_2 \sigma_3^4 + F_3 \sigma_2^4)}{\sqrt{B}\sqrt{((\left| \bk+\bk_1 \right|/g- \sigma_3^2)^2-\sigma_2^4} } {\mathrm d}\sigma_1 {\mathrm d}\theta_1 {\mathrm d}\sigma_2 , + \label{eq:snl_gqm} +\end{equation} +where $B$ is given by eq. (A5) of Lavrenov (2001) and +\begin{equation} +T(\bk,\bk_1,\bk_2,\bk_3) = \frac{\pi g^2 D^2(\bk,\bk_1,\bk_2,\bk_3) }{4 \sigma \sigma_1 \sigma_2 \sigma_3} +\end{equation} +where $ D(\bk,\bk_1,\bk_2,\bk_3)$ is given by \cite{Webb1978} in his eq. (A1). + +This triple integral is performed using quadrature functions to best resolve the effect of the singularities in the denominator. It is thus replaced with weighted sums over the 3 dimensions. + +Compared to the DIA, there is no bilinear interpolation and the nearest neighbor is used in frequency and direction. Also, +the source term is computed by a loop over the quadruplet configuration, which allows for filtering based on +both the value of the coupling coefficient and the energy level at the frequency corresponding to $\bk$. Within +that loop, the source term contribution is computed for all 4 interacting components, so that any filtering still +conserves energy, action, momentum ... (One may argue that this multiplies by 4 the number of calculations, but it may have the benefit of properly dealing with the high frequency boundary... this is to be verified. The same question arises for the DIA: why have the wavenumber $\bk$ play the role of the other members of the quadruplets when this will also be computed as we loop on the spectral components?). + +If a very aggressive filtering is performed, the source may need to be rescaled. + diff --git a/manual/impl/switch.tex b/manual/impl/switch.tex index 856a7d2184..22ab75f344 100644 --- a/manual/impl/switch.tex +++ b/manual/impl/switch.tex @@ -94,7 +94,7 @@ \subsubsection{~Mandatory switches} \label{sub:man_switch} Selection of nonlinear interactions: \begin{slist} \sit{nl0} {No nonlinear interactions used.} -\sit{nl1} {Discrete interaction approximation (\dia).} +\sit{nl1} {Discrete interaction approximation (\dia) or Gaussian Quadrature Method (GQM).} \sit{nl2} {Exact interaction approximation (\xnl).} \sit{nl3} {Generalized Multiple \dia\ (\gmd).} \sit{nl4} {Two-scale approximation (TSA).} diff --git a/manual/manual.bib b/manual/manual.bib index 8cb9734fbf..0aacb51054 100644 --- a/manual/manual.bib +++ b/manual/manual.bib @@ -3664,3 +3664,23 @@ @article{art:DC23 volume = {}, year = {2023} } + +@ARTICLE{Lavrenov2001, + author = "Igor V. Lavrenov", + title = "Effect of wind wave parameter fluctuation on the nonlinear spectrum evolution", + journal = JPO, + volume = 31, + pages = "861--873", + year = 2001, + url="http://ams.allenpress.com/archive/1520-0485/31/4/pdf/i1520-0485-31-4-861", + keywords={4-wave interactions,GQM}, +} + + +@PHDTHESIS{Gagnaire-Renou2009, + author = "Elodie Gagnaire-Renou", + title = "Amelioration de la modelisation spectrale des etats de mer par un calcul quasi-exact des interactions non-lineaires vague-vague", + school = "Universit{\'e} du Sud Toulon Var", + year = 2010, +} + diff --git a/model/inp/ww3_grid.inp b/model/inp/ww3_grid.inp index b802c67178..655a10493d 100644 --- a/model/inp/ww3_grid.inp +++ b/model/inp/ww3_grid.inp @@ -102,6 +102,18 @@ $ KDCONV : Factor before kd in Eq. (n.nn). $ KDMIN, SNLCS1, SNLCS2, SNLCS3 : $ Minimum kd, and constants c1-3 $ in depth scaling function. +$ IQTYPE : Type of depth treatment +$ -2 : Deep water GQM with scaling +$ 1 : Deep water DIA +$ 2 : Deep water DIA with scaling +$ 3 : Shallow water DIA +$ TAILNL : Parametric tail power. +$ GQMNF1 : number of points along the locus +$ GQMNT1 : idem +$ GQMNQ_OM2 : idem +$ GQMTHRSAT : threshold on saturation for SNL calculation +$ GQMTHRCOU : threshold for filter on coupling coefficient +$ GQAMP1, GQAMP2, GQAMP3, GQAMP4 : amplification factor $ Exact interactions : Namelist SNL2 $ IQTYPE : Type of depth treatment $ 1 : Deep water diff --git a/model/nml/namelists.nml b/model/nml/namelists.nml index 7b373c71e9..390fdb8745 100644 --- a/model/nml/namelists.nml +++ b/model/nml/namelists.nml @@ -81,6 +81,16 @@ $ KDCONV : Factor before kd in Eq. (n.nn). $ KDMIN, SNLCS1, SNLCS2, SNLCS3 : $ Minimum kd, and constants c1-3 $ in depth scaling function. +$ IQTYPE : Type of depth treatment +$ -2 : Deep water GQM with scaling +$ 1 : Deep water DIA +$ 2 : Deep water DIA with scaling +$ 3 : Shallow water DIA +$ TAILNL : Parametric tail power. +$ GQMNF1, GQMNT1, GQMNQ_OM2 : Gaussian quadrature resolution +$ GQMTHRSAT : Threshold on saturation for SNL calculation +$ GQMTHRCOU : Threshold for filter on coupling coefficient +$ GQAMP1, GQAMP2, GQAMP3, GQAMP4 : Amplification factors $ Exact interactions : Namelist SNL2 $ IQTYPE : Type of depth treatment $ 1 : Deep water diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 6cd6e91d8f..7bc5e2f303 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -429,6 +429,17 @@ MODULE W3GDATMD ! KDCON Real Public Conversion factor for relative depth. ! KDMN Real Public Minimum relative depth. ! SNLSn Real Public Constants in shallow water factor. + ! IQTPE Int. Public Type of depth treatment + ! -2 : Deep water GQM with scaling + ! 1 : Deep water DIA + ! 2 : Deep water DIA with scaling + ! 3 : Finite water depth DIA + ! GQNF1 Int. Public Gaussian quadrature resolution + ! GQNT1 Int. Public Gaussian quadrature resolution + ! GQNNQ_OM2 Int. Public Gaussian quadrature resolution + ! GQTHRSAT Real Public Threshold on saturation for SNL calculation + ! GQTHRCOU Real Public Threshold for filter on coupling coefficient + ! GQAMP R.A. Public Amplification factors ! (!/NL2) ! IQTPE Int. Public Type of depth treatment ! 1 : Deep water @@ -910,6 +921,8 @@ MODULE W3GDATMD #ifdef W3_NL1 REAL :: SNLC1, LAM, KDCON, KDMN, & SNLS1, SNLS2, SNLS3 + INTEGER :: IQTPE, GQNF1, GQNT1, GQNQ_OM2 + REAL :: NLTAIL, GQTHRSAT, GQTHRCOU, GQAMP(4) #endif #ifdef W3_NL2 INTEGER :: IQTPE, NDPTHS @@ -1319,6 +1332,8 @@ MODULE W3GDATMD !/ Data aliasses for structure SNLP(S) !/ #ifdef W3_NL1 + INTEGER, POINTER :: IQTPE, GQNF1, GQNT1, GQNQ_OM2 + REAL, POINTER :: NLTAIL, GQTHRSAT, GQTHRCOU, GQAMP(:) REAL, POINTER :: SNLC1, LAM, KDCON, KDMN, & SNLS1, SNLS2, SNLS3 #endif @@ -2690,6 +2705,14 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) SNLS1 => MPARS(IMOD)%SNLPS%SNLS1 SNLS2 => MPARS(IMOD)%SNLPS%SNLS2 SNLS3 => MPARS(IMOD)%SNLPS%SNLS3 + IQTPE => MPARS(IMOD)%SNLPS%IQTPE + GQNF1 => MPARS(IMOD)%SNLPS%GQNF1 + GQNT1 => MPARS(IMOD)%SNLPS%GQNT1 + GQNQ_OM2 => MPARS(IMOD)%SNLPS%GQNQ_OM2 + NLTAIL => MPARS(IMOD)%SNLPS%NLTAIL + GQTHRSAT => MPARS(IMOD)%SNLPS%GQTHRSAT + GQTHRCOU=> MPARS(IMOD)%SNLPS%GQTHRCOU + GQAMP=> MPARS(IMOD)%SNLPS%GQAMP #endif #ifdef W3_NL2 IQTPE => MPARS(IMOD)%SNLPS%IQTPE diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index aa618b59f7..fa8128afb4 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -113,6 +113,7 @@ MODULE W3GRIDMD !/ 27-May-2021 : Moved to a subroutine ( version 7.13 ) !/ 07-Jun-2021 : S_{nl} GKE NL5 (Q. Liu) ( version 7.13 ) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) + !/ 28-Feb-2023 : GQM as an alternative for NL1 ( version 7.15 ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -439,7 +440,7 @@ MODULE W3GRIDMD ! (2006) input and Babanin et al. (2001,2010) dissipation. ! ! !/NL0 No nonlinear interactions. - ! !/NL1 Discrete interaction approximation (DIA). + ! !/NL1 Discrete interaction approximation (DIA or GQM). ! !/NL2 Exact interactions (WRT). ! !/NL3 Generalized Multiple DIA (GMD). ! !/NL4 Two Scale Approximation @@ -867,6 +868,8 @@ MODULE W3GRIDMD #ifdef W3_NL1 REAL :: LAMBDA, KDCONV, KDMIN, & SNLCS1, SNLCS2, SNLCS3 + INTEGER :: IQTYPE, GQMNF1, GQMNT1, GQMNQ_OM2 + REAL :: TAILNL, GQMTHRSAT, GQMTHRCOU, GQAMP1, GQAMP2, GQAMP3, GQAMP4 #endif #ifdef W3_NL2 INTEGER :: IQTYPE, NDEPTH @@ -998,7 +1001,9 @@ MODULE W3GRIDMD #endif #ifdef W3_NL1 NAMELIST /SNL1/ LAMBDA, NLPROP, KDCONV, KDMIN, & - SNLCS1, SNLCS2, SNLCS3 + SNLCS1, SNLCS2, SNLCS3, & + IQTYPE, TAILNL, GQMNF1, GQMNT1, & + GQMNQ_OM2, GQMTHRSAT, GQMTHRCOU, GQAMP1, GQAMP2, GQAMP3, GQAMP4 #endif #ifdef W3_NL2 NAMELIST /SNL2/ IQTYPE, TAILNL, NDEPTH @@ -1831,6 +1836,18 @@ SUBROUTINE W3GRID() SNLCS1 = 5.5 SNLCS2 = 0.833 SNLCS3 = -1.25 + ! Additional parameters for GQM + IQTYPE = 1 + TAILNL = -FACHF + GQMNF1 = 14 + GQMNT1 = 8 + GQMNQ_OM2=8 + GQMTHRSAT=0. + GQMTHRCOU=0.015 + GQAMP1=1. + GQAMP2=0.002 + GQAMP3=1. + GQAMP4=1. CALL READNL ( NDSS, 'SNL1', STATUS ) WRITE (NDSO,922) STATUS WRITE (NDSO,923) LAMBDA, NLPROP, KDCONV, KDMIN, & @@ -1842,6 +1859,18 @@ SUBROUTINE W3GRID() SNLS1 = SNLCS1 SNLS2 = SNLCS2 SNLS3 = SNLCS3 + ! Additional parameters for GQM + IQTPE = IQTYPE + GQNF1 = GQMNF1 + GQNT1 = GQMNT1 + GQNQ_OM2 = GQMNQ_OM2 + GQTHRSAT = GQMTHRSAT + GQTHRCOU = GQMTHRCOU + GQAMP(1) = GQAMP1 + GQAMP(2) = GQAMP2 + GQAMP(3) = GQAMP3 + GQAMP(4) = GQAMP4 + NLTAIL = TAILNL #endif ! #ifdef W3_ST0 @@ -3175,7 +3204,10 @@ SUBROUTINE W3GRID() #endif #ifdef W3_NL1 WRITE (NDSO,2922) LAMBDA, NLPROP, KDCONV, KDMIN, & - SNLCS1, SNLCS2, SNLCS3 + SNLCS1, SNLCS2, SNLCS3, & + IQTYPE, TAILNL, GQMNF1, & + GQMNT1, GQMNQ_OM2, GQMTHRSAT, GQMTHRCOU,& + GQAMP1, GQAMP2, GQAMP3, GQAMP4 #endif #ifdef W3_NL2 WRITE (NDSO,2922) IQTYPE, TAILNL, NDEPTH @@ -6230,7 +6262,11 @@ SUBROUTINE W3GRID() 2922 FORMAT ( ' &SNL1 LAMBDA =',F7.3,', NLPROP =',E10.3, & ', KDCONV =',F7.3,', KDMIN =',F7.3,','/ & ' SNLCS1 =',F7.3,', SNLCS2 =',F7.3, & - ', SNLCS3 = ',F7.3,' /') + ', SNLCS3 = ',F7.3','/ & + ' IQTYPE =',I2,', TAILNL =',F5.1,','/ & + ' GQMNF1 =',I2,', GQMNT1 =',I2,',', & + ' GQMNQ_OM2 =',I2,', GQMTHRSAT =',E11.4,', GQMTHRCOU =',F4.3,','/ & + ' GQAMP1 =',F5.3,', GQAMP2 =',F5.3,', GQAMP3 =',F5.3,', GQAMP4 =',F5.3,' /') #endif ! #ifdef W3_NL2 diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index e96b7b7882..4f211402d5 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -284,7 +284,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & DIKCUMUL #endif #ifdef W3_NL1 - USE W3SNL1MD, ONLY: INSNL1 + USE W3SNL1MD, ONLY: INSNL1, INSNLGQM #endif #ifdef W3_NL2 USE W3SNL2MD, ONLY: INSNL2 @@ -1580,18 +1580,28 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #ifdef W3_NL1 IF ( WRITE ) THEN WRITE (NDSM) & - SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP #ifdef W3_ASCII WRITE (NDSA,*) & - 'SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3:',& - SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 + 'SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP:', & + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP #endif ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3 + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP END IF IF ( FLTEST ) WRITE (NDST,9051) SNLC1, LAM, & - KDCON, KDMN, SNLS1, SNLS2, SNLS3 + KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, GQNQ_OM2, & + GQTHRSAT, GQTHRCOU, GQAMP #endif ! #ifdef W3_NL2 @@ -1713,7 +1723,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif ! #ifdef W3_NL1 - IF ( .NOT. WRITE ) CALL INSNL1 ( IGRD ) + IF ( .NOT. WRITE ) THEN + IF (IQTPE.GT.0) THEN + CALL INSNL1 ( IGRD ) + ELSE + CALL INSNLGQM + END IF + END IF #endif #ifdef W3_NL3 IF ( .NOT. WRITE ) CALL INSNL3 diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index e21349edef..598b627ea6 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -28,7 +28,7 @@ MODULE W3SNL1MD !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | - !/ | Last update : 03-Sep-2012 | + !/ | Last update : 28-Feb-2023 | !/ +-----------------------------------+ !/ !/ 04-Feb-2000 : Origination. ( version 2.00 ) @@ -36,6 +36,7 @@ MODULE W3SNL1MD !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 ) !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 03-Sep-2012 : Clean up of test output T0, T1 ( version 4.07 ) + !/ 28-Feb-2023 : Adds GQM separate routines ( version 7.07 ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -77,8 +78,22 @@ MODULE W3SNL1MD ! !/ ------------------------------------------------------------------- / !/ + !/ PUBLIC !/ + !/ These are the arrays and variables used for GQM method + !/ + INTEGER :: NCONF + INTEGER, ALLOCATABLE :: K_IF2 (:,:,:) , K_IF3 (:,:,:) , K_1P2P(:,:,:) , & + K_1P3M(:,:,:) , K_1P2M(:,:,:) , K_1P3P(:,:,:) , & + K_1M2P(:,:,:) , K_1M3M(:,:,:) , K_1M2M(:,:,:) , & + K_1M3P(:,:,:) + INTEGER, ALLOCATABLE :: F_POIN(:) , T_POIN(:) , K_IF1(:) , K_1P(:,:) , & + K_1M(:,:) , IDCONF(:,:) + DOUBLE PRECISION, ALLOCATABLE :: F_COEF(:) , F_PROJ(:) , TB_SCA(:) , TB_V14(:) + DOUBLE PRECISION, ALLOCATABLE :: TB_V24(:,:,:) , TB_V34(:,:,:) , & + TB_TPM(:,:,:) , TB_TMP(:,:,:) , TB_FAC(:,:,:) + !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -768,6 +783,1353 @@ SUBROUTINE INSNL1 ( IMOD ) !/ End of INSNL1 ----------------------------------------------------- / !/ END SUBROUTINE INSNL1 + + !/ ------------------------------------------------------------------- / + SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) + ! This and the following routines are adapted to WW3 from TOMAWAC qnlin3.f + !*********************************************************************** + ! TOMAWAC V6P1 24/06/2011 + !*********************************************************************** + ! + !brief COMPUTES THE CONTRIBUTION OF THE NON-LINEAR INTERACTIONS + !+ SOURCE TERM BETWEEN QUADRUPLETS USING THE GQM METHOD + !+ ("GAUSSIAN QUADRATURE METHOD") PROPOSED BY LAVRENOV + !+ (2001) + !+ + !+ PROCEDURE SPECIFIC TO THE CASE WHERE THE FREQUENCIES + !+ FOLLOW A GEOMETRICAL PROGRESSION AND THE DIRECTIONS + !+ ARE EVENLY DISTRIBUTED OVER [0;2.PI]. + ! + !note THIS SUBROUTINE USES THE OUTPUT FROM 'PRENL3' TO OPTIMISE + !+ THE COMPUTATIONS FOR DIA. + ! + !reference LAVRENOV, I.V. (2001): + !+ "EFFECT OF WIND WAVE PARAMETER FLUCTUATION ON THE NONLINEAR + !+ SPECTRUM EVOLUTION". J. PHYS. OCEANOGR. 31, 861-873. + ! + !history E. GAGNAIRE-RENOU + !+ 04/2011 + !+ V6P1 + !+ CREATED + ! + !history G.MATTAROLO (EDF - LNHE) + !+ 24/06/2011 + !+ V6P1 + !+ Translation of French names of the variables in argument + + ! + !/ Warning, contrary to the DIA routine, there is no extension to frequencies below IK=1 + !/ as a result the first two frequencies are not fully treated. + !================================================================================== + ! This subroutine is same as qnlin3 in TOMWAC + USE CONSTANTS, ONLY: TPI + USE W3GDATMD, ONLY: SIG, NK , NTH , DTH, XFR, FR1, GQTHRSAT, GQAMP + + REAL, intent(in) :: A(NTH,NK), CG(NK), WN(NK) + REAL, intent(in) :: DEPTH + REAL, intent(out) :: TSTOTn(NTH,NK), TSDERn(NTH,NK) + + INTEGER :: ITH,IK,NT,NF + REAL :: q_dfac, SATVAL(NK), SUME, ACCVAL, ACCMAX, AMPFAC + DOUBLE PRECISION :: RAISF, FREQ(NK) + DOUBLE PRECISION :: TSTOT(NTH,NK) , TSDER(NTH,NK), F(NTH,NK) + DOUBLE PRECISION :: TEMP + + !.....LOCAL VARIABLES + INTEGER JF , JT , JF1 , JT1 , IQ_OM2 & + , JFM0 , JFM1 , JFM2 , JFM3 , IXF1 , IXF2 & + , IXF3 , JFMIN , JFMAX , ICONF , LBUF + INTEGER KT1P , KT1M , JT1P , JT1M , KT1P2P, KT1P2M & + , KT1P3P, KT1P3M, KT1M2P, KT1M2M, KT1M3P, KT1M3M & + , JT1P2P, JT1P2M, JT1P3P, JT1P3M, JT1M2P, JT1M2M & + , JT1M3P, JT1M3M + DOUBLE PRECISION V1_4 , V2_4 , V3_4 , Q_2P3M, Q_2M3P, FACTOR & + , T_2P3M, T_2M3P, S_2P3M, S_2M3P, SCAL_T, T2P3M & + , T2M3P , SP0 , SP1P , SP1M , SP1P2P, SP1P2M & + , SP1P3P, SP1P3M, SP1M2P, SP1M2M, SP1M3P, SP1M3M & + , CF0 , CP0 , CF1 , CP1 , CF2 , CP2 & + , CF3 , CP3 , Q2PD0 , Q2PD1 , Q2PD2P, Q2PD3M & + , Q2MD0 , Q2MD1 , Q2MD2M, Q2MD3P ,AUX00 , AUX01 & + , AUX02 , AUX03 , AUX04 , AUX05 , SEUIL & + , AUX06 , AUX07 , AUX08 , AUX09 , AUX10 , FSEUIL + + NT = NTH + NF = NK + LBUF = 500 + SEUIL = 0. + RAISF = XFR + + DO IK = 1,NK + FREQ(IK) = FR1*RAISF**(IK-1) + ENDDO + + DO ITH = 1,NTH + DO IK = 1,NK + ! F is the E(f,theta) spectrum ... + F(ITH,IK) = DBLE(A(ITH,IK)*SIG(IK))*DBLE(TPI)/DBLE(CG(IK)) + ENDDO + ENDDO + ! CALL INSNLGQM + ! it returns: F_POIN , T_POIN , F_COEF , F_PROJ, TB_SCA , K_IF1, K_1P, k_1M , K_IF2 + ! K_IF3, K_1P2P , K_1P3M , K_1P2M , K_1P3P , K_1M2P , K_1M3M , K_1M2M + ! K_1M3P , TB_V14 , TB_FAC , TB_V24 , TB_V34 , TB_TMP , TB_TPM , IDCONF, NCONF + !======================================================================= + ! COMPUTES THE GENERALIZED MIN AND MAX FREQUENCIES : INSTEAD OF GOING + ! FROM 1 TO NF IN FREQ(JF) FOR THE MAIN FREQUENCY, IT GOES FROM JFMIN + ! TO JFMAX + ! JFMIN IS GIVEN BY Fmin=FREQ(1) /Gamma_min + ! JFMAX IS GIVEN BY Fmax=FREQ(NF)*Gamma_max + ! TESTS HAVE SHOWN THAT IT CAN BE ASSUMED Gamma_min=1. (JFMIN=1) AND + ! Gamma_max=1.3 (JFMAX>NF) TO OBTAIN IMPROVED RESULTS + ! Note by Fabrice Ardhuin: this appears to give the difference in tail benaviour with Gerbrant's WRT + !======================================================================= + JFMIN= 1-INT(LOG(1.0D0)/LOG(RAISF)) + JFMAX=NF+INT(LOG(1.3D0)/LOG(RAISF)) + ! + !======================================================================= + ! COMPUTES THE SPECTRUM THRESHOLD VALUES (BELOW WHICH QNL4 IS NOT + ! CALCULATED). THE THRESHOLD IS SET WITHIN 0 AND 1. + ! This was commented by FA + !======================================================================= + ! AUX00=0.0D0 + ! DO JF=1,NF + ! DO JT=1,NT + ! IF (F(JT,JF).GT.AUX00) AUX00=F(JT,JF) + ! ENDDO + ! ENDDO + ! FSEUIL=AUX00*SEUIL + + TSTOT = 0. + TSDER = 0. + !======================================================================= + ACCMAX=0. + DO JF=JFMIN,JFMAX + SUME=SUM(F(:,JF))*DTH + SATVAL(JF) = SUME*FREQ(JF)**5 + ACCVAL = SUME*FREQ(JF)**4 + IF (ACCVAL.GT.ACCMAX) ACCMAX=ACCVAL + END DO + + + ! ================================================== + ! STARTS LOOP 1 OVER THE SELECTED CONFIGURATIONS + ! ================================================== + DO ICONF=1,NCONF + ! ---------selected configuration characteristics + JF1 =IDCONF(ICONF,1) + JT1 =IDCONF(ICONF,2) + IQ_OM2=IDCONF(ICONF,3) + ! + ! ---------Recovers V1**4=(f1/f0)**4 + V1_4 =TB_V14(JF1) + ! ---------Recovers the shift of the frequency index on f1 + IXF1 =K_IF1(JF1) + ! ---------Recovers the direction indexes for Delat1 + KT1P =K_1P(JT1,JF1) + KT1M =K_1M(JT1,JF1) + ! ---------Recovers V2**4=(f2/f0)**4 and V3**4=(f3/f0)**4 + V2_4 =TB_V24(IQ_OM2,JT1,JF1) + V3_4 =TB_V34(IQ_OM2,JT1,JF1) + ! ---------Recovers the frequency indexes shift on f2 and f3 + IXF2 =K_IF2 (IQ_OM2,JT1,JF1) + IXF3 =K_IF3 (IQ_OM2,JT1,JF1) + ! ---------Recovers the direction indexes shift + KT1P2P=K_1P2P(IQ_OM2,JT1,JF1) + KT1P2M=K_1P2M(IQ_OM2,JT1,JF1) + KT1P3P=K_1P3P(IQ_OM2,JT1,JF1) + KT1P3M=K_1P3M(IQ_OM2,JT1,JF1) + KT1M2P=K_1M2P(IQ_OM2,JT1,JF1) + KT1M2M=K_1M2M(IQ_OM2,JT1,JF1) + KT1M3P=K_1M3P(IQ_OM2,JT1,JF1) + KT1M3M=K_1M3M(IQ_OM2,JT1,JF1) + ! ---------Recovers the coupling coefficients + T2P3M =TB_TPM(IQ_OM2,JT1,JF1) + T2M3P =TB_TMP(IQ_OM2,JT1,JF1) + ! ---------Recovers the multiplicative factor of QNL4 + FACTOR=TB_FAC(IQ_OM2,JT1,JF1) + + ! = = = = = = = = = = = = = = = = = = = = = = = = = + ! STARTS LOOP 2 OVER THE SPECTRUM FREQUENCIES + ! = = = = = = = = = = = = = = = = = = = = = = = = = + DO JF=JFMIN,JFMAX + IF (SATVAL(JF).GT.GQTHRSAT) THEN + ! + !.........Recovers the coefficient for the coupling factor + !.........Computes the coupling coefficients for the case +Delta1 (SIG=1) + SCAL_T=TB_SCA(LBUF+JF)*FACTOR + T_2P3M=T2P3M*SCAL_T + T_2M3P=T2M3P*SCAL_T + ! + !.........Frequency indexes and coefficients + JFM0=F_POIN(JF+LBUF) + CF0 =F_COEF(JF+LBUF) + CP0 =F_PROJ(JF+LBUF) + JFM1=F_POIN(JF+IXF1) + CF1 =F_COEF(JF+IXF1) + CP1 =F_PROJ(JF+IXF1) + JFM2=F_POIN(JF+IXF2) + CF2 =F_COEF(JF+IXF2) + CP2 =F_PROJ(JF+IXF2) + JFM3=F_POIN(JF+IXF3) + CF3 =F_COEF(JF+IXF3) + CP3 =F_PROJ(JF+IXF3) + ! + ! ------------------------------------------------- + ! STARTS LOOP 3 OVER THE SPECTRUM DIRECTIONS + ! ------------------------------------------------- + DO JT=1,NT + ! + !...........Direction indexes + ! direct config (+delta1) (sig =1) + JT1P =T_POIN(JT+KT1P) + JT1P2P=T_POIN(JT+KT1P2P) + JT1P2M=T_POIN(JT+KT1P2M) + JT1P3P=T_POIN(JT+KT1P3P) + JT1P3M=T_POIN(JT+KT1P3M) + ! image config (-delta1) + JT1M =T_POIN(JT+KT1M) + JT1M2P=T_POIN(JT+KT1M2P) + JT1M2M=T_POIN(JT+KT1M2M) + JT1M3P=T_POIN(JT+KT1M3P) + JT1M3M=T_POIN(JT+KT1M3M) + ! + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! STARTS LOOP 4 OVER THE MESH NODES + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! + SP0=F(JT,JFM0)*CF0 + ! + ! IF (SP0.GT.FSEUIL) THEN + ! + ! Config. +Delta1 (SIG=1) + ! ======================= + !...............Computes the spectrum values in 1, 2, 3 + SP1P =F(JT1P ,JFM1)*CF1 + SP1P2P=F(JT1P2P,JFM2)*CF2 + SP1P3M=F(JT1P3M,JFM3)*CF3 + SP1P2M=F(JT1P2M,JFM2)*CF2 + SP1P3P=F(JT1P3P,JFM3)*CF3 + ! + !...............Computes auxiliary products and variables + AUX01=SP0*V1_4+SP1P + AUX02=SP0*SP1P + AUX03=SP1P2P*SP1P3M + AUX04=SP1P2P*V3_4+SP1P3M*V2_4 + AUX05=SP1P2M*SP1P3P + AUX06=SP1P2M*V3_4+SP1P3P*V2_4 + AUX07=AUX02*V3_4 + AUX08=AUX02*V2_4 + ! + !...............Computes the components of the transfer term + S_2P3M=AUX03*AUX01-AUX02*AUX04 + S_2M3P=AUX05*AUX01-AUX02*AUX06 + Q_2P3M=T_2P3M*S_2P3M + Q_2M3P=T_2M3P*S_2M3P + AUX00 =Q_2P3M+Q_2M3P + ! + !...............Computes the components of the derived terms (dQ/dF) + Q2PD0 =T_2P3M*(AUX03*V1_4 - SP1P*AUX04)*CF0 + Q2PD1 =T_2P3M*(AUX03 - SP0 *AUX04)*CF1 + Q2PD2P=T_2P3M*(AUX01*SP1P3M - AUX07 )*CF2 + Q2PD3M=T_2P3M*(AUX01*SP1P2P - AUX08 )*CF3 + Q2MD0 =T_2M3P*(AUX05*V1_4 - SP1P*AUX06)*CF0 + Q2MD1 =T_2M3P*(AUX03 - SP0 *AUX06)*CF1 + Q2MD2M=T_2M3P*(AUX01*SP1P3P - AUX07 )*CF2 + Q2MD3P=T_2M3P*(AUX01*SP1P2M - AUX08 )*CF3 + AUX09=Q2PD0+Q2MD0 + AUX10=Q2PD1+Q2MD1 + ! + !...............Sum of Qnl4 term in the table TSTOT + TSTOT(JT,JFM0 )=TSTOT(JT,JFM0 )+AUX00 *CP0 + TSTOT(JT1P,JFM1 )=TSTOT(JT1P,JFM1 )+AUX00 *CP1 + TSTOT(JT1P2P,JFM2)=TSTOT(JT1P2P,JFM2)-Q_2P3M*CP2 + TSTOT(JT1P2M,JFM2)=TSTOT(JT1P2M,JFM2)-Q_2M3P*CP2 + TSTOT(JT1P3M,JFM3)=TSTOT(JT1P3M,JFM3)-Q_2P3M*CP3 + TSTOT(JT1P3P,JFM3)=TSTOT(JT1P3P,JFM3)-Q_2M3P*CP3 + ! + !...............Sum of the term dQnl4/dF in the table TSDER + TSDER(JT,JFM0)=TSDER(JT,JFM0)+AUX09 *CP0 + TSDER(JT1P,JFM1)=TSDER(JT1P,JFM1)+AUX10 *CP1 + TSDER(JT1P2P,JFM2)=TSDER(JT1P2P,JFM2)-Q2PD2P*CP2 + TSDER(JT1P2M,JFM2)=TSDER(JT1P2M,JFM2)-Q2MD2M*CP2 + TSDER(JT1P3M,JFM3)=TSDER(JT1P3M,JFM3)-Q2PD3M*CP3 + TSDER(JT1P3P,JFM3)=TSDER(JT1P3P,JFM3)-Q2MD3P*CP3 +#ifdef W3_TGQM + ! Test output to set up triplet method ... + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT, JFM0,AUX00 *CP0, F(JT,JFM0),TSTOT(JT ,JFM0) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P, JFM1,AUX00 *CP1, F(JT1P,JFM1),TSTOT(JT1P,JFM1) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2P,JFM2,-Q_2P3M*CP2,F(JT1P2P,JFM2),TSTOT(JT1P2P,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2M,JFM2,-Q_2M3P*CP2,F(JT1P2M,JFM2),TSTOT(JT1P2M,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3M,JFM2,-Q_2P3M*CP3,F(JT1P3M,JFM3),TSTOT(JT1P3M,JFM3) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3P,JFM2,-Q_2M3P*CP3,F(JT1P3P,JFM3),TSTOT(JT1P3P,JFM3) + TEMP=(TB_TPM(IQ_OM2,JT1,JF1)*(( F(JT1P2P,JFM2)*CF2 *F(JT1P3M,JFM3)*CF3)* & + (F(JT,JFM0 )*CF0*TB_V14(JF1)+F(JT1P ,JFM1)*CF1) & + -SP0*SP1P*(SP1P2P*V3_4+SP1P3M*V2_4))+T_2M3P*(AUX05*AUX01-AUX02*AUX06)) *CP0 + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT, F(JT,JFM0) + TEMP=(Q_2P3M+Q_2M3P) *CP1 + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P, JFM1,AUX00 *CP1, F(JT1P,JFM1),TSTOT(JT1P,JFM1) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2P,JFM2,-Q_2P3M*CP2,F(JT1P2P,JFM2),TSTOT(JT1P2P,JFM2) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2M,JFM2,-Q_2M3P*CP2,F(JT1P2M,JFM2),TSTOT(JT1P2M,JFM2) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3M,JFM2,-Q_2P3M*CP3,F(JT1P3M,JFM3),TSTOT(JT1P3M,JFM3) + WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P3P,JFM2,-Q_2M3P*CP3,F(JT1P3P,JFM3),TSTOT(JT1P3P,JFM3) +#endif + ! + ! Config. -Delta1 (SIG=-1) + ! ======================== + !...............Computes the spectrum values in 1, 2, 3 + SP1M =F(JT1M ,JFM1)*CF1 + SP1M2P=F(JT1M2P,JFM2)*CF2 + SP1M3M=F(JT1M3M,JFM3)*CF3 + SP1M2M=F(JT1M2M,JFM2)*CF2 + SP1M3P=F(JT1M3P,JFM3)*CF3 + ! + !...............Computes auxiliary products and variables + AUX01=SP0*V1_4+SP1M + AUX02=SP0*SP1M + AUX03=SP1M2P*SP1M3M + AUX04=SP1M2P*V3_4+SP1M3M*V2_4 + AUX05=SP1M2M*SP1M3P + AUX06=SP1M2M*V3_4+SP1M3P*V2_4 + AUX07=AUX02*V3_4 + AUX08=AUX02*V2_4 + ! + !...............Computes the transfer term components + S_2P3M=AUX03*AUX01-AUX02*AUX04 + S_2M3P=AUX05*AUX01-AUX02*AUX06 + Q_2P3M=T_2M3P*S_2P3M + Q_2M3P=T_2P3M*S_2M3P + AUX00 =Q_2P3M+Q_2M3P ! Same as in +Delta1, can be commented out + ! + !...............Computes the derived terms components (dQ/dF) + Q2PD0 =T_2P3M*(AUX03*V1_4 - SP1M*AUX04)*CF0 + Q2PD1 =T_2P3M*(AUX03 - SP0 *AUX04)*CF1 + Q2PD2P=T_2P3M*(AUX01*SP1M3M - AUX07 )*CF2 + Q2PD3M=T_2P3M*(AUX01*SP1M2P - AUX08 )*CF3 + Q2MD0 =T_2M3P*(AUX05*V1_4 - SP1M*AUX06)*CF0 + Q2MD1 =T_2M3P*(AUX03 - SP0 *AUX06)*CF1 + Q2MD2M=T_2M3P*(AUX01*SP1M3P - AUX07 )*CF2 + Q2MD3P=T_2M3P*(AUX01*SP1M2M - AUX08 )*CF3 + AUX09=Q2PD0+Q2MD0 + AUX10=Q2PD1+Q2MD1 + ! + !...............Sum of Qnl4 term in the table TSTOT + TSTOT(JT ,JFM0)=TSTOT(JT ,JFM0)+AUX00 *CP0 + TSTOT(JT1M ,JFM1)=TSTOT(JT1M ,JFM1)+AUX00 *CP1 + TSTOT(JT1M2P,JFM2)=TSTOT(JT1M2P,JFM2)-Q_2P3M*CP2 + TSTOT(JT1M2M,JFM2)=TSTOT(JT1M2M,JFM2)-Q_2M3P*CP2 + TSTOT(JT1M3M,JFM3)=TSTOT(JT1M3M,JFM3)-Q_2P3M*CP3 + TSTOT(JT1M3P,JFM3)=TSTOT(JT1M3P,JFM3)-Q_2M3P*CP3 + ! + !...............Sum of the term dQnl4/dF in the table TSDER + TSDER(JT ,JFM0)=TSDER(JT ,JFM0)+AUX09 *CP0 + TSDER(JT1M ,JFM1)=TSDER(JT1M ,JFM1)+AUX10 *CP1 + TSDER(JT1M2P,JFM2)=TSDER(JT1M2P,JFM2)-Q2PD2P*CP2 + TSDER(JT1M2M,JFM2)=TSDER(JT1M2M,JFM2)-Q2MD2M*CP2 + TSDER(JT1M3M,JFM3)=TSDER(JT1M3M,JFM3)-Q2PD3M*CP3 + TSDER(JT1M3P,JFM3)=TSDER(JT1M3P,JFM3)-Q2MD3P*CP3 + ! +#ifdef W3_TGQM + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT, JFM0,AUX00 *CP0, F(JT,JFM0),TSTOT(JT ,JFM0) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M, JFM1,AUX00 *CP1, F(JT1M,JFM1),TSTOT(JT1M,JFM1) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M2P,JFM2,-Q_2P3M*CP2,F(JT1M2P,JFM2),TSTOT(JT1M2P,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M2M,JFM2,-Q_2M3P*CP2,F(JT1M2M,JFM2),TSTOT(JT1M2M,JFM2) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M3M,JFM2,-Q_2P3M*CP3,F(JT1M3M,JFM3),TSTOT(JT1M3M,JFM3) + WRITE(994,'(5I3,3E12.3)') ICONF,JF,JT,JT1M3P,JFM2,-Q_2M3P*CP3,F(JT1M3P,JFM3),TSTOT(JT1M3P,JFM3) +#endif + ! + ! ENDIF ! this was the test on SEUIL + ! + ENDDO + ! ------------------------------------------------- + ! END OF LOOP 3 OVER THE SPECTRUM DIRECTIONS + ! ------------------------------------------------- + ! + ENDIF ! End of test on saturation level + ENDDO + ! = = = = = = = = = = = = = = = = = = = = = = = = = + ! END OF LOOP 2 OVER THE SPECTRUM FREQUENCIES + ! = = = = = = = = = = = = = = = = = = = = = = = = = + ! + ENDDO + ! ================================================== + ! END OF LOOP 1 OVER THE SELECTED CONFIGURATIONS + ! ================================================== + ! Applying WAM DEPTH SCALING ! to be added later ... + ! CALL q_dscale(F,WN,SIG,DTH,NK,NTH,DEPTH,q_dfac) + q_dfac=1 + + ! Amplification inspired by Lavrenov 2001, eq 10. + AMPFAC=GQAMP(4)*MIN(MAX(ACCMAX/GQAMP(2),1.)**GQAMP(1),GQAMP(3)) + !WRITE(991,*) ACCMAX,q_dfac,AMPFAC,GQAMP(1:3),SATVAL(10),SATVAL(30) + + ! Replacing Double Precision with Simple Real and scaling + TSTOTn = TSTOT*q_dfac*AMPFAC + TSDERn = TSDER*q_dfac*AMPFAC + + + ! Converting Snl(theta,f) to Snl(theta,k)/sigma + DO ITH = 1,NT + DO IK = 1,NF + TSTOTn(ITH,IK) = TSTOTn(ITH,IK)*CG(IK)/(TPI*SIG(IK)) + ENDDO + ENDDO + !CLOSE(994) + !STOP + END SUBROUTINE W3SNLGQM + + !/ ------------------------------------------------------------------- / + FUNCTION COUPLE(XK1 ,YK1 ,XK2 ,YK2 ,XK3 ,YK3 ,XK4 ,YK4) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | M. Benoit & E. Gagnaire-Renou | + !/ | Last update : 20-Nov-2022 | + !/ +-----------------------------------+ + !/ + !/ 19-Nov-2022 : Transfer from TOMAWAC code ( version 7.xx ) + !/ + ! 1. Purpose : + ! + ! Computes the 4-wave coupling coefficient used in Snl4 + ! + ! 2. Method : + ! + ! Uses theoretical expression by Webb (1978) + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! XK1 Real I x component of k1 wavenumber ... + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! INNSLGQM Subr. W3SNL2 Prepares source term integration. + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! + ! None. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + USE CONSTANTS, ONLY: GRAV + ! + DOUBLE PRECISION, INTENT(IN) :: XK1 , YK1 , XK2 , YK2 + DOUBLE PRECISION, INTENT(IN) :: XK3 , YK3 + DOUBLE PRECISION, INTENT(IN) :: XK4 , YK4 + DOUBLE PRECISION COUPLE + ! + !.....LOCAL VARIABLES + ! """""""""""""""""" + DOUBLE PRECISION RK1 , RK2 , RK3 , RK4 , WK1 , WK2 + DOUBLE PRECISION WK3 , WK4 , S12 , S13 , S14 , S23 + DOUBLE PRECISION S24 , S34 , W1P2 , Q12 , W1M3 , Q13 + DOUBLE PRECISION W1M4 , Q14 , DDD , COEF , DENO13, NUME13 + DOUBLE PRECISION DENO14, NUME14, ZERO, PI + + ! + PI = ACOS(-1.) + COEF=PI*GRAV*GRAV/4.D0 + ZERO=1.D-10 + ! + RK1=SQRT(XK1*XK1+YK1*YK1) + RK2=SQRT(XK2*XK2+YK2*YK2) + RK3=SQRT(XK3*XK3+YK3*YK3) + RK4=SQRT(XK4*XK4+YK4*YK4) + ! + WK1=SQRT(RK1) + WK2=SQRT(RK2) + WK3=SQRT(RK3) + WK4=SQRT(RK4) + ! + S12=XK1*XK2+YK1*YK2 + S13=XK1*XK3+YK1*YK3 + S14=XK1*XK4+YK1*YK4 + S23=XK2*XK3+YK2*YK3 + S24=XK2*XK4+YK2*YK4 + S34=XK3*XK4+YK3*YK4 + ! + W1P2=SQRT((XK1+XK2)*(XK1+XK2)+(YK1+YK2)*(YK1+YK2)) + W1M3=SQRT((XK1-XK3)*(XK1-XK3)+(YK1-YK3)*(YK1-YK3)) + W1M4=SQRT((XK1-XK4)*(XK1-XK4)+(YK1-YK4)*(YK1-YK4)) + Q12=(WK1+WK2)*(WK1+WK2) + Q13=(WK1-WK3)*(WK1-WK3) + Q14=(WK1-WK4)*(WK1-WK4) + ! + !.....COMPUTES THE D COEFFICIENT OF WEBB (1978) + ! """""""""""""""""""""""""""""""""""""" + DDD=2.00D0*Q12*(RK1*RK2-S12)*(RK3*RK4-S34)/(W1P2-Q12) & + +0.50D0*(S12*S34+S13*S24+S14*S23) & + +0.25D0*(S13+S24)*Q13*Q13 & + -0.25D0*(S12+S34)*Q12*Q12 & + +0.25D0*(S14+S23)*Q14*Q14 & + +2.50D0*RK1*RK2*RK3*RK4 & + +Q12*Q13*Q14*(RK1+RK2+RK3+RK4) + + DENO13=W1M3-Q13 + NUME13=2.00D0*Q13*(RK1*RK3+S13)*(RK2*RK4+S24) + IF (ABS(DENO13).LT.ZERO) THEN + IF (ABS(NUME13).LT.ZERO) THEN + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-3) 0/0 !' + ELSE + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-3) inifinte value' + ENDIF + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-3) term not used' + ELSE + DDD=DDD+NUME13/DENO13 + ENDIF + DENO14=W1M4-Q14 + NUME14=2.00D0*Q14*(RK1*RK4+S14)*(RK2*RK3+S23) + IF (ABS(DENO14).LT.ZERO) THEN + IF (ABS(NUME14).LT.ZERO) THEN + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-4) 0/0 !' + ELSE + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-4) inifinte value' + ENDIF + WRITE(*,*) 'W3SNL2 error for coupling coefficient : (1-4) term not used' + ELSE + DDD=DDD+NUME14/DENO14 + ENDIF + + COUPLE=COEF*DDD*DDD/(WK1*WK2*WK3*WK4) + ! RETURN + END FUNCTION COUPLE + + !/ ------------------------------------------------------------------- / + SUBROUTINE GAULEG (W_LEG ,X_LEG ,NPOIN) + !/ ------------------------------------------------------------------- / + !.....VARIABLES IN ARGUMENT + ! """""""""""""""""""" + INTEGER , INTENT(IN) :: NPOIN + DOUBLE PRECISION ,INTENT(INOUT) :: W_LEG(NPOIN) , X_LEG(NPOIN) + ! + !.....LOCAL VARIABLES + ! """"""""""""""""" + INTEGER I, M, J + DOUBLE PRECISION EPS, Z, P1, P2, P3, PP, Z1, PI + PARAMETER (EPS=3.D-14) + ! + PI = ACOS(-1.) + M=(NPOIN+1)/2 + DO I=1,M + Z=COS(PI*(DBLE(I)-0.25D0)/(DBLE(NPOIN)+0.5D0)) +1 CONTINUE + P1=1.0D0 + P2=0.0D0 + DO J=1,NPOIN + P3=P2 + P2=P1 + P1=((2.D0*DBLE(J)-1.D0)*Z*P2-(DBLE(J)-1.D0)*P3)/DBLE(J) + ENDDO + PP=DBLE(NPOIN)*(Z*P1-P2)/(Z*Z-1.D0) + Z1=Z + Z=Z-P1/PP + IF (ABS(Z-Z1).GT.EPS) GOTO 1 + X_LEG(I)=-Z + X_LEG(NPOIN+1-I)=Z + W_LEG(I)=2.D0/((1.D0-Z**2)*PP**2) + W_LEG(NPOIN+1-I)=W_LEG(I) + ENDDO + END SUBROUTINE GAULEG + + !/ ------------------------------------------------------------------- / + SUBROUTINE F1F1F1(F1SF,NF1,IQ_OM1) + ! TOMAWAC V6P3 15/06/2011 + !*********************************************************************** + ! + !brief SUBROUTINE CALLED BY PRENL3 + !+ COMPUTES VALUES OF RATIO F1/F AS FUNCTION OF THE IQ_OM1 + !+ INDICATOR + ! + !history E. GAGNAIRE-RENOU + !+ 04/2011 + !+ V6P1 + !+ CREATED + ! + !history G.MATTAROLO (EDF - LNHE) + !+ 15/06/2011 + !+ V6P1 + !+ Translation of French names of the variables in argument + ! + !history E. GAGNAIRE-RENOU + !+ 12/03/2013 + !+ V6P3 + !+ Better formatted: WRITE(LU,*), etc. + !/ ------------------------------------------------------------------- / + IMPLICIT NONE + INTEGER, INTENT(IN) :: IQ_OM1 + INTEGER, INTENT(INOUT) :: NF1 + DOUBLE PRECISION, INTENT(INOUT) :: F1SF(*) + ! + INTEGER I,M + DOUBLE PRECISION RAISON + ! + IF(IQ_OM1.EQ.1) THEN + IF(NF1.NE.14) THEN + WRITE(*,*) '#1 Incorrect value for NF1',NF1 + ENDIF + F1SF( 1)=0.30D0 + F1SF( 2)=0.40D0 + F1SF( 3)=0.50D0 + F1SF( 4)=0.60D0 + F1SF( 5)=0.70D0 + F1SF( 6)=0.80D0 + F1SF( 7)=0.90D0 + F1SF( 8)=1.00D0 + F1SF( 9)=1.11D0 + F1SF(10)=1.25D0 + F1SF(11)=1.42D0 + F1SF(12)=1.67D0 + F1SF(13)=2.00D0 + F1SF(14)=2.50D0 + F1SF(15)=3.30D0 + ELSEIF(IQ_OM1.EQ.2) THEN + IF (NF1.NE.26) THEN + WRITE(*,*) '#2 Incorrect value for NF1', NF1 + ENDIF + F1SF( 1)=0.32D0 + F1SF( 2)=0.35D0 + F1SF( 3)=0.39D0 + F1SF( 4)=0.44D0 + F1SF( 5)=0.50D0 + F1SF( 6)=0.56D0 + F1SF( 7)=0.63D0 + F1SF( 8)=0.70D0 + F1SF( 9)=0.78D0 + F1SF(10)=0.86D0 + F1SF(11)=0.92D0 + F1SF(12)=0.97D0 + F1SF(13)=1.00D0 + F1SF(14)=1.03D0 + F1SF(15)=1.08D0 + F1SF(16)=1.13D0 + F1SF(17)=1.20D0 + F1SF(18)=1.28D0 + F1SF(19)=1.37D0 + F1SF(20)=1.48D0 + F1SF(21)=1.50D0 + F1SF(22)=1.65D0 + F1SF(23)=1.85D0 + F1SF(24)=2.10D0 + F1SF(25)=2.40D0 + F1SF(26)=2.70D0 + F1SF(27)=3.20D0 + ELSEIF(IQ_OM1.EQ.3) THEN + IF(NF1.NE.11) THEN + WRITE(*,*) 'Incorrect value for NF1', NF1 + ENDIF + F1SF( 1)=0.30D0 + F1SF( 2)=0.48D0 + F1SF( 3)=0.64D0 + F1SF( 4)=0.78D0 + F1SF( 5)=0.90D0 + F1SF( 6)=1.00D0 + F1SF( 7)=1.12D0 + F1SF( 8)=1.28D0 + F1SF( 9)=1.50D0 + F1SF(10)=1.80D0 + F1SF(11)=2.40D0 + F1SF(12)=3.40D0 + ELSEIF(IQ_OM1.EQ.4) THEN + IF(NF1.NE.40) THEN + WRITE(*,*) 'Incorrect value for NF1', NF1 + ENDIF + NF1=20 + M=10 + RAISON=9.D0**(1.D0/DBLE(NF1)) + F1SF(M+1)=1.0D0/3.0D0 + NF1=2*M+NF1 + DO I=M+2,NF1+1 + F1SF(I)=F1SF(I-1)*RAISON + ENDDO + DO I=M,1,-1 + F1SF(I)=F1SF(I+1)/RAISON + ENDDO + ELSEIF(IQ_OM1.EQ.5) THEN + RAISON=9.D0**(1.D0/DBLE(NF1)) + F1SF(1)=1.D0/3.D0 + DO I=2,NF1+1 + F1SF(I)=F1SF(I-1)*RAISON + ENDDO + ELSEIF(IQ_OM1.EQ.6) THEN + RAISON=(3.D0-1.D0/3.D0)/DBLE(NF1) + F1SF(1)=1.D0/3.D0 + DO I=2,NF1+1 + F1SF(I)=F1SF(I-1)+RAISON + ENDDO + ELSEIF(IQ_OM1.EQ.7) THEN + IF(NF1.NE.20) THEN + WRITE(*,*) 'Incorrect value for NF1', NF1 + ENDIF + F1SF( 1)=1.D0/3.D0 + F1SF( 2)=0.40D0 + F1SF( 3)=0.46D0 + F1SF( 4)=0.52D0 + F1SF( 5)=0.60D0 + F1SF( 6)=0.70D0 + F1SF( 7)=0.79D0 + F1SF( 8)=0.86D0 + F1SF( 9)=0.92D0 + F1SF(10)=0.97D0 + F1SF(11)=1.00D0 + F1SF(12)=1.04D0 + F1SF(13)=1.10D0 + F1SF(14)=1.18D0 + F1SF(15)=1.28D0 + F1SF(16)=1.42D0 + F1SF(17)=1.60D0 + F1SF(18)=1.84D0 + F1SF(19)=2.14D0 + F1SF(20)=2.52D0 + F1SF(21)=3.00D0 + ENDIF + ! + END SUBROUTINE F1F1F1 + !/ ------------------------------------------------------------------- / + SUBROUTINE INSNLGQM + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | E. Gagnaire-Renou & | + !/ | M. Benoit | + !/ | S. Mostafa Siadatamousavi | + !/ | M. Beyramzadeh | + !/ | FORTRAN 90 | + !/ | Last update : 20-Nov-2022 | + !/ +-----------------------------------+ + !/ + !/ 20-Nov-2022 : Merging with NL2 in WW3. ( version 7.00 ) + !/ + ! 1. Purpose : + ! + ! Preprocessing for nonlinear interactions (Xnl). + ! + ! 2. Method : + ! + ! See Xnl documentation. + ! + ! 3. Parameters : + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD Subroutine tracing. + ! Subr. GAULEG Gauss-Legendre weights + ! xnl_init Subr. m_constants Xnl initialization routine. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! W3IOGR Subr. W3IOGRMD Model definition file management. + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! + ! 7. Remarks : + ! + ! 8. Structure : + ! + ! - See source code. + ! + ! 9. Switches : + ! + ! !/S Enable subroutine tracing. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + USE CONSTANTS, ONLY: GRAV + USE W3GDATMD, ONLY: NK , NTH , XFR , FR1, GQNF1, GQNT1, GQNQ_OM2, NLTAIL, GQTHRCOU + +#ifdef W3_S + CALL STRACE (IENT, 'INSNLGQM') +#endif + !.....LOCAL VARIABLES + INTEGER JF , JT , JF1 , JT1 , NF1P1 , IAUX , NT , NF , IK + INTEGER IQ_TE1 , IQ_OM2 , LBUF , DIMBUF , IQ_OM1 , NQ_TE1 , NCONFM + + DOUBLE PRECISION EPSI_A, AUX , CCC , DENO , AAA , DP2SG , TAILF + DOUBLE PRECISION V1 , V1_4 , DV1 , DTETAR , ELIM , RAISF + DOUBLE PRECISION V2 , V2_4 , V3 , V3_4 + DOUBLE PRECISION W2 , W2_M , W2_1 , W_MIL , W_RAD + DOUBLE PRECISION RK0 , XK0 , YK0 , RK1 , XK1 , YK1 + DOUBLE PRECISION RK2 , XK2P , YK2P , XK2M , YK2M + DOUBLE PRECISION RK3 , XK3P , YK3P , XK3M , YK3M + DOUBLE PRECISION D01P , C_D01P, S_D01P, D0AP , C_D0AP, S_D0AP + DOUBLE PRECISION GA2P , C_GA2P, S_GA2P, GA3P , C_GA3P, S_GA3P, TWOPI, PI, SEUIL1 , SEUIL2 , SEUIL + ! + !.....Variables related to the Gaussian quadratures + DOUBLE PRECISION W_CHE_TE1, W_CHE_OM2, C_LEG_OM2 + ! + !.....Variables related to the configuration selection + DOUBLE PRECISION TEST1 , TEST2 + DOUBLE PRECISION :: FREQ(NK) + DOUBLE PRECISION, ALLOCATABLE :: F1SF(:) , X_CHE_TE1(:) , X_CHE_OM2(:) , X_LEG_OM2(:) , W_LEG_OM2(:) & + , MAXCLA(:) + + PI = Acos(-1.) + LBUF = 500 + DIMBUF = 2*LBUF+200 + TWOPI = 2.*PI + ! + ! Defines some threshold values for filtering (See Gagnaire-Renou Thesis, p 52) + ! + SEUIL1 = 1E10 + SEUIL2 = GQTHRCOU + + IF(GQNF1.EQ.14) IQ_OM1=1 + IF(GQNF1.EQ.26) IQ_OM1=2 + IF(GQNF1.EQ.11) IQ_OM1=3 + IF(GQNF1.EQ.40) IQ_OM1=4 + IF(GQNF1.EQ.11) IQ_OM1=3 + IF(GQNF1.EQ.40) IQ_OM1=4 + IF(GQNF1.EQ.20) IQ_OM1=7 + ! + ! Note by FA: not sure what the 5 and 6 cases correspond to + ! + NQ_TE1 = GQNT1/2 + NCONFM = GQNF1*GQNT1*GQNQ_OM2 + + RAISF = XFR + NT = NTH + NF = NK + DTETAR = TWOPI/DBLE(NT) + + DO IK = 1,NK + FREQ(IK) = FR1*RAISF**(IK-1) + ENDDO + + TAILF = -NLTAIL + + !===============ALLOCATE MATRICES============================================= + if (Allocated(K_IF2) ) then + deallocate(K_IF2) + endif + ALLOCATE(K_IF2(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_IF3) ) then + deallocate(K_IF3) + endif + ALLOCATE(K_IF3(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P2P) ) then + deallocate(K_1P2P) + endif + ALLOCATE(K_1P2P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P3M) ) then + deallocate(K_1P3M) + endif + ALLOCATE(K_1P3M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P2M) ) then + deallocate(K_1P2M) + endif + ALLOCATE(K_1P2M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1P3P) ) then + deallocate(K_1P3P) + endif + ALLOCATE(K_1P3P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M2P) ) then + deallocate(K_1M2P) + endif + ALLOCATE(K_1M2P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M3M) ) then + deallocate(K_1M3M) + endif + ALLOCATE(K_1M3M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M2M) ) then + deallocate(K_1M2M) + endif + ALLOCATE(K_1M2M(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_1M3P) ) then + deallocate(K_1M3P) + endif + ALLOCATE(K_1M3P(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_V24) ) then + deallocate(TB_V24) + endif + ALLOCATE(TB_V24(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_V34) ) then + deallocate(TB_V34) + endif + ALLOCATE(TB_V34(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_TPM) ) then + deallocate(TB_TPM) + endif + ALLOCATE(TB_TPM(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_TMP) ) then + deallocate(TB_TMP) + endif + ALLOCATE(TB_TMP(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(TB_FAC) ) then + deallocate(TB_FAC) + endif + ALLOCATE(TB_FAC(GQNQ_OM2,GQNT1,GQNF1)) + + if (Allocated(K_IF1) ) then + deallocate(K_IF1) + endif + ALLOCATE(K_IF1(GQNF1)) + + if (Allocated(K_1P) ) then + deallocate(K_1P) + endif + ALLOCATE(K_1P(GQNT1,GQNF1)) + + if (Allocated(K_1M) ) then + deallocate(K_1M) + endif + ALLOCATE(K_1M(GQNT1,GQNF1)) + + if (Allocated(TB_V14) ) then + deallocate(TB_V14) + endif + ALLOCATE(TB_V14(GQNF1)) + + if (Allocated(IDCONF) ) then + deallocate(IDCONF) + endif + ALLOCATE(IDCONF(NCONFM,3)) + + !======================================================================= + ! INITIALISATION OF AUXILIAIRY TABLES FOR SPECTRUM INTERPOLATION + !======================================================================= + if (Allocated(F_POIN) ) then + deallocate(F_POIN) + endif + ALLOCATE(F_POIN(DIMBUF)) + + if (Allocated(T_POIN) ) then + deallocate(T_POIN) + endif + ALLOCATE(T_POIN(DIMBUF)) + + if (Allocated(F_COEF) ) then + deallocate(F_COEF) + endif + ALLOCATE(F_COEF(DIMBUF)) + + if (Allocated(F_PROJ) ) then + deallocate(F_PROJ) + endif + ALLOCATE(F_PROJ(DIMBUF)) + + if (Allocated(TB_SCA) ) then + deallocate(TB_SCA) + endif + ALLOCATE(TB_SCA(DIMBUF)) + + + F_POIN(:)=0 + T_POIN(:)=0 + F_COEF(:)=0.D0 + F_PROJ(:)=0.D0 + TB_SCA(:)=0.0D0 + + DO JF=1,LBUF + F_POIN(JF)=1 + F_COEF(JF)=0.0D0 + F_PROJ(JF)=0.0D0 + ENDDO + DO JF=1,NF + IAUX=LBUF+JF + F_POIN(IAUX)=JF + F_COEF(IAUX)=1.0D0 + F_PROJ(IAUX)=1.0D0 + ENDDO + AUX=1.D0/RAISF**TAILF + DO JF=1,LBUF + IAUX=LBUF+NF+JF + F_POIN(IAUX)=NF + F_COEF(IAUX)=AUX**JF + F_PROJ(IAUX)=0.0D0 + ENDDO + ! + DO JT=LBUF,1,-1 + T_POIN(JT)=NT-MOD(LBUF-JT,NT) + ENDDO + DO JT=1,NT + T_POIN(LBUF+JT)=JT + ENDDO + DO JT=1,LBUF + T_POIN(LBUF+NT+JT)=MOD(JT-1,NT)+1 + ENDDO + !====================================================================== + ! + !======================================================================= + ! COMPUTES SCALE COEFFICIENTS FOR THE COUPLING COEFFICIENT + ! Would be easier to pass these on from W3SRCE ??? + !======================================================================= + DP2SG=TWOPI*TWOPI/GRAV + DO JF=1,LBUF + AUX=FREQ(1)/RAISF**(LBUF-JF+1) + TB_SCA(JF)=(DP2SG*AUX**2)**6/(TWOPI**3*AUX) + ENDDO + DO JF=1,NF + TB_SCA(LBUF+JF)=(DP2SG*FREQ(JF)**2)**6/(TWOPI**3*FREQ(JF)) + ENDDO + DO JF=1,LBUF + IAUX=LBUF+NF+JF + AUX=FREQ(NF)*RAISF**JF + TB_SCA(IAUX)=(DP2SG*AUX**2)**6/(TWOPI**3*AUX) + ENDDO + !======================================================================= + ! + !======================================================================= + ! COMPUTES VALUES FOR GAUSSIAN QUADRATURES + !======================================================================= + if (Allocated(X_CHE_TE1) ) then + deallocate(X_CHE_TE1) + endif + ALLOCATE(X_CHE_TE1(1:NQ_TE1),X_CHE_OM2(1:GQNQ_OM2)) + + if (Allocated(X_LEG_OM2) ) then + deallocate(X_LEG_OM2) + endif + ALLOCATE(X_LEG_OM2(1:GQNQ_OM2),W_LEG_OM2(1:GQNQ_OM2)) + ! + !.....Abscissa and weight (constant) for Gauss-Chebyshev + DO IQ_TE1=1,NQ_TE1 + X_CHE_TE1(IQ_TE1)=COS(PI*(DBLE(IQ_TE1)-0.5D0)/DBLE(NQ_TE1)) + ENDDO + W_CHE_TE1=PI/DBLE(NQ_TE1) + DO IQ_OM2=1,GQNQ_OM2 + X_CHE_OM2(IQ_OM2)=COS(PI*(DBLE(IQ_OM2)-0.5D0)/DBLE(GQNQ_OM2)) + ENDDO + W_CHE_OM2=PI/DBLE(GQNQ_OM2) + ! + !.....Abscissa et weight for Gauss-Legendre + CALL GAULEG( W_LEG_OM2 , X_LEG_OM2 , GQNQ_OM2 ) + DO IQ_OM2=1,GQNQ_OM2 + X_LEG_OM2(IQ_OM2)=0.25D0*(1.D0+X_LEG_OM2(IQ_OM2))**2 + ENDDO + !======================================================================= + ! + ! + !======================================================================= + ! COMPUTES VALUES OF RATIO F1/F AS FUNCTION OF THE IQ_OM1 INDICATOR + !======================================================================= + NF1P1=GQNF1+1 + if (Allocated(F1SF) ) then + deallocate(F1SF) + endif + ALLOCATE(F1SF(1:NF1P1)) + + CALL F1F1F1 ( F1SF , GQNF1 , IQ_OM1) + !======================================================================= + ! + ! ================================================== + ! STARTS LOOP 1 OVER THE RATIOS F1/F0 + ! ================================================== + DO JF1=1,GQNF1 + ! ---------Computes and stores v1=f1/f0 and v1**4 + V1=(F1SF(JF1+1)+F1SF(JF1))/2.D0 + K_IF1(JF1)=NINT(DBLE(LBUF)+LOG(V1)/LOG(RAISF)) + V1_4=V1**4 + TB_V14(JF1)=V1_4 + ! ---------Computes and stores dv1=df1/f0 + DV1=F1SF(JF1+1)-F1SF(JF1) + ! ---------Computes the A parameter + AAA=((1.D0+V1)**4-4.D0*(1.D0+V1_4))/(8.D0*V1**2) + ! + ! ================================================= + ! STARTS LOOP 2 OVER THE DELTA_1+ VALUES + ! ================================================= + DO JT1=1,GQNT1 + ! + !......Computes the Delta1+ values (=Theta_1-Theta_0) between 0 and Pi. + IF (JT1.LE.NQ_TE1) THEN + ! ---------First interval : X from -1 to A + IQ_TE1=JT1 + C_D01P=(-1.D0+AAA)/2.D0+(1.D0+AAA)/2.D0*X_CHE_TE1(IQ_TE1) + CCC=DV1*SQRT((AAA-C_D01P)/(1.D0-C_D01P))*W_CHE_TE1 + ELSE + ! ---------Second interval : X from A to 1 + IQ_TE1=JT1-NQ_TE1 + C_D01P=( 1.D0+AAA)/2.D0+(1.D0-AAA)/2.D0*X_CHE_TE1(IQ_TE1) + CCC=DV1*SQRT((C_D01P-AAA)/(1.D0+C_D01P))*W_CHE_TE1 + ENDIF + S_D01P=SQRT(1.D0-C_D01P*C_D01P) + D01P =ACOS(C_D01P) + K_1P(JT1,JF1)=LBUF+NINT(D01P/DTETAR) + K_1M(JT1,JF1)=LBUF-NINT(D01P/DTETAR) + ! + ! ---------Computes Epsilon_a + EPSI_A=2.D0*SQRT(1.D0+V1_4+2.D0*V1*V1*C_D01P)/(1.D0+V1)**2 + ! ---------Computes Delta_A+ and its cosinus + C_D0AP=(1.D0-V1_4+0.25D0*EPSI_A**2*(1.D0+V1)**4) & + /(EPSI_A*(1.D0+V1)**2) + S_D0AP=SQRT(1.0D0-C_D0AP*C_D0AP) + D0AP = ACOS(C_D0AP) + ! + !.......Integration over OMEGA2 depending on EPS_A + IF (EPSI_A.LT.1.D0) THEN + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !........Case of a single singularity (in OMEGA2-) + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + W2_M=0.5D0*(1.D0-EPSI_A/2.D0) + W2_1=0.5D0 + ! + W_RAD=W2_1-W2_M + C_LEG_OM2=SQRT(W_RAD) + ! + ! ---------------------------------------------------- + !........STARTS LOOP 3 OVER OMEGA_2 (CASE Epsilon_A < 1) + !........Case of a single singularity (in OMEGA2-) + !........Integration over OMEGA2 via GAUSS-LEGENDRE quadrature + ! ---------------------------------------------------- + DO IQ_OM2=1,GQNQ_OM2 + ! ---------Computes W2, V2, and V3 + W2=W2_M+W_RAD*X_LEG_OM2(IQ_OM2) + V2=W2*(1.D0+V1) + V2_4=V2**4 + TB_V24(IQ_OM2,JT1,JF1)=V2_4 + K_IF2 (IQ_OM2,JT1,JF1) = NINT(DBLE(LBUF) & + + LOG(V2)/LOG(RAISF)) + V3=1.D0+V1-V2 + V3_4=V3**4 + TB_V34(IQ_OM2,JT1,JF1)=V3_4 + K_IF3 (IQ_OM2,JT1,JF1) = NINT(DBLE(LBUF) & + + LOG(V3)/LOG(RAISF)) + ! ---------Computes Gamma_2+ et Gamma_3+ angles + C_GA2P=(EPSI_A**2/4.D0+W2**4-(1.D0-W2)**4)/(EPSI_A*W2*W2) + C_GA2P=MAX(MIN(C_GA2P,1.D0),-1.D0) + S_GA2P=SQRT(1.D0-C_GA2P*C_GA2P) + GA2P =ACOS(C_GA2P) + C_GA3P=(EPSI_A**2/4.D0-W2**4+(1.D0-W2)**4)/EPSI_A & + /(1.D0-W2)**2 + C_GA3P=MAX(MIN(C_GA3P,1.D0),-1.D0) + S_GA3P=SQRT(1.D0-C_GA3P*C_GA3P) + GA3P =ACOS(C_GA3P) + ! Shifting of the direction indexes - Config. +Delta1 (SIG=1) + K_1P2P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1P2M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! Shifting of the direction indexes - Config. -Delta1 (SIG=-1) + K_1M2P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1M2M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! + !.........Computes the coupling coefficients (only for Delta_1+ ) + RK0=1.D0 + RK1=V1*V1 + RK2=V2*V2 + RK3=(1.D0+V1-V2)**2 + XK0 = RK0 + YK0 = 0.0D0 + XK1 = RK1*C_D01P + YK1 = RK1*S_D01P + XK2P = RK2*(C_D0AP*C_GA2P-S_D0AP*S_GA2P) + YK2P = RK2*(S_D0AP*C_GA2P+C_D0AP*S_GA2P) + XK2M = RK2*(C_D0AP*C_GA2P+S_D0AP*S_GA2P) + YK2M = RK2*(S_D0AP*C_GA2P-C_D0AP*S_GA2P) + XK3P = RK3*(C_D0AP*C_GA3P-S_D0AP*S_GA3P) + YK3P = RK3*(S_D0AP*C_GA3P+C_D0AP*S_GA3P) + XK3M = RK3*(C_D0AP*C_GA3P+S_D0AP*S_GA3P) + YK3M = RK3*(S_D0AP*C_GA3P-C_D0AP*S_GA3P) + TB_TPM(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2P , YK2P , XK3M , YK3M) + TB_TMP(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2M , YK2M , XK3P , YK3P) + ! + !.........Computes the multiplicative coefficient for QNL4 + DENO=2.D0*SQRT( (0.5D0*(1.D0+EPSI_A/2.D0)-W2) & + *((W2-0.5D0)**2+0.25D0*(1.D0+EPSI_A)) & + *((W2-0.5D0)**2+0.25D0*(1.D0-EPSI_A)) ) + TB_FAC(IQ_OM2,JT1,JF1)=1.D0/(DENO*V1*W2*(1.D0-W2)) & + /(1.D0+V1)**5 * W_LEG_OM2(IQ_OM2)*C_LEG_OM2* CCC + ENDDO + ! ----------------------------------------------- + !........END OF THE LOOP 3 OVER OMEGA_2 (CASE Epsilon_A < 1) + ! ----------------------------------------------- + ! + ELSE + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !........STARTS LOOP 3 OVER OMEGA_2 (CASE Epsilon_A > 1) + !........Case of two singularities (in OMEGA2- and OMEGA2_1) + !........Integration over OMEGA2 via GAUSS-CHEBYSCHEV quadrature + ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - + W2_M=0.5D0*(1.D0-EPSI_A/2.D0) + W2_1=0.5D0*(1.D0-SQRT(EPSI_A-1.D0)) + ! + W_MIL=(W2_M+W2_1)/2.D0 + W_RAD=(W2_1-W2_M)/2.D0 + ! + DO IQ_OM2=1,GQNQ_OM2 + ! ---------Computes W2, V2, and V3 + W2=W_MIL+W_RAD*X_CHE_OM2(IQ_OM2) + V2=W2*(1.D0+V1) + V2_4=V2**4 + TB_V24(IQ_OM2,JT1,JF1)=V2_4 + K_IF2 (IQ_OM2,JT1,JF1)=NINT(DBLE(LBUF) & + +LOG(V2)/LOG(RAISF)) + V3=1.D0+V1-V2 + V3_4=V3**4 + TB_V34(IQ_OM2,JT1,JF1)=V3_4 + K_IF3 (IQ_OM2,JT1,JF1)=NINT(DBLE(LBUF) & + +LOG(V3)/LOG(RAISF)) + ! ---------Computes Gamma_2+ et Gamma_3+ angles + C_GA2P=(EPSI_A**2/4.D0+W2**4-(1.D0-W2)**4)/(EPSI_A*W2*W2) + C_GA2P=MAX(MIN(C_GA2P,1.D0),-1.D0) + S_GA2P=SQRT(1.D0-C_GA2P*C_GA2P) + GA2P =ACOS(C_GA2P) + C_GA3P=(EPSI_A**2/4.D0-W2**4+(1.D0-W2)**4)/EPSI_A & + /(1.D0-W2)**2 + C_GA3P=MAX(MIN(C_GA3P,1.D0),-1.D0) + S_GA3P=SQRT(1.D0-C_GA3P*C_GA3P) + GA3P =ACOS(C_GA3P) + ! Shifts the direction indexes - Config. +Delta1 (SIG=1) + K_1P2P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1P2M(IQ_OM2,JT1,JF1)=NINT(( D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1P3P(IQ_OM2,JT1,JF1)=NINT(( D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! Shifts the direction indexes - Config. -Delta1 (SIG=-1) + K_1M2P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA3P)/DTETAR & + +DBLE(LBUF)) + K_1M2M(IQ_OM2,JT1,JF1)=NINT((-D0AP-GA2P)/DTETAR & + +DBLE(LBUF)) + K_1M3P(IQ_OM2,JT1,JF1)=NINT((-D0AP+GA3P)/DTETAR & + +DBLE(LBUF)) + ! + !.........Computes the coupling coefficients (only for Delta_1+ ) + RK0=1.D0 + RK1=V1*V1 + RK2=V2*V2 + RK3=(1.D0+V1-V2)**2 + XK0 = RK0 + YK0 = 0.0D0 + XK1 = RK1*C_D01P + YK1 = RK1*S_D01P + XK2P = RK2*(C_D0AP*C_GA2P-S_D0AP*S_GA2P) + YK2P = RK2*(S_D0AP*C_GA2P+C_D0AP*S_GA2P) + XK2M = RK2*(C_D0AP*C_GA2P+S_D0AP*S_GA2P) + YK2M = RK2*(S_D0AP*C_GA2P-C_D0AP*S_GA2P) + XK3P = RK3*(C_D0AP*C_GA3P-S_D0AP*S_GA3P) + YK3P = RK3*(S_D0AP*C_GA3P+C_D0AP*S_GA3P) + XK3M = RK3*(C_D0AP*C_GA3P+S_D0AP*S_GA3P) + YK3M = RK3*(S_D0AP*C_GA3P-C_D0AP*S_GA3P) + TB_TPM(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2P , YK2P , XK3M , YK3M) + TB_TMP(IQ_OM2,JT1,JF1)=COUPLE( XK0 , YK0 , XK1 , YK1 , XK2M , YK2M , XK3P , YK3P) + ! + !.........Computes the multiplicative coefficient for QNL4 + DENO=2.D0*SQRT( (0.5D0*(1.D0+EPSI_A/2.D0)-W2) & + *((W2-0.5D0)**2+0.25D0*(1.D0+EPSI_A)) & + *(0.5D0*(1.D0+SQRT(EPSI_A-1.D0))-W2) ) + TB_FAC(IQ_OM2,JT1,JF1)=1.D0/(DENO*V1*W2*(1.D0-W2)) & + /(1.D0+V1)**5 * W_CHE_OM2* CCC + ! + ENDDO + ! ----------------------------------------------- + !........END OF LOOP 3 OVER OMEGA_2 (CASE Epsilon_A > 1) + ! ----------------------------------------------- + ! + ENDIF + ENDDO + ! ================================================= + ! END OF LOOP 2 OVER THE DELTA_1+ VALUES + ! ================================================= + ! + ENDDO + ! ================================================== + ! END OF LOOP 1 OVER THE F1/F0 RATIOS + ! ================================================== + DEALLOCATE(F1SF) + DEALLOCATE(X_CHE_TE1) + DEALLOCATE(X_CHE_OM2) + DEALLOCATE(X_LEG_OM2) + DEALLOCATE(W_LEG_OM2) + + ! =========================================================== + ! POST-PROCESSING TO ELIMINATE PART OF THE CONFIGURATIONS + ! =========================================================== + ! + !.....It looks, for every value of the ratio V1, for the maximum value + !.....of FACTOR*COUPLING : it is stored in the local table NAXCLA(.) + ! """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" + ALLOCATE(MAXCLA(1:GQNF1)) + DO JF1=1,GQNF1 + AUX=0.0D0 + DO JT1=1,GQNT1 + DO IQ_OM2=1,GQNQ_OM2 + AAA=TB_FAC(IQ_OM2,JT1,JF1)*TB_TPM(IQ_OM2,JT1,JF1) + IF (AAA.GT.AUX) AUX=AAA + CCC=TB_FAC(IQ_OM2,JT1,JF1)*TB_TMP(IQ_OM2,JT1,JF1) + IF (CCC.GT.AUX) AUX=CCC + ENDDO + ENDDO + MAXCLA(JF1)=AUX + ENDDO + ! + !.....It looks for the max V1 value + ! """""""""""""""""""""""""""""""""""""""""""""""""""""""""""" + AUX=0.0D0 + DO JF1=1,GQNF1 + IF (MAXCLA(JF1).GT.AUX) AUX=MAXCLA(JF1) + ENDDO + TEST1=SEUIL1*AUX + ! + !.....Set to zero the coupling coefficients not used + ! """"""""""""""""""""""""""""""""""""""""""""""""""""" + NCONF=0 + DO JF1=1,GQNF1 + TEST2 =SEUIL2*MAXCLA(JF1) + DO JT1=1,GQNT1 + DO IQ_OM2=1,GQNQ_OM2 + AAA=TB_FAC(IQ_OM2,JT1,JF1)*TB_TPM(IQ_OM2,JT1,JF1) + CCC=TB_FAC(IQ_OM2,JT1,JF1)*TB_TMP(IQ_OM2,JT1,JF1) + IF ((AAA.GT.TEST1.OR.AAA.GT.TEST2).OR. & + (CCC.GT.TEST1.OR.CCC.GT.TEST2)) THEN + NCONF=NCONF+1 + IDCONF(NCONF,1)=JF1 + IDCONF(NCONF,2)=JT1 + IDCONF(NCONF,3)=IQ_OM2 + ENDIF +#ifdef W3_TGQM + WRITE(993,*) NCONF,JF1,JT1,IQ_OM2,AAA,CCC,(AAA.GT.TEST1.OR.AAA.GT.TEST2), & + (CCC.GT.TEST1.OR.CCC.GT.TEST2) +#endif + ENDDO + ENDDO + ENDDO + DEALLOCATE(MAXCLA) + ! + !..... counts the fraction of the eliminated configurations + ELIM=(1.D0-DBLE(NCONF)/DBLE(NCONFM))*100.D0 + ! WRITE(994,*) 'NCONF:',NCONF,ELIM + END SUBROUTINE INSNLGQM !/ !/ End of module W3SNL1MD -------------------------------------------- / !/ diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 6aa708bb86..a846605d8f 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -564,6 +564,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_NL1 USE W3SNL1MD + USE W3GDATMD, ONLY: IQTPE #endif #ifdef W3_NL2 USE W3SNL2MD @@ -1215,7 +1216,11 @@ 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 ) + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( SPEC, CG1, WNMEAN*DEPTH, VSNL, VDNL ) + ELSE + CALL W3SNLGQM ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) + END IF #endif #ifdef W3_NL2 CALL W3SNL2 ( SPEC, CG1, DEPTH, VSNL, VDNL ) diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index 409888da19..0cbc0b6538 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -1547,6 +1547,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) #endif #ifdef W3_NL1 USE W3SNL1MD + USE W3GDATMD, ONLY: IQTPE #endif #ifdef W3_NL2 USE W3SNL2MD @@ -2421,7 +2422,11 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) END IF IF ( FLSRCE(3) ) THEN #ifdef W3_NL1 - CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + ELSE + CALL W3SNLGQM ( A, CG, WN, DEPTH, XNL, DIA ) + END IF #endif #ifdef W3_NL2 CALL W3SNL2 ( A, CG, DEPTH, XNL, DIA ) diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index a95ec2e93e..6d750687a9 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -1983,7 +1983,11 @@ SUBROUTINE W3EXPO END IF IF ( FLSRCE(3) ) THEN #ifdef W3_NL1 - CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( A, CG, WNMEAN*DEPTH, XNL, DIA ) + ELSE + CALL W3SNLGQM ( A, CG, WN, DEPTH, XNL, DIA ) + END IF #endif #ifdef W3_NL2 CALL W3SNL2 ( A, CG, DEPTH, XNL, DIA ) diff --git a/model/src/ww3_trnc.F90 b/model/src/ww3_trnc.F90 index c2049751c6..ec69db4dca 100644 --- a/model/src/ww3_trnc.F90 +++ b/model/src/ww3_trnc.F90 @@ -71,6 +71,9 @@ PROGRAM W3TRNC !/ ------------------------------------------------------------------- / USE CONSTANTS +#ifdef W3_NL1 + USE W3ADATMD, ONLY : W3NAUX, W3SETA +#endif USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR, GNAME USE W3ODATMD, ONLY : W3NOUT, W3SETO, FNMPRE USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE @@ -131,6 +134,10 @@ PROGRAM W3TRNC ! CALL W3NMOD ( 1, 6, 6 ) CALL W3SETG ( 1, 6, 6 ) +#ifdef W3_NL1 + CALL W3NAUX ( 6, 6 ) + CALL W3SETA ( 1, 6, 6 ) +#endif CALL W3NOUT ( 6, 6 ) CALL W3SETO ( 1, 6, 6 ) ! diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 864583358a..3d1d84f16d 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -912,6 +912,8 @@ echo "$rtst -s ST4_TSA -w work_ST4_TSA $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST6 -w work_ST6 $ww3 ww3_ts1" >> matrix.body echo "$rtst -w work_NL5 -i input_nl5_matrix $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g ST4_T707 -w work_T707GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g ST4_T713 -w work_T713GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body fi # fetch limited growth, no switch sharing here diff --git a/regtests/bin/matrix_cmake_datarmor b/regtests/bin/matrix_cmake_datarmor index 4e635f3c2c..16c31e47c7 100755 --- a/regtests/bin/matrix_cmake_datarmor +++ b/regtests/bin/matrix_cmake_datarmor @@ -129,7 +129,7 @@ main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" export mpi='$MPI_LAUNCH' # Compile option - opt="-f -N -S -T" + opt="-f -N -S -T -o both" # Base run_test command line export rtst="./bin/run_cmake_test $opt" diff --git a/regtests/ww3_ts1/input/namelists_ST4_T475.nml b/regtests/ww3_ts1/input/namelists_ST4_T475.nml new file mode 100644 index 0000000000..e104247aa6 --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T475.nml @@ -0,0 +1,7 @@ +&SIN4 BETAMAX = 1.75, SWELLF = 0.66, TAUWSHELTER = 0.3, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 FXFM3 = 2.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / + +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T700.nml b/regtests/ww3_ts1/input/namelists_ST4_T700.nml index aa6ecdf70a..b47cc70d04 100644 --- a/regtests/ww3_ts1/input/namelists_ST4_T700.nml +++ b/regtests/ww3_ts1/input/namelists_ST4_T700.nml @@ -1,4 +1,4 @@ &SDS4 SDSBCHOICE=3, SDSC2 = -3.8, SDSBR = 0.005, - SDSSTRAIN =0., SDSSTRAIN2 = 0., FXFM3 = 20., SDSFACMTF = 400., + FXFM3 = 20., SDSFACMTF = 400., SDSCUM=0., SDSC5 =0. / END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T702.nml b/regtests/ww3_ts1/input/namelists_ST4_T702.nml new file mode 100644 index 0000000000..444c02e297 --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T702.nml @@ -0,0 +1,12 @@ +&SIN4 BETAMAX = 1.7, SWELLF = 0.60, TAUWSHELTER = 0.2, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 SDSBCHOICE = 3, SDSC2 = -3.80, FXFM3 = 20.00, + SDSBR = 0.005, SDSBT = 0.0011, SDSCUM = 0.300, SDSC5 = 1.0, + SDSMWD = 0.00, SDSFACMTF = 400 / +&SNL1 NLPROP = 25000000.0 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FLAGTR = 4, FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T707.nml b/regtests/ww3_ts1/input/namelists_ST4_T707.nml new file mode 100644 index 0000000000..16f81517d2 --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T707.nml @@ -0,0 +1,13 @@ + &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, + TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., + GQAMP2=0.0022, GQAMP3=1., GQAMP4=1.0 / + &SIN4 BETAMAX = 1.6, TAUWSHELTER = 0.0 / + &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, + FXFM3 = 20, SDSFACMTF = 400., + SDSMWD = 2., SDSCUM = 0.35, SDSNUW =0, SDSC5=1., SDSBRF1=0.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FLAGTR = 4, FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml new file mode 100644 index 0000000000..7987e95282 --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T475.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T475.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml new file mode 100644 index 0000000000..48135e1d9f --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T702.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T702.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml new file mode 100644 index 0000000000..e6ef84a562 --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T707.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T707.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml new file mode 100644 index 0000000000..0458cd7753 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml @@ -0,0 +1,14 @@ + &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, + TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., + GQAMP2=0.0022, GQAMP3=1., GQAMP4=1.0 / + &SIN4 BETAMAX = 1.6, TAUWSHELTER = 0.0 / + &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, + FXFM3 = 20, SDSFACMTF = 400., + SDSMWD = 2., SDSCUM = 0.35, SDSNUW =0, SDSC5=1., SDSBRF1=0.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +! DO NOT FORGET TO ADD FLAGTR = 4 for real life runs ... +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml new file mode 100644 index 0000000000..8786044301 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml @@ -0,0 +1,14 @@ + &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, + TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., + GQAMP2=0.0022, GQAMP3=2. / +&SIN4 BETAMAX = 1.1, TAUWSHELTER = 0.0 / +&SDS4 SDSBCHOICE=3, SDSC2 = -2.5, SDSBR = 0.005, + SDSSTRAIN2 =1.,SDSCUMP=1., FXFM3 = 20, SDSFACMTF = 200., + SDSMWD = 0.9, SDSCUM = 0.3, SDSNUW =0, SDSC5=0.5, SDSBRF1=0.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +! DO NOT FORGET TO ADD FLAGTR = 4 for real life runs ... +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/points.list b/regtests/ww3_ts1/input_10ms/points.list new file mode 100644 index 0000000000..5ad8fde504 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/points.list @@ -0,0 +1 @@ +0.0 0.0 'The_point' diff --git a/regtests/ww3_ts1/input_10ms/switch b/regtests/ww3_ts1/input_10ms/switch new file mode 100644 index 0000000000..c3b8938ee6 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/switch @@ -0,0 +1 @@ +NOGRB SHRD PR0 FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_ts1/input_10ms/switch_ST4 b/regtests/ww3_ts1/input_10ms/switch_ST4 new file mode 100644 index 0000000000..c3b8938ee6 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/switch_ST4 @@ -0,0 +1 @@ +NOGRB SHRD PR0 FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml new file mode 100644 index 0000000000..5378ebec39 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T707.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 5. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T707.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml new file mode 100644 index 0000000000..3efd65adf5 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T713.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 5. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T713.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_ounf.nml b/regtests/ww3_ts1/input_10ms/ww3_ounf.nml new file mode 100644 index 0000000000..716f1df4b7 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20000101 000000' + FIELD%TIMESTRIDE = '10' + FIELD%TIMECOUNT = '8000' + FIELD%LIST = 'DPT QP QKK WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA UST' + FIELD%PARTITION = '0 1 2' + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IX0 = 2 + FILE%IXN = 2 + FILE%IY0 = 2 + FILE%IYN = 2 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml b/regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml new file mode 100644 index 0000000000..34bac97643 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_ounp_spec.nml @@ -0,0 +1,48 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20000101 000000' + POINT%TIMESTRIDE = '1800.' + POINT%TIMECOUNT = '1000' + POINT%TIMESPLIT = 4 + POINT%BUFFER = 100 + POINT%TYPE = 3 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_shel.nml b/regtests/ww3_ts1/input_10ms/ww3_shel.nml new file mode 100644 index 0000000000..d83106ed12 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_shel.nml @@ -0,0 +1,54 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%START = '20000101 000000' + DOMAIN%STOP = '20000106 000000' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_NML + INPUT%FORCING%WINDS = 'H' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'DPT QP QKK WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA UST' + TYPE%POINT%FILE = '../input_10ms/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '19680606 000000' '1800' '20230618 000000' + DATE%POINT = '19680606 000000' '1800' '20230618 000000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML + HOMOG_COUNT%N_CUR = 0 + HOMOG_COUNT%N_WND = 1 +/ + +&HOMOG_INPUT_NML + HOMOG_INPUT(1)%NAME = 'WND' + HOMOG_INPUT(1)%VALUE1 = 10. + HOMOG_INPUT(1)%VALUE2 = 270. + HOMOG_INPUT(1)%VALUE3 = 0. +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! From 4cd995d09caf1e243d8e724827d2d0bb21bb062f Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 31 Oct 2023 16:00:22 -0400 Subject: [PATCH 019/136] update logic to ensure you are not accessing uninitialized dates (#1114) --- model/src/w3wavemd.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 44c80964d2..c144ab8d8d 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -2409,8 +2409,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! #ifdef W3_MPI - IF ( ( (DSEC21(TIME,TONEXT(:,1)).EQ.0.) .AND. FLOUT(1) ) .OR. & - ( (DSEC21(TIME,TONEXT(:,7)).EQ.0.) .AND. FLOUT(7) .AND. SBSED ) ) THEN + IF ( (FLOUTG) .OR. (FLOUTG2 .AND. SBSED) ) THEN IF (.NOT. LPDLIB) THEN IF (NRQGO.NE.0 ) THEN #endif From c3451a9a83ee0247cec3b15cf21610ba15872d30 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Wed, 1 Nov 2023 21:28:47 +0000 Subject: [PATCH 020/136] Initialised S and D arrays in W3SDB1 before potential early return if zero energy. (#1115) --- model/src/w3sdb1md.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index c297e85221..34c7ec3bfb 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -232,12 +232,12 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) ! ! 0. Initialzations ------------------------------------------------- / ! Never touch this 4 lines below ... otherwise my exceptionhandling will not work. + S = 0. + D = 0. THR = DBLE(1.E-15) IF (SUM(A) .LT. THR) RETURN - S = 0. - D = 0. IWB = 1 ! #ifdef W3_T From f702a8fe0bf9f6a6201111c156dcd7adead7bd88 Mon Sep 17 00:00:00 2001 From: Biao Zhao Date: Thu, 2 Nov 2023 18:25:50 +0100 Subject: [PATCH 021/136] ww3_ounp.F90: x/y units attribute corrected from 'm' to 'km' (#1088) --- model/src/ww3_ounp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index 0cbc0b6538..499e0371fb 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -3208,7 +3208,7 @@ SUBROUTINE W3CRNC (ITYPE, OTYPE, NCTYPE, NCFILE, NCID, DIMID, DIMLN, VARID, ONE, IRET=NF90_PUT_ATT(NCID,VARID(4),'long_name','x') IRET=NF90_PUT_ATT(NCID,VARID(4),'standard_name','x') IRET=NF90_PUT_ATT(NCID,VARID(4),'globwave_name','x') - IRET=NF90_PUT_ATT(NCID,VARID(4),'units','m') + IRET=NF90_PUT_ATT(NCID,VARID(4),'units','km') IRET=NF90_PUT_ATT(NCID,VARID(4),'scale_factor',1.) IRET=NF90_PUT_ATT(NCID,VARID(4),'add_offset',0.) IRET=NF90_PUT_ATT(NCID,VARID(4),'valid_min',0.) @@ -3225,7 +3225,7 @@ SUBROUTINE W3CRNC (ITYPE, OTYPE, NCTYPE, NCFILE, NCID, DIMID, DIMLN, VARID, ONE, IRET=NF90_PUT_ATT(NCID,VARID(5),'long_name','y') IRET=NF90_PUT_ATT(NCID,VARID(5),'standard_name','y') IRET=NF90_PUT_ATT(NCID,VARID(5),'globwave_name','y') - IRET=NF90_PUT_ATT(NCID,VARID(5),'units','m') + IRET=NF90_PUT_ATT(NCID,VARID(5),'units','km') IRET=NF90_PUT_ATT(NCID,VARID(5),'scale_factor',1.) IRET=NF90_PUT_ATT(NCID,VARID(5),'add_offset',0.) IRET=NF90_PUT_ATT(NCID,VARID(5),'valid_min',0.) From 1f928aa66d6f59237bc48b93f6e27283f63f6c1d Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Mon, 6 Nov 2023 16:13:40 +0000 Subject: [PATCH 022/136] Bugfix: Assign unit numbers to ASCII gridded/point output in multi-grid mode. (#1118) --- model/src/wminitmd.F90 | 76 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 72 insertions(+), 4 deletions(-) diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index daea42c5c1..956490b5e2 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -743,7 +743,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ! 2.c Set up I/O for individual models (initial) ! - ALLOCATE ( MDS(13,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & + ALLOCATE ( MDS(15,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & @@ -2303,8 +2303,20 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & SELECT CASE (J) CASE (1) MDS(7,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(14,I) = NDSFND ! ASCII +#endif CASE (2) MDS(8,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(15,I) = NDSFND ! ASCII +#endif CASE (3) MDS(12,I) = NDSFND CALL WMUGET ( MDSE, MDST, NDSFND, 'INP' ) @@ -2422,6 +2434,28 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END IF ! +#ifdef W3_ASCII + IF ( MDS(14,I) .NE. -1 ) THEN ! Grid output (ASCII) + IF ( IAPROC .EQ. NAPFLD ) THEN + TNAME = TRIM(FNMPRE)//'out_grd.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(14,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(14,I), .FALSE. ) + MDS(14,I) = -1 + END IF + END IF + ! + IF ( MDS(15,I) .NE. -1 ) THEN ! Point output (ASCII) + IF ( IAPROC .EQ. NAPPNT ) THEN + TNAME = TRIM(FNMPRE)//'out_pnt.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(15,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(15,I), .FALSE. ) + MDS(15,I) = -1 + END IF + END IF +#endif +! #ifdef W3_T WRITE (MDST,9081) I, TIME #endif @@ -3389,7 +3423,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! #ifdef W3_T 9020 FORMAT ( ' TEST WMINIT : UNIT NUMBERS FOR GRIDS (',A,')'/ & - 15X,'GRID MDS(1-13)',43X,'NTRACE') + 15X,'GRID MDS(1-15)',43X,'NTRACE') 9021 FORMAT (14X,16I4) 9022 FORMAT ( ' TEST WMINIT : UNIT NUMBERS FOR INTPUT FILES'/ & 15X,'GRID MDSF(JFIRST-9)') @@ -4108,7 +4142,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! ! 2.c Set up I/O for individual models (initial) ! - ALLOCATE ( MDS(13,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & + ALLOCATE ( MDS(15,NRGRD), NTRACE(2,NRGRD), ODAT(40,0:NRGRD), & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & @@ -5400,8 +5434,20 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & SELECT CASE (J) CASE (1) MDS(7,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(14,I) = NDSFND ! ASCII +#endif CASE (2) MDS(8,I) = NDSFND +#ifdef W3_ASCII + CALL WMUGET ( MDSE, MDST, NDSFND, 'OUT' ) + CALL WMUSET ( MDSE, MDST, NDSFND, .TRUE., & + DESC='ASCII output file' ) + MDS(15,I) = NDSFND ! ASCII +#endif CASE (3) MDS(12,I) = NDSFND CALL WMUGET ( MDSE, MDST, NDSFND, 'INP' ) @@ -5519,6 +5565,28 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END IF ! +#ifdef W3_ASCII + IF ( MDS(14,I) .NE. -1 ) THEN ! Grid output (ASCII) + IF ( IAPROC .EQ. NAPFLD ) THEN + TNAME = TRIM(FNMPRE)//'out_grd.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(14,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(14,I), .FALSE. ) + MDS(14,I) = -1 + END IF + END IF + ! + IF ( MDS(15,I) .NE. -1 ) THEN ! Point output (ASCII) + IF ( IAPROC .EQ. NAPPNT ) THEN + TNAME = TRIM(FNMPRE)//'out_pnt.' // FILEXT(:II) // '.txt' + CALL WMUSET ( MDSE,MDST, MDS(15,I), .TRUE., NAME=TNAME ) + ELSE + CALL WMUSET ( MDSE,MDST, MDS(15,I), .FALSE. ) + MDS(15,I) = -1 + END IF + END IF +#endif +! #ifdef W3_T WRITE (MDST,9081) I, TIME #endif @@ -6493,7 +6561,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! #ifdef W3_T 9020 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS FOR GRIDS (',A,')'/ & - 15X,'GRID MDS(1-13)',43X,'NTRACE') + 15X,'GRID MDS(1-15)',43X,'NTRACE') 9021 FORMAT (14X,16I4) 9022 FORMAT ( ' TEST WMINITNML : UNIT NUMBERS FOR INTPUT FILES'/ & 15X,'GRID MDSF(JFIRST-9)') From d90078b3cd97418451deeb2909615d77dbd4a136 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Tue, 28 Nov 2023 17:30:37 +0100 Subject: [PATCH 023/136] correct bugs to run correctly GQM implementation (#1127) --- manual/eqs/NL1.tex | 29 +++++++++++++++-------------- manual/manual.bib | 11 +++++++++++ manual/sys/files_w3.tex | 6 +++++- model/src/w3snl1md.F90 | 22 ++++++++++++++-------- model/src/w3src4md.F90 | 2 +- 5 files changed, 46 insertions(+), 24 deletions(-) diff --git a/manual/eqs/NL1.tex b/manual/eqs/NL1.tex index d9bc4c5217..c45e9294d8 100644 --- a/manual/eqs/NL1.tex +++ b/manual/eqs/NL1.tex @@ -55,37 +55,38 @@ \subsubsection{~$S_{nl}$: Discrete Interaction Approximation (\dia)} \label{sec: \sin(\delta_{\theta,3})&=&\sin(\delta_{\theta,2}) (1-\lambda)^2/(1+\lambda)^2. \end{eqnarray} - For these quadruplets, each source term value -$S_{nl}(\bk)$ corresponding to each discrete $(f_r,\theta)$ -we compute the three contributions that correspond to the situation in which $\bk$ takes the role of $\bk$,$\bk_{2,+}$, $\bk_{2,-}$, $\bk_{3,+}$ and $\bk_{3,-}$ in the quadruplet, namely the full source term is +Hence for any $\bk$ one quadruplet selects $\bk_{2,+}$ and $\bk_{3,+}$, and the other quadruplet selects its mirror image +$\bk_{2,-}$, $\bk_{2,-}$. Because there are 3 different components interacting in the two DIA-selected quadruplets, any discrete spectral component $(f_r,\theta)$ is actually involved in 6 quadruplets and directly exchanges energy with 12 other components $(f_r',\theta')$. Because the values of $f'_r$ and $\theta'$ do not fall exacly on other discrete components, the spectral density is interpolated using a bilinear interpolation, so that each source term value +$S_{nl}(\bk)$ contains the direct exchange of energy with 48 other discrete components. +we compute the three contributions that correspond to the situation in which $\bk$ takes the role of $\bk$,$\bk_{2,+}$, $\bk_{2,-}$, $\bk_{3,+}$ and $\bk_{3,-}$ in the quadruplet, namely the full source term is, without making explicit that bilinear interpolation, \begin{eqnarray} -S_{\mathrm{nl}}(\bk) &=& -2 \left[\delta S_{\mathrm{nl}}(\bk,\bk_2,\bk_3,+)+\delta S_{\mathrm{nl}}(\bk,\bk_2,\bk_3,-)\right] \nonumber \\ - & & + \delta S_{\mathrm{nl}}(\bk_4,\bk,\bk_5,+) + \delta S_{\mathrm{nl}}(\bk_6,\bk,\bk_7,-) \\ - & & + \delta S_{\mathrm{nl}}(\bk_8,\bk_9,\bk, +) + \delta S_{\mathrm{nl}}(\bk_{10},\bk_{11},\bk, -) . \label{eq:diasum} +S_{\mathrm{nl}}(\bk) &=& -2 \left[\delta S_{\mathrm{nl}}(\bk,\bk_{2,+},\bk_{3,+})+\delta S_{\mathrm{nl}}(\bk,\bk_{2,-},\bk_{3,-})\right] \nonumber \\ + & & + \delta S_{\mathrm{nl}}(\bk_4,\bk,\bk_5) + \delta S_{\mathrm{nl}}(\bk_6,\bk,\bk_7) \\ + & & + \delta S_{\mathrm{nl}}(\bk_8,\bk_9,\bk) + \delta S_{\mathrm{nl}}(\bk_{10},\bk_{11},\bk) . \label{eq:diasum} \end{eqnarray} -with elementary contributions given by +where the geometry of the quadruplet $(\bk_4,\bk_4,\bk,\bk_5)$ is obtained from that of $(\bk,\bk,\bk_{2,+},\bk_{3,+})$ by a dilation by a factor $(1+\lambda)^2$ and rotation by the angle $\delta_{\theta,2}$; $(\bk_6,\bk_6,\bk,\bk_7)$ has the same dilation but the opposite rotation; $(\bk_8,\bk_8,\bk_9,\bk)$ is dilated by a factor $(1-\lambda)^2$ and rotated by the angle $-\delta_{\theta,3}$: and $(\bk_{10},\bk_{10},\bk_{11},\bk)$ is dilated by the same factor and rotated by the opposite angle. + + +The elementary contributions $\delta S_{\mathrm{nl}}(\bk_l,\bk_m,\bk_n)$ are given by %----------------------------% % Nonlinear interactions DIA % %----------------------------% % eq:snl_dia \begin{equation} -\delta S_{\mathrm{nl}}(\bk,\bk_2,\bk_3,s) = \frac{C}{g^4} f_{r,1}^{11} \left [ F^2 \left ( \frac{F_{2,s}}{(1+\lambda_{nl})^4} + - \frac{F_{3,s}}{(1-\lambda_{nl})^4} \right ) - \frac{2 F F_{2,s} F_{3,s}}{(1-\lambda_{nl}^2)^4} \right] , +\delta S_{\mathrm{nl}}(\bk_l,\bk_m,\bk_n) = \frac{C}{g^4} f_{r,l}^{11} \left [ F_l^2 \left ( \frac{F_m}{(1+\lambda)^4} + + \frac{F_n}{(1-\lambda)^4} \right ) - \frac{2 F_l F_m F_n}{(1-\lambda^2)^4} \right] , \label{eq:snl_dia} \end{equation} -where $s=+$ or $s=-$ is a sign index, and the spectral densities are $F = F(f_{r} ,\theta)$, $F_{2,+} = F(f_{r,2} ,\theta + \delta_{\theta,2})$, $F_{2,-} = F(f_{r,2} ,\theta - \delta_{\theta,2})$, etc. +where the spectral densities are $F_l = F(f_{r,l} ,\theta_l)$, etc. $C$ is a proportionality constant that was tuned to reproduce the inverse energy cascade. Default values for different source term packages are presented in Table~\ref{tab:snl_par}. -As a result, when accounting for the two quadruplet configurations, the source term at $\bk$ includes the interactions with -10 other spectral components. Besides, because $f_{r,2}$ and $f_{r,3}$ nor $\theta_{2,\pm} $ and $\theta_{3,\pm} $ fall on discretized frequencies and directions, the spectral densities are bilinearly interpolated, which involves 4 discrete spectral components for each of these 10 components. - % tab:snl_par \begin{table} \begin{center} \begin{tabular}{|l|c|c|} \hline - & $\lambda_{nl}$ & $C$ \\ \hline + & $\lambda$ & $C$ \\ \hline ST6 & 0.25 & $3.00 \; 10^7$ \\ \hline \wam-3 & 0.25 & $2.78 \; 10^7$ \\ \hline ST4 (Ardhuin et al.)& 0.25 & $2.50 \; 10^7$ \\ \hline diff --git a/manual/manual.bib b/manual/manual.bib index 0aacb51054..c49e3340b8 100644 --- a/manual/manual.bib +++ b/manual/manual.bib @@ -3665,6 +3665,17 @@ @article{art:DC23 year = {2023} } +@ARTICLE{Webb1978, + author = "D. J. Webb", + title = "Nonlinear transfer between sea waves", + journal = DSR, + volume = 25, + pages = "279--298", + year = 1978, + where="paper", +} + + @ARTICLE{Lavrenov2001, author = "Igor V. Lavrenov", title = "Effect of wind wave parameter fluctuation on the nonlinear spectrum evolution", diff --git a/manual/sys/files_w3.tex b/manual/sys/files_w3.tex index fcd48a8f7c..d0ad76f7e5 100644 --- a/manual/sys/files_w3.tex +++ b/manual/sys/files_w3.tex @@ -506,11 +506,15 @@ \subsubsection{~Wave model modules} \label{sec:wave_mod} \end{flist} \noindent -Nonlinear interaction module (\dia) \hfill {\file w3snl1md.ftn} +Nonlinear interaction module (\dia or GQM) \hfill {\file w3snl1md.ftn} \begin{flisti} \fit{w3snl1}{Calculation of $S_{nl}$.} \fit{insnl1}{Initialization for $S_{nl}$.} +\fit{w3snlgqm}{Calculation of $S_{nl}$.} +\fit{w3scouple}{Calculation of coupling coefficient.} +\fit{gauleg}{Calculation of Gauss-Legendre quadrature coefficients.} +\fit{INSNLGQM}{Initialization for $S_{nl}$ with GQ method.} \end{flisti} \noindent diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index 598b627ea6..09c096d2bd 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -825,6 +825,8 @@ SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) USE CONSTANTS, ONLY: TPI USE W3GDATMD, ONLY: SIG, NK , NTH , DTH, XFR, FR1, GQTHRSAT, GQAMP + IMPLICIT NONE + REAL, intent(in) :: A(NTH,NK), CG(NK), WN(NK) REAL, intent(in) :: DEPTH REAL, intent(out) :: TSTOTn(NTH,NK), TSDERn(NTH,NK) @@ -883,8 +885,8 @@ SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) ! Gamma_max=1.3 (JFMAX>NF) TO OBTAIN IMPROVED RESULTS ! Note by Fabrice Ardhuin: this appears to give the difference in tail benaviour with Gerbrant's WRT !======================================================================= - JFMIN= 1-INT(LOG(1.0D0)/LOG(RAISF)) - JFMAX=NF+INT(LOG(1.3D0)/LOG(RAISF)) + JFMIN=MAX(1-INT(LOG(1.0D0)/LOG(RAISF)),1) + JFMAX=MIN(NF+INT(LOG(1.3D0)/LOG(RAISF)),NK) ! !======================================================================= ! COMPUTES THE SPECTRUM THRESHOLD VALUES (BELOW WHICH QNL4 IS NOT @@ -1065,7 +1067,7 @@ SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) TEMP=(TB_TPM(IQ_OM2,JT1,JF1)*(( F(JT1P2P,JFM2)*CF2 *F(JT1P3M,JFM3)*CF3)* & (F(JT,JFM0 )*CF0*TB_V14(JF1)+F(JT1P ,JFM1)*CF1) & -SP0*SP1P*(SP1P2P*V3_4+SP1P3M*V2_4))+T_2M3P*(AUX05*AUX01-AUX02*AUX06)) *CP0 - WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT, F(JT,JFM0) + WRITE(995,'(3I3,3E12.3)') ICONF,JF,JT, F(JT,JFM0) TEMP=(Q_2P3M+Q_2M3P) *CP1 WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P, JFM1,AUX00 *CP1, F(JT1P,JFM1),TSTOT(JT1P,JFM1) WRITE(995,'(5I3,3E12.3)') ICONF,JF,JT,JT1P2P,JFM2,-Q_2P3M*CP2,F(JT1P2P,JFM2),TSTOT(JT1P2P,JFM2) @@ -1219,6 +1221,8 @@ FUNCTION COUPLE(XK1 ,YK1 ,XK2 ,YK2 ,XK3 ,YK3 ,XK4 ,YK4) !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: GRAV ! + IMPLICIT NONE + DOUBLE PRECISION, INTENT(IN) :: XK1 , YK1 , XK2 , YK2 DOUBLE PRECISION, INTENT(IN) :: XK3 , YK3 DOUBLE PRECISION, INTENT(IN) :: XK4 , YK4 @@ -1305,6 +1309,7 @@ SUBROUTINE GAULEG (W_LEG ,X_LEG ,NPOIN) !/ ------------------------------------------------------------------- / !.....VARIABLES IN ARGUMENT ! """""""""""""""""""" + IMPLICIT NONE INTEGER , INTENT(IN) :: NPOIN DOUBLE PRECISION ,INTENT(INOUT) :: W_LEG(NPOIN) , X_LEG(NPOIN) ! @@ -1552,6 +1557,7 @@ SUBROUTINE INSNLGQM #ifdef W3_S CALL STRACE (IENT, 'INSNLGQM') #endif + IMPLICIT NONE !.....LOCAL VARIABLES INTEGER JF , JT , JF1 , JT1 , NF1P1 , IAUX , NT , NF , IK INTEGER IQ_TE1 , IQ_OM2 , LBUF , DIMBUF , IQ_OM1 , NQ_TE1 , NCONFM @@ -2084,10 +2090,7 @@ SUBROUTINE INSNLGQM AUX=0.0D0 DO JT1=1,GQNT1 DO IQ_OM2=1,GQNQ_OM2 - AAA=TB_FAC(IQ_OM2,JT1,JF1)*TB_TPM(IQ_OM2,JT1,JF1) - IF (AAA.GT.AUX) AUX=AAA - CCC=TB_FAC(IQ_OM2,JT1,JF1)*TB_TMP(IQ_OM2,JT1,JF1) - IF (CCC.GT.AUX) AUX=CCC + AUX=MAX(AUX,TB_FAC(IQ_OM2,JT1,JF1)*TB_TPM(IQ_OM2,JT1,JF1),TB_FAC(IQ_OM2,JT1,JF1)*TB_TMP(IQ_OM2,JT1,JF1)) ENDDO ENDDO MAXCLA(JF1)=AUX @@ -2099,6 +2102,7 @@ SUBROUTINE INSNLGQM DO JF1=1,GQNF1 IF (MAXCLA(JF1).GT.AUX) AUX=MAXCLA(JF1) ENDDO + TEST1=SEUIL1*AUX ! !.....Set to zero the coupling coefficients not used @@ -2128,7 +2132,9 @@ SUBROUTINE INSNLGQM ! !..... counts the fraction of the eliminated configurations ELIM=(1.D0-DBLE(NCONF)/DBLE(NCONFM))*100.D0 - ! WRITE(994,*) 'NCONF:',NCONF,ELIM +#ifdef W3_TGQM + WRITE(994,*) 'NCONF, ELIM FRACTION:',NCONF,ELIM +#endif END SUBROUTINE INSNLGQM !/ !/ End of module W3SNL1MD -------------------------------------------- / diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index e2bf12c9a1..a1d4423bf2 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -2520,7 +2520,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & RETURN END IF ! - WHITECAP(1:2) = 0. + WHITECAP(1:4) = 0. ! ! precomputes integration of Lambda over direction ! times wavelength times a (a=5 in Reul&Chapron JGR 2003) times dk From 3f35df79359f90969b4c33069b82477003d9fdb5 Mon Sep 17 00:00:00 2001 From: Edward Hartnett <38856240+edwardhartnett@users.noreply.github.com> Date: Thu, 30 Nov 2023 12:33:23 -0700 Subject: [PATCH 024/136] Adding documentation to w3iopo() in preparation for code for #682. (#1131) --- model/src/w3iopomd.F90 | 78 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 71 insertions(+), 7 deletions(-) diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index d573879ce7..0c15ea8c6a 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -1023,17 +1023,81 @@ SUBROUTINE W3IOPE ( A ) !/ End of W3IOPE ----------------------------------------------------- / !/ END SUBROUTINE W3IOPE - !/ ------------------------------------------------------------------- / + + !> Read or write point output. !> - !> @brief Read/write point output. + !> This subroutine can either read or write the point output file, + !> depending on the value of the first parameter. !> - !> @param[in] INXOUT Test string for read/write. - !> @param[in] NDSOP File unit number. - !> @param[out] IOTST Test indictor for reading. - !> @param[in] IMOD Model number for W3GDAT etc. + !> When reading, the entire file is read with one call to this + !> subroutine. !> - !> @author H. L. Tolman @date 25-Jul-2006 + !> When writing, this subroutine can either write one timestep or + !> the whole model run. This is an option in the input file. If the + !> entire model run is to be written, then OFILES(2) is 0. If only + !> one timestep is to be written, then OFILES(2) is 1. + !> + !> If OFILES(2) is 0, the output file is names out_pnt.ww3. If + !> OFILES(2) is 1, the output file is named TIMETAG.out_pnt.ww3. + !> + !> The format of the point output file is: + !> Size (bytes) | Type | Variable | Meaning + !> -------------|------|----------|-------- + !> 40 | character*40 | IDTST | ID string + !> 4 | integer | VERTST | Model definition file version number + !> 4 | integer | NK | Dimension of frequency + !> 4 | integer | MTH | Directionality of the frequency + !> 4 | integer | NOPTS | Number of output points. + !> 8*NOPTS | integer(2,NOPTS) | PTLOC | Point locations + !> 7*NOPTS | character*7 | PTNME | Point names + !> 8 | integer(2) | TIME | Time + !> reclen*NOPTS | * | * | records + !> + !> Each record contains: + !> Size (bytes) | Type | Variable | Meaning + !> -------------|------|----------|-------- + !> 4 | integer | IW | Number of water points in interpolation box for output point. + !> 4 | integer | II | Number of ice points in interpolation box for output point. + !> 4 | integer | IL | Number of land points in interpolation box for output point. + !> 4 | real | DPO | Interpolated depths. + !> 4 | real | WAO | Interpolated wind speeds. + !> 4 | real | WDO | Interpolated wind directions. + !> 4 | real | TAUAO | (W3_FLX5 only) Interpolated atmospheric stresses. + !> 4 | real | TAUDO | (W3_FLX5 only) Interpolated atmospheric stress directions. + !> 4 | real | DAIRO | (W3_FLX5 only) Interpolated rho atmosphere. + !> 4 | real | ZET_SETO | (W3_SETUP only) Used for wave setup. + !> 4 | real | ASO | Interpolated air-sea temperature difference + !> 4 | real | CAO | Interpolated current speeds. + !> 4 | real | CDO | Interpolated current directions. + !> 4 | real | ICEO | Interpolated ice concentration. + !> 4 | real | ICEHO | Interpolated ice thickness. + !> 4 | real | ICEFO | Interpolated ice floe. + !> 13 | char | GRDID | Originating grid ID + !> 4 | real | SPCO(J,I),J=1,NSPEC | Output spectra !> + !> In the event of error, EXTCDE() will be called with the following exit codes: + !> - 1 INXOUT must be 'READ' or 'WRITE'. + !> - 2 Unexpectedly changed from WRITE to READ in subsequent call. + !> - 10 Unexpected IDSTR + !> - 11 Unexpected VEROPT + !> - 12 Unexpected MK or MTH + !> - 20 Error opening file. + !> - 21 Unexpected end of file during read. + !> - 22 Error reading file. + !> - 23 Unexpected end of file during read. + !> + !> @param[in] INXOUT String indicating read/write. Must be 'READ' or + !> 'WRITE'. + !> @param[in] NDSOP File unit number. + !> @param[out] IOTST Error code: + !> - 0 No error. + !> - -1 Unexpected end of file when reading. + !> @param[in] IMOD Model number for W3GDAT etc. +#ifdef W3_ASCII + !> @param[in] NDSOA File unit number for ASCII output. +#endif + !> + !> @author H. L. Tolman @date 25-Jul-2006 SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & #ifdef W3_ASCII ,NDSOA & From ff1b9e9df09607a15b532392594f55a831927941 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Thu, 7 Dec 2023 15:42:16 -0500 Subject: [PATCH 025/136] NCEP regtest module updates: uses spack-stack/1.5.0, includes scotch/7.0.4 (#1137) --- regtests/bin/matrix_cmake_ncep | 51 ++++++++++++++++------------------ 1 file changed, 24 insertions(+), 27 deletions(-) diff --git a/regtests/bin/matrix_cmake_ncep b/regtests/bin/matrix_cmake_ncep index 771b6f96ed..300af93e38 100755 --- a/regtests/bin/matrix_cmake_ncep +++ b/regtests/bin/matrix_cmake_ncep @@ -41,16 +41,18 @@ EOF # Convert main_dir to absolute path main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" -# Module Versions from HPC-Stack that are common for all platforms - modnetcdf='netcdf/4.7.4' - modjasper='jasper/2.0.25' - modzlib='zlib/1.2.11' +# Module Versions from spack-stack that are common for all platforms + modnetcdfc='netcdf-c/4.9.2' + modnetcdff='netcdf-fortran/4.6.0' + modjasper='jasper/2.0.32' + modzlib='zlib/1.2.13' modpng='libpng/1.6.37' - modhdf5='hdf5/1.10.6' + modhdf5='hdf5/1.14.0' modbacio='bacio/2.4.1' modg2='g2/3.4.5' - modw3emc='w3emc/2.9.2' - modesmf='esmf/8.3.0b09' + modw3emc='w3emc/2.10.0' + modesmf='esmf/8.4.2' + modscotch='scotch/7.0.4' # Set batchq queue, choose modules and other custom variables to fit system and # to define headers etc (default to original version if empty) @@ -62,25 +64,21 @@ EOF batchq='slurm' basemodcomp='intel/2022.1.2' basemodmpi='impi/2022.1.2' - hpcstackpath='/scratch1/NCEPDEV/nems/role.epic/hpc-stack/libs/intel-2022.1.2/modulefiles/stack' - hpcstackversion='hpc/1.2.0' - modcomp='hpc-intel/2022.1.2' - modmpi='hpc-impi/2022.1.2' - scotchpath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hpc-stack/scotch-v7.0.3/install' - metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hpc-stack/parmetis-4.0.3/install' - modcmake='cmake/3.20.1' + spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.5.0/envs/unified-env-noavx512/install/modulefiles/Core' + modcomp='stack-intel/2021.5.0' + modmpi='stack-intel-oneapi-mpi/2021.5.1' + metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/spack-stack/1.5.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' elif [ $isorion ] then batchq='slurm' basemodcomp='intel/2022.1.2' basemodmpi='impi/2022.1.2' - hpcstackpath='/work/noaa/epic-ps/role-epic-ps/hpc-stack/libs/intel-2022.1.2/modulefiles/stack' - hpcstackversion='hpc/1.2.0' - modcomp='hpc-intel/2022.1.2' - modmpi='hpc-impi/2022.1.2' - scotchpath='/work2/noaa/marine/mmasarik/waves/opt/hpc-stack/scotch-v7.0.3/install' - metispath='/work2/noaa/marine/mmasarik/waves/opt/hpc-stack/parmetis-4.0.3/install' - modcmake='cmake/3.22.1' + spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.5.0/envs/unified-env/install/modulefiles/Core' + modcomp='stack-intel/2022.0.2' + modmpi='stack-intel-oneapi-mpi/2021.5.1' + metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/spack-stack/1.5.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' else batchq= fi @@ -139,29 +137,28 @@ EOF # Netcdf, Parmetis and SCOTCH modules & variables echo " module purge" >> matrix.head - echo " module load $modcmake" >> matrix.head if [ ! -z $basemodcomp ]; then echo " module load $basemodcomp" >> matrix.head fi if [ ! -z $basemodmpi ]; then echo " module load $basemodmpi" >> matrix.head fi - echo " module use $hpcstackpath" >> matrix.head - echo " module load $hpcstackversion" >> matrix.head + echo " module use $spackstackpath" >> matrix.head echo " module load $modcomp" >> matrix.head echo " module load $modmpi" >> matrix.head + echo " module load $modcmake" >> matrix.head echo " module load $modpng" >> matrix.head echo " module load $modzlib" >> matrix.head echo " module load $modjasper" >> matrix.head echo " module load $modhdf5" >> matrix.head - echo " module load $modnetcdf" >> matrix.head + echo " module load $modnetcdfc" >> matrix.head + echo " module load $modnetcdff" >> matrix.head echo " module load $modbacio" >> matrix.head echo " module load $modg2" >> matrix.head echo " module load $modw3emc" >> matrix.head echo " module load $modesmf" >> matrix.head - + echo " module load $modscotch" >> matrix.head echo " export METIS_PATH=${metispath}" >> matrix.head - echo " export SCOTCH_PATH=${scotchpath}" >> matrix.head echo " export path_build_root=$(dirname $main_dir)/regtests/buildmatrix" >> matrix.head echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}' >> matrix.head echo ' ' From d3ea810da35e9266a4163b4b8f2f4cba5599a5eb Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 12 Dec 2023 15:15:42 -0500 Subject: [PATCH 026/136] Minor update to ncep regtests (#1138) --- regtests/bin/matrix_cmake_ncep | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/regtests/bin/matrix_cmake_ncep b/regtests/bin/matrix_cmake_ncep index 300af93e38..7d0d26bec8 100755 --- a/regtests/bin/matrix_cmake_ncep +++ b/regtests/bin/matrix_cmake_ncep @@ -62,8 +62,6 @@ EOF then # If no other h, assuming Hera batchq='slurm' - basemodcomp='intel/2022.1.2' - basemodmpi='impi/2022.1.2' spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.5.0/envs/unified-env-noavx512/install/modulefiles/Core' modcomp='stack-intel/2021.5.0' modmpi='stack-intel-oneapi-mpi/2021.5.1' @@ -72,8 +70,6 @@ EOF elif [ $isorion ] then batchq='slurm' - basemodcomp='intel/2022.1.2' - basemodmpi='impi/2022.1.2' spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.5.0/envs/unified-env/install/modulefiles/Core' modcomp='stack-intel/2022.0.2' modmpi='stack-intel-oneapi-mpi/2021.5.1' @@ -94,7 +90,7 @@ EOF # 1.a Computer/ user dependent set up - echo '#!/bin/sh --login' > matrix.head + echo '#!/bin/sh' > matrix.head echo ' ' >> matrix.head if [ $batchq = "slurm" ] && [ $isorion ] then From 88c89be2b4d868442bfea6dfc29feb5eba1e2058 Mon Sep 17 00:00:00 2001 From: Edward Hartnett <38856240+edwardhartnett@users.noreply.github.com> Date: Tue, 26 Dec 2023 13:16:55 -0700 Subject: [PATCH 027/136] Updated intel workflow to install oneapi compilers from new location. (#1157) --- .github/workflows/intel.yml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index 700553ceac..54a388c55d 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -1,3 +1,8 @@ +# This is a GitHub actions workflow for WW3. +# +# This workflow builds with the Intel compilers. +# +# Matt Masarik, Alex Richert, Ed Hartnett name: Intel Linux Build on: [push, pull_request, workflow_dispatch] @@ -8,7 +13,7 @@ concurrency: # Set I_MPI_CC/F90 so Intel MPI wrapper uses icc/ifort instead of gcc/gfortran env: - cache_key: intel10 + cache_key: intel10-3 CC: icc FC: ifort CXX: icpc @@ -51,7 +56,7 @@ jobs: sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update - sudo apt-get install intel-oneapi-dev-utilities intel-oneapi-mpi-devel intel-oneapi-openmp intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic + sudo apt-get install intel-oneapi-dev-utilities intel-oneapi-mpi-devel intel-oneapi-compiler-fortran-2023.2.1 intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2023.2.1 intel-oneapi-openmp # Build WW3 spack environment - name: install-dependencies-with-spack From 7bec5605487761a03759a5e2f5f7159f18f0ca1b Mon Sep 17 00:00:00 2001 From: Edward Hartnett <38856240+edwardhartnett@users.noreply.github.com> Date: Thu, 4 Jan 2024 10:03:03 -0700 Subject: [PATCH 028/136] Add unit test for points I/O code. (#1158) --- .github/workflows/io_gnu_yml.old | 122 +++++++++++++++++ CMakeLists.txt | 6 + regtests/unittests/CMakeLists.txt | 39 ++++++ regtests/unittests/data/switch.io | 1 + regtests/unittests/data/ww3_grid.inp | 48 +++++++ regtests/unittests/data/ww3_outp.inp | 8 ++ regtests/unittests/test_io_points_bin.F90 | 152 ++++++++++++++++++++++ 7 files changed, 376 insertions(+) create mode 100644 .github/workflows/io_gnu_yml.old create mode 100644 regtests/unittests/CMakeLists.txt create mode 100644 regtests/unittests/data/switch.io create mode 100644 regtests/unittests/data/ww3_grid.inp create mode 100644 regtests/unittests/data/ww3_outp.inp create mode 100644 regtests/unittests/test_io_points_bin.F90 diff --git a/.github/workflows/io_gnu_yml.old b/.github/workflows/io_gnu_yml.old new file mode 100644 index 0000000000..def5a1402a --- /dev/null +++ b/.github/workflows/io_gnu_yml.old @@ -0,0 +1,122 @@ +name: io_gnu +on: [push, pull_request, workflow_dispatch] + +# Cancel in-progress workflows when pushing to a branch +concurrency: + group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + +env: + cache_key: gnu11-1 + CC: gcc-10 + FC: gfortran-10 + CXX: g++-10 + + +# Split into a steup step, and a WW3 build step which +# builds multiple switches in a matrix. The setup is run once and +# the environment is cached so each build of WW3 can share the dependencies. + +jobs: + setup: + runs-on: ubuntu-latest + + steps: + - name: checkout-ww3 + if: steps.cache-env.outputs.cache-hit != 'true' + uses: actions/checkout@v3 + with: + path: ww3 + # Cache spack, OASIS, and compiler + # No way to flush Action cache, so key may have # appended + - name: cache-env + id: cache-env + uses: actions/cache@v3 + with: + path: | + spack + ~/.spack + work_oasis3-mct + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + + # Build WW3 spack environment + - name: install-dependencies-with-spack + if: steps.cache-env.outputs.cache-hit != 'true' + run: | + # Install NetCDF, ESMF, g2, etc using Spack + sudo apt install cmake + git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git + source spack/share/spack/setup-env.sh + spack env create ww3-gnu ww3/model/ci/spack_gnu.yaml + spack env activate ww3-gnu + spack compiler find + spack external find cmake + spack add mpich@3.4.2 + spack concretize + spack install --dirty -v + + - name: build-oasis + if: steps.cache-env.outputs.cache-hit != 'true' + run: | + source spack/share/spack/setup-env.sh + spack env activate ww3-gnu + export WWATCH3_DIR=${GITHUB_WORKSPACE}/ww3/model + export OASIS_INPUT_PATH=${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/oasis3-mct + export OASIS_WORK_PATH=${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/work_oasis3-mct + cd ww3/regtests/ww3_tp2.14/input/oasis3-mct/util/make_dir + cmake . + make VERBOSE=1 + cp -r ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/work_oasis3-mct ${GITHUB_WORKSPACE} + + io_gnu: + needs: setup + runs-on: ubuntu-latest + + steps: + - name: install-dependencies + run: | + sudo apt-get update + sudo apt-get install doxygen gcovr valgrind + + - name: checkout-ww3 + uses: actions/checkout@v3 + with: + path: ww3 + + - name: cache-env + id: cache-env + uses: actions/cache@v3 + with: + path: | + spack + ~/.spack + work_oasis3-mct + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + + - name: build-ww3 + run: | + source spack/share/spack/setup-env.sh + spack env activate ww3-gnu + set -x + cd ww3 + export CC=mpicc + export FC=mpif90 + export OASISDIR=${GITHUB_WORKSPACE}/work_oasis3-mct + mkdir build && cd build + export LD_LIBRARY_PATH="/home/runner/work/WW3/WW3/spack/var/spack/environments/ww3-gnu/.spack-env/view/:$LD_LIBRARY_PATH" + cmake -DSWITCH=${GITHUB_WORKSPACE}/ww3/regtests/unittests/data/switch.io -DCMAKE_BUILD_TYPE=Debug -DCMAKE_Fortran_FLAGS="-g -fprofile-abs-path -fprofile-arcs -ftest-coverage -O0 -Wall -fno-omit-frame-pointer -fsanitize=address" -DCMAKE_C_FLAGS="-g -fprofile-abs-path -fprofile-arcs -ftest-coverage -O0 -Wall -fno-omit-frame-pointer -fsanitize=address" .. + make -j2 VERBOSE=1 + ./bin/ww3_grid + mv mod_def.ww3 regtests/unittests + ctest --verbose --output-on-failure --rerun-failed + gcovr --root .. -v --html-details --exclude ../regtests/unittests --exclude CMakeFiles --print-summary -o test-coverage.html &> /dev/null + + - name: upload-test-coverage + uses: actions/upload-artifact@v3 + with: + name: ww3-test-coverage + path: | + ww3/build/*.html + ww3/build/*.css + + diff --git a/CMakeLists.txt b/CMakeLists.txt index 58115b3aa6..5436f9cb1d 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -58,3 +58,9 @@ if(NOT CMAKE_BUILD_TYPE MATCHES "^(Debug|Release|RelWithDebInfo|MinSizeRel)$") endif() add_subdirectory(model) + +# Turn on unit testing. +include(CTest) +if(BUILD_TESTING) + add_subdirectory(regtests/unittests) +endif() diff --git a/regtests/unittests/CMakeLists.txt b/regtests/unittests/CMakeLists.txt new file mode 100644 index 0000000000..69445bfb79 --- /dev/null +++ b/regtests/unittests/CMakeLists.txt @@ -0,0 +1,39 @@ +# This is the CMake file for the model/tests directory in the WW3 +# project. +# +# Ed Hartnett, 10/14/23 + +# Some very small test files may be committed to the repo. This +# function copies such a data file to the build directory. +function(copy_test_data name) + message(STATUS "Copying ${name} to ${CMAKE_CURRENT_BINARY_DIR}") + file(COPY "${CMAKE_CURRENT_SOURCE_DIR}/data/${name}" + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE GROUP_READ WORLD_READ) +endfunction() + +# Some very small test files may be committed to the repo. This +# function copies such a data file to the build directory. +function(copy_test_data_2 srcname destname) + message(STATUS "Copying ${srcname} to ${CMAKE_CURRENT_BINARY_DIR}/${destname}") + file(COPY "${CMAKE_CURRENT_SOURCE_DIR}/data/${srcname}" + DESTINATION "${CMAKE_BINARY_DIR}" + FILE_PERMISSIONS OWNER_READ OWNER_WRITE GROUP_READ WORLD_READ) + file(RENAME "${CMAKE_BINARY_DIR}/${srcname}" "${CMAKE_BINARY_DIR}/${destname}") +endfunction() + +# Function to build and run a test. +function(unit_test name) + add_executable(${name} ${name}.F90) + target_link_libraries(${name} PRIVATE ww3_lib) + add_test(NAME ${name} COMMAND ${name}) +endfunction() + +# Copy test data files that are in the repo to the build directory. +copy_test_data(switch.io) +copy_test_data_2(ww3_grid.inp ww3_grid.inp) + +# Build and run the tests. +unit_test(test_io_points_bin) + + diff --git a/regtests/unittests/data/switch.io b/regtests/unittests/data/switch.io new file mode 100644 index 0000000000..c97e44765d --- /dev/null +++ b/regtests/unittests/data/switch.io @@ -0,0 +1 @@ +NOGRB SHRD PR1 FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 \ No newline at end of file diff --git a/regtests/unittests/data/ww3_grid.inp b/regtests/unittests/data/ww3_grid.inp new file mode 100644 index 0000000000..6f45604f33 --- /dev/null +++ b/regtests/unittests/data/ww3_grid.inp @@ -0,0 +1,48 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + '1-D REFRACTION X ' +$ + 1.25 0.08 3 24 0. +$ + F T F T F F + 300. 300. 150. 300. +$ + &PRO1 CFLTM = 0.75 / + &PRO2 CFLTM = 0.75 / + &PRO3 CFLTM = 0.75, WDTHCG = 0., WDTHTH = 0. / + &PRO4 CFLTM = 0.75, RNFAC = 0., RSFAC = 0. / +END OF NAMELISTS +$ + 'RECT' F 'NONE' + 13 3 + 5.E3 5.E3 1. + -5.E3 -5.E3 1. +$ + -1. 1. 10 -1. 2 1 '(....)' 'UNIT' 'input' +$ +$ First grid +$ + 50 50 50 45 40 35 30 25 20 15 10 5 0 + 50 50 50 45 40 35 30 25 20 15 10 5 0 + 50 50 50 45 40 35 30 25 20 15 10 5 0 +$ +$ Second grid +$ +$ 0 5 10 15 20 25 30 35 40 45 50 50 50 +$ 0 5 10 15 20 25 30 35 40 45 50 50 50 +$ 0 5 10 15 20 25 30 35 40 45 50 50 50 +$ + 10 1 1 '(....)' 'PART' 'input' +$ +$ First grid +$ + 2 2 F +$ +$ Second grid +$ +$ 12 2 F + 0 0 F + 0 0 F + 0 0 +$ + 0. 0. 0. 0. 0 diff --git a/regtests/unittests/data/ww3_outp.inp b/regtests/unittests/data/ww3_outp.inp new file mode 100644 index 0000000000..dd728819fb --- /dev/null +++ b/regtests/unittests/data/ww3_outp.inp @@ -0,0 +1,8 @@ +$ + 20100101 000000 3600 1 +$ + 1 + -1 +$ + 4 + 2 30 20100101 000000 'UTC' diff --git a/regtests/unittests/test_io_points_bin.F90 b/regtests/unittests/test_io_points_bin.F90 new file mode 100644 index 0000000000..69c197bce8 --- /dev/null +++ b/regtests/unittests/test_io_points_bin.F90 @@ -0,0 +1,152 @@ +! This is a test for model IO for WW3. This tests the legacy (binary) +! output of points data, done by function W3IOPO(). +! +! Ed Hartnett 10/14/23 +program test_io_points_bin + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i + integer :: ndsop, iotest, ndsbul, ndsm + integer :: ndstrc, ntrace + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 binary point file code.' + + ! These are mysterious but have to be called or else the IPASS + ! variable does not exist and w3iopo() crashes. + call w3nmod(1, 6, 6) + call w3setg(1, 6, 6) + call w3ndat(6, 6) + call w3setw(1, 6, 6) + call w3nout(6, 6) + call w3seto(1, 6, 6) + + ndsm = 20 + ndsop = 20 + ndsbul = 0 + ndstrc = 6 + ntrace = 10 + + ! Create a point output file needed for this test. + if (write_test_file() .ne. 0) stop 1 + + write (ndso,900) +900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & + 15X,'==============================================='/) + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! This will not work. But cannot be tested because it will change the value of IPASS, +! call w3iopo('EAD', ndsop, iotest) +! if (iotest .ne. 1) stop 7 + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + call w3iopo('READ', ndsop, iotest) + if (iotest .ne. 0) stop 10 + close(ndsop) + + ! Make sure we got the values we expected. + if (nopts .ne. 11) stop 11 + expected_loc_1 = 0.0 + do i = 1, nopts + ! Check ptnme and ptloc arrays. + print *, ptnme(i), ptloc(1, i), ptloc(2, i) + if (i .lt. 10) then + my_fmt = '(a,i1)' + else + my_fmt = '(a,i2)' + endif + write(fmt = my_fmt, unit=expected_ptnme) 'Point', i + if (ptnme(i) .ne. expected_ptnme) stop 20 + print *, expected_loc_1 + if (ptloc(1, i) .ne. expected_loc_1) stop 21 + expected_loc_1 = expected_loc_1 + 5000.0 + if (ptloc(2, i) .ne. 0) stop 22 + end do + + print *, 'OK!' + print *, 'SUCCESS!' +end program test_io_points_bin + +integer function write_test_file() + implicit none + + integer :: ntlu, nk, nth, nopts + character(len=10), parameter :: veropt = '2021-04-06' + character(len=31), parameter :: idstr = 'WAVEWATCH III POINT OUTPUT FILE' + real :: ptloc(2,11) = reshape((/ 0., 0., 5000., 0., 10000., 0., 15000., 0., & + 20000., 0., 25000., 0., 30000., 0., 35000., 0., 40000., 0., 45000., 0., 50000., 0. /), & + (/ 2, 11 /)) + character*40 ptnme(11) + integer :: time(2) = (/ 19680606, 0 /) + integer :: nspec = 72 + integer :: iw(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer :: ii(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer :: il(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + real :: iceo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: iceho(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: icefo(11) = (/ 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000. /) + real :: dpo(11) = (/ 50., 50., 45., 40., 35., 30., 25., 20., 15., 10., 5. /) + real :: wao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: wdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: aso(11) = (/ -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, & + -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, -999.900024 /) + real :: cao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: cdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + character*13 :: grdid(11) + real :: spco(72, 11) + integer :: i, j + integer :: ierr + + ! Initialize some values. + ntlu = 21 + nk = 3 + nth = 24 + nopts = 11 + do i = 1, nopts + if (i .le. 9) then + write(ptnme(i), '(a,i1)') 'Point', i + else + write(ptnme(i), '(a,i2)') 'Point', i + endif + grdid(i) = 'ww3 ' + end do + + ! Open the file. + open(ntlu, file="out_pnt.ww3", form="unformatted", status="replace", & + action="write", convert="big_endian", iostat=ierr) + if (ierr .ne. 0) stop 111 + + ! Write our values. + write (ntlu, iostat=ierr) idstr, veropt, nk, nth, nopts + if (ierr .ne. 0) stop 112 + write (ntlu, iostat=ierr) ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts) + if (ierr .ne. 0) stop 113 + write (ntlu, iostat=ierr) time + if (ierr .ne. 0) stop 114 + do i=1, nopts + write (ntlu, iostat=ierr) iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), & + aso(i), cao(i), cdo(i), iceo(i), iceho(i), & + icefo(i), grdid(i), (spco(j,i),j=1,nspec) + if (ierr .ne. 0) stop 115 + enddo + + ! Close the file. + close(ntlu) + + ! We're done! + write_test_file = 0 +end function write_test_file + From 63f82704fb6dce077958cfb562193320fb0d0da7 Mon Sep 17 00:00:00 2001 From: Alex Richert <82525672+AlexanderRichert-NOAA@users.noreply.github.com> Date: Thu, 11 Jan 2024 14:12:05 -0500 Subject: [PATCH 029/136] Update Intel CI (relocate /usr/local; ensure intel-oneapi-mpi; use ubuntu-latest) (#1161) --- .github/workflows/intel.yml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml index 54a388c55d..f5de65dcd3 100644 --- a/.github/workflows/intel.yml +++ b/.github/workflows/intel.yml @@ -26,7 +26,7 @@ env: jobs: setup: - runs-on: ubuntu-20.04 + runs-on: ubuntu-latest steps: @@ -62,6 +62,7 @@ jobs: - name: install-dependencies-with-spack if: steps.cache-env.outputs.cache-hit != 'true' run: | + sudo mv /usr/local /usr/local_mv # Install NetCDF, ESMF, g2, etc using Spack . /opt/intel/oneapi/setvars.sh git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git @@ -72,7 +73,7 @@ jobs: spack compiler find sudo apt install cmake spack external find - spack add intel-oneapi-mpi + spack config add "packages:mpi:require:'intel-oneapi-mpi'" spack config add "packages:all:require:['%intel']" spack concretize spack install --dirty -v --fail-fast @@ -97,7 +98,7 @@ jobs: strategy: matrix: switch: [Ifremer1, NCEP_st2, NCEP_st4, ite_pdlib, NCEP_st4sbs, NCEP_glwu, OASACM, UKMO, MULTI_ESMF] - runs-on: ubuntu-20.04 + runs-on: ubuntu-latest steps: - name: checkout-ww3 @@ -118,6 +119,8 @@ jobs: - name: build-ww3 run: | + sudo mv /usr/local /usr/local_mv + sudo apt install cmake . /opt/intel/oneapi/setvars.sh source spack/share/spack/setup-env.sh spack env activate ww3-intel From 3952826f7f0f79b622f5e325151355a05cda09b8 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Tue, 16 Jan 2024 18:49:43 +0100 Subject: [PATCH 030/136] remove lookup table for ST4 to speed up computation and clean up the ST4 code (#1124) Co-authored-by: Fabrice Ardhuin --- manual/eqs/ST3.tex | 11 +- manual/eqs/ST4.tex | 20 +- model/src/w3gdatmd.F90 | 11 +- model/src/w3gridmd.F90 | 58 ++- model/src/w3iogrmd.F90 | 59 ++- model/src/w3src4md.F90 | 493 ++++++++++-------- model/src/w3srcemd.F90 | 21 +- model/src/ww3_ounp.F90 | 2 +- regtests/bin/matrix.base | 4 + regtests/bin/run_cmake_test | 4 +- regtests/ww3_ts1/input/namelists_ST4_T500.nml | 3 + regtests/ww3_ts1/input/namelists_ST4_T707.nml | 2 +- regtests/ww3_ts1/input/ww3_grid_ST4_T500.nml | 225 ++++++++ .../ww3_ts1/input_10ms/namelists_Romero.nml | 20 + .../ww3_ts1/input_10ms/namelists_ST4_T471.nml | 2 + .../ww3_ts1/input_10ms/namelists_ST4_T475.nml | 7 + .../ww3_ts1/input_10ms/namelists_ST4_T701.nml | 20 + .../ww3_ts1/input_10ms/namelists_ST4_T702.nml | 14 + .../ww3_ts1/input_10ms/namelists_ST4_T707.nml | 2 +- .../ww3_ts1/input_10ms/namelists_ST4_T713.nml | 5 +- .../ww3_ts1/input_10ms/ww3_grid_Romero.nml | 225 ++++++++ .../ww3_ts1/input_10ms/ww3_grid_ST4_T471.nml | 225 ++++++++ .../ww3_ts1/input_10ms/ww3_grid_ST4_T475.nml | 225 ++++++++ .../ww3_ts1/input_10ms/ww3_grid_ST4_T701.nml | 225 ++++++++ .../ww3_ts1/input_10ms/ww3_grid_ST4_T702.nml | 225 ++++++++ 25 files changed, 1801 insertions(+), 307 deletions(-) create mode 100644 regtests/ww3_ts1/input/namelists_ST4_T500.nml create mode 100644 regtests/ww3_ts1/input/ww3_grid_ST4_T500.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_Romero.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_ST4_T471.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_ST4_T475.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_ST4_T701.nml create mode 100644 regtests/ww3_ts1/input_10ms/namelists_ST4_T702.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_Romero.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T471.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T475.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T701.nml create mode 100644 regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T702.nml diff --git a/manual/eqs/ST3.tex b/manual/eqs/ST3.tex index 91a7fca105..b287aa2ecd 100644 --- a/manual/eqs/ST3.tex +++ b/manual/eqs/ST3.tex @@ -57,16 +57,15 @@ \subsubsection{~$S_{in} + S_{ds}$: \wam\ cycle 4 (ECWAM)} \label{sec:ST3} waves that travel faster than the wind. This accounts for some gustiness in the wind and should possibly be resolution-dependent. For reference, this parameter was not properly set in early versions of the SWAN model, as -discovered by R. Lalbeharry.}. The roughness $z_1$ is defined as, - +discovered by R. Lalbeharry.}. If the friction velocity $u_\star$ is known, +it gives the roughness $z_1$ and the wind speed at altitude $z_u$ (by default $z_u=10$~m), \begin{eqnarray} -U_{10}&=&\frac{u_\star}{\kappa} \log\left(\frac{z_u}{z_1}\right) \\ -z_1&=&\alpha_0 \frac{\tau}{ \sqrt{1-\tau_w/\tau}}, +z_1&=&\alpha_0 \frac{\tau}{ \sqrt{1-\tau_w/u_\star^2}}, \\ +U(z_u)&=&\frac{u_\star}{\kappa} \log\left(\frac{z_u}{z_1}\right) \end{eqnarray} \noindent -where $\tau=u_\star^2$, and $z_u$ is the height at which the wind is -specified. These two equations provide an implicit functional dependence of +In practice these two equations provide an implicit functional dependence of $u_\star$ on $U_{10}$ and $\tau_w/\tau$. This relationship is then tabulated \citep{art:Jan91, rep:Bea07}. diff --git a/manual/eqs/ST4.tex b/manual/eqs/ST4.tex index 624ac6af8d..733ec09e71 100644 --- a/manual/eqs/ST4.tex +++ b/manual/eqs/ST4.tex @@ -8,10 +8,10 @@ \subsubsection{~$S_{\mathrm{in}} + S_{\mathrm{ds}}$: Saturation-based dissipatio This family of parameterizations uses a positive part of the wind input taken from WAM cycle 4 with an ad hoc reduction of $u_\star$, implemented in order to allow a balance with a saturation-based dissipation that uses different options for -a cumulative term. There are three main options for defining the saturation and the cumulative term. Chosing one or the other is done with the {\F SDSBCHOICE} parameter, with {\F SDSBCHOICE=1} for \cite{art:Aea10}, {\F SDSBCHOICE=2} for \cite{Filipot&Ardhuin2012}, and {\F SDSBCHOICE=3} for \cite{Romero2019}. That last options uses a saturation that is defined from the local spectral density, and thus gives zero dissipation for directions where the threshold is not reached, leading to much broader directional spectra. Also the stronger bimodality is achieved by having a strong modulation effect as a cumulative term. +a cumulative term. There are three main options for defining the saturation and the cumulative term. Chosing one or the other is done with the {\F SDSBCHOICE} parameter, with {\F SDSBCHOICE=1} for \cite{art:Aea10}, {\F SDSBCHOICE=2} for \cite{Filipot&Ardhuin2012}, and {\F SDSBCHOICE=3} for \cite{Romero2019} and later adjustments including \cite{art:AA23}. That last option uses a saturation that is defined from the local spectral density, and thus gives zero dissipation for directions where the threshold is not reached, leading to much broader directional spectra. Also the stronger bimodality is achieved by having a strong modulation effect as a cumulative term. Many other adjustments can be made by changing the namelist parameters. A few successful combinations -are given by tables \ref{tab:ST4_parSIN} and \ref{tab:ST4_parSDS}, with results described by \citep{art:RA13,art:SAG16}. +are given by tables \ref{tab:ST4_parSIN} and \ref{tab:ST4_parSDS}, with results described by \citep{art:RA13,art:SAG16,art:AA23}. Further calibration to any particular wind field should be done for best performance. Guidance for this is given by \cite{Stopa2018}. %We also note that the particular %set of parameters T400 corresponds to setting IPHYS=1 in the ECWAM code cycle 45R2, with a few differences @@ -216,27 +216,15 @@ \subsubsection{~$S_{\mathrm{in}} + S_{\mathrm{ds}}$: Saturation-based dissipatio direction will typically produce less dissipation than a sea state with all the energy radiated in the same direction. -Based on recent analysis by \cite{Guimaraes2018} and \cite{Peureux&al.2019}, this saturation is enhanced by a factor $M_L$ that represents -the effect of long waves on short waves -\begin{equation} -M_l(k,\theta)=1+M_\theta \sqrt{\mathrm{mss}(k,\theta)} + N_\theta \sqrt{\mathrm{nss}(k,\theta)} \label{defFACSAT}. -\end{equation} -where $M_\theta$ is twice the modulation transfer function for short wave steepness, with -$M_\theta=8$ when following the simplified theory by \cite{art:LHS60} and using the root mean square enhancement of $B$ over a -long wave cycle. $N_\theta$ is an additional straining factor due to the instability of the wave action envelope of short waves -propagating in the direction close to that of the long wave \citep{Peureux&al.2019}. The squared slopes $\mathrm{mss}(k,\theta)$ is -the mean square slope in direction $\theta$, wheras $\mathrm{nss}(k,\theta)$ is a slope of long waves propagating in a narrow window $\pm \delta_\theta$, -around the short wave direction $\theta$. - We finally define our dissipation term as the sum of the saturation-based term and a cumulative breaking term $S_{\mathrm{bk,cu}}$, \begin{eqnarray} \cS_{ds}(k,\theta)& =& \sigma \frac{C_{\mathrm{ds}}^{\mathrm{sat}}}{B^2_r} \left[ \delta_d -\max\left\{ M_l(k,\theta) B\left(k\right) - +\max\left\{ B\left(k\right) - B_r,0\right\}^2 \right. \nonumber \\ - & & + \left(1-\delta_d \right) \left. \max\left\{ M_L(k,\theta) B'\left(k,\theta \right)- B_r + & & + \left(1-\delta_d \right) \left. \max\left\{B'\left(k,\theta \right)- B_r ,0\right\}^2\right]N(k,\theta) \nonumber \\ & & + \cS_{\mathrm{bk,cu}}(k,\theta) + \cS_{\mathrm{turb}}(k,\theta) \label{Sds_all}. \end{eqnarray} diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 7bc5e2f303..59d3bcddf5 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -897,7 +897,7 @@ MODULE W3GDATMD REAL, POINTER :: DCKI(:,:), SATWEIGHTS(:,:),CUMULW(:,:),QBI(:,:) REAL :: AALPHA, BBETA, ZZ0MAX, ZZ0RAT, ZZALP,& SSINTHP, TTAUWSHELTER, SSWELLF(1:7), & - SSDSC(1:21), SSDSBR, & + SSDSC(1:21), SSDSBR, SINTAILPAR(1:5),& SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & FFXPM, FFXFM, FFXFA, & SSDSBRF1, SSDSBRF2, SSDSBINT,SSDSBCK,& @@ -1317,7 +1317,7 @@ MODULE W3GDATMD FFXFM, FFXPM, SSDSBRF1, SSDSBRF2, & SSDSBINT, SSDSBCK, SSDSHCK, SSDSABK, & SSDSPBK, SSINBR,SSINTHP,TTAUWSHELTER,& - SSWELLF(:), SSDSC(:), SSDSBR, & + SINTAILPAR(:), SSWELLF(:), SSDSC(:), SSDSBR, & SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & SSDSBT, SSDSCOS, SSDSDTH, SSDSBM(:) #endif @@ -2074,12 +2074,18 @@ SUBROUTINE W3DIMS ( IMOD, MK, MTH, NDSE, NDST ) MPARS(IMOD)%SRCPS%QBI(NKHS,NKD), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) + MPARS(IMOD)%SRCPS%IKTAB(:,:)=0. + MPARS(IMOD)%SRCPS%DCKI(:,:)=0. + MPARS(IMOD)%SRCPS%QBI(:,:)=0. SDSNTH = MTH/2-1 !MIN(NINT(SSDSDTH/(DTH*RADE)),MTH/2-1) ALLOCATE( MPARS(IMOD)%SRCPS%SATINDICES(2*SDSNTH+1,MTH), & MPARS(IMOD)%SRCPS%SATWEIGHTS(2*SDSNTH+1,MTH), & MPARS(IMOD)%SRCPS%CUMULW(MSPEC,MSPEC), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) + MPARS(IMOD)%SRCPS%SATINDICES(:,:)=0. + MPARS(IMOD)%SRCPS%SATWEIGHTS(:,:)=0. + MPARS(IMOD)%SRCPS%CUMULW(:,:)=0. #endif ! SGRDS(IMOD)%SINIT = .TRUE. @@ -2648,6 +2654,7 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) ZZ0RAT => MPARS(IMOD)%SRCPS%ZZ0RAT ZZALP => MPARS(IMOD)%SRCPS%ZZALP TTAUWSHELTER => MPARS(IMOD)%SRCPS%TTAUWSHELTER + SINTAILPAR => MPARS(IMOD)%SRCPS%SINTAILPAR SSWELLFPAR => MPARS(IMOD)%SRCPS%SSWELLFPAR SSWELLF => MPARS(IMOD)%SRCPS%SSWELLF SSDSC => MPARS(IMOD)%SRCPS%SSDSC diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index fa8128afb4..5af38fc12e 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -839,7 +839,8 @@ MODULE W3GRIDMD #endif ! #ifdef W3_ST4 - INTEGER :: SWELLFPAR, SDSISO, SDSBRFDF + INTEGER :: SWELLFPAR, SDSISO, SDSBRFDF, SINTABLE,& + TAUWBUG REAL :: SDSBCHOICE REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& ZALP, Z0RAT, TAUWSHELTER, SWELLF, & @@ -855,7 +856,8 @@ MODULE W3GRIDMD SDSBRF1, & SDSBM0, SDSBM1, SDSBM2, SDSBM3, & SDSBM4, SDSFACMTF, SDSCUMP, SDSNUW, & - SDSL, SDSMWD, SDSMWPOW, SPMSS, SDSNMTF + SDSL, SDSMWD, SDSMWPOW, SPMSS, SDSNMTF, SINTAIL1, SINTAIL2, & + CUMSIGP, VISCSTRESS #endif ! #ifdef W3_ST6 @@ -997,7 +999,7 @@ MODULE W3GRIDMD NAMELIST /SIN4/ ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & TAUWSHELTER, SWELLFPAR, SWELLF, & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, & - SWELLF7, Z0RAT, SINBR + SWELLF7, Z0RAT, SINBR, SINTABLE, SINTAIL1, SINTAIL2, TAUWBUG, VISCSTRESS #endif #ifdef W3_NL1 NAMELIST /SNL1/ LAMBDA, NLPROP, KDCONV, KDMIN, & @@ -1039,7 +1041,7 @@ MODULE W3GRIDMD SDSC5, SDSC6, SDSBR, SDSBT, SDSP, SDSISO, & SDSBCK, SDSABK, SDSPBK, SDSBINT, SDSHCK, & SDSDTH, SDSCOS, SDSBRF1, SDSBRFDF, SDSNUW, & - SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & + SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, CUMSIGP,& WHITECAPWIDTH, WHITECAPDUR, SDSMWD, SDSMWPOW, SDKOF #endif @@ -1718,6 +1720,12 @@ SUBROUTINE W3GRID() TAUWSHELTER = 0.3 ZALP = 0.006 SINBR = 0. + SINTABLE = 1 + SINTAIL1 = 0. ! TAUWSHELTER FOR TAIL (no table) + SINTAIL2 = 0. ! additional peak in capillary range + TAUWBUG = 1 ! TAUWBUG is 1 is the bug is kept: + ! initializes TAUWX/Y to zero in W3SRCE + VISCSTRESS =0 #endif ! #ifdef W3_ST6 @@ -1801,6 +1809,11 @@ SUBROUTINE W3GRID() SSWELLF(6) = SWELLF6 SSWELLF(7) = SWELLF7 SSWELLFPAR = SWELLFPAR + SINTAILPAR(1) = FLOAT(SINTABLE) + SINTAILPAR(2) = SINTAIL1 + SINTAILPAR(3) = SINTAIL2 + SINTAILPAR(4) = FLOAT(TAUWBUG) + SINTAILPAR(5) = VISCSTRESS #endif ! #ifdef W3_ST6 @@ -2106,8 +2119,8 @@ SUBROUTINE W3GRID() SDSDTH = 80. SDSCOS = 2. SDSISO = 2 - SDSBM0 = 1. - SDSBM1 = 0. + SDSBM0 = 1. ! All these parameters are related to finite depth + SDSBM1 = 0. ! scaling of breaking SDSBM2 = 0. SDSBM3 = 0. SDSBM4 = 0. @@ -2117,8 +2130,9 @@ SUBROUTINE W3GRID() SDSBINT = 0.3 SDSHCK = 1.5 WHITECAPWIDTH = 0.3 - SDSSTRAIN = 0. SDSFACMTF = 400 ! MTF factor for Lambda , Romero (2019) + CUMSIGP = 0. + SDSSTRAIN = 0. SDSSTRAINA = 15. SDSSTRAIN2 = 0. WHITECAPDUR = 0.56 ! breaking duration factor @@ -2129,7 +2143,7 @@ SUBROUTINE W3GRID() ! MTF SPMSS = 0.5 ! cmss^SPMSS SDSNMTF = 1.5 ! MTF power - SDSCUMP = 2. + SDSCUMP = 2. ! 2 for cumulative mss, 1 for cumulative orb. vel. ! MW SDSMWD = .9 ! new AFo SDSMWPOW = 1. ! (k )^pow @@ -2211,9 +2225,9 @@ SUBROUTINE W3GRID() SSDSC(7) = WHITECAPWIDTH SSDSC(8) = SDSSTRAIN ! Straining constant ... SSDSC(9) = SDSL - SSDSC(10) = SDSSTRAINA*NTH/360. ! angle Aor enhanced straining + SSDSC(10) = SDSSTRAINA*NTH/360. ! angle for enhanced straining SSDSC(11) = SDSSTRAIN2 ! straining constant for directional part - SSDSC(12) = SDSBT + SSDSC(12) = CUMSIGP SSDSC(13) = SDSMWD SSDSC(14) = SPMSS SSDSC(15) = SDSMWPOW @@ -3197,7 +3211,7 @@ SUBROUTINE W3GRID() #ifdef W3_ST4 WRITE (NDSO,2920) ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & TAUWSHELTER, SWELLFPAR, SWELLF, SWELLF2, SWELLF3, SWELLF4, & - SWELLF5, SWELLF6, SWELLF7, Z0RAT, SINBR + SWELLF5, SWELLF6, SWELLF7, Z0RAT, SINBR, SINTABLE, TAUWBUG, VISCSTRESS, SINTAIL1, SINTAIL2 #endif #ifdef W3_ST6 WRITE (NDSO,2920) SINA0, SINWS, SINFC @@ -3262,7 +3276,7 @@ SUBROUTINE W3GRID() SDSBT, SDSP, SDSISO, SDSCOS, SDSDTH, SDSBRF1, & SDSBRFDF, SDSBM0, SDSBM1, SDSBM2, SDSBM3, SDSBM4, & SPMSS, SDKOF, SDSMWD, SDSFACMTF, SDSNMTF,SDSMWPOW,& - SDSCUMP, SDSNUW, WHITECAPWIDTH, WHITECAPDUR + SDSCUMP, CUMSIGP, SDSNUW, WHITECAPWIDTH, WHITECAPDUR #endif #ifdef W3_ST6 WRITE (NDSO,2924) SDSET, SDSA1, SDSA2, SDSP1, SDSP2 @@ -3305,7 +3319,7 @@ SUBROUTINE W3GRID() JGS_TERMINATE_DIFFERENCE, & JGS_TERMINATE_NORM, & JGS_LIMITER, & - JGS_LIMITER_FUNC, & + JGS_LIMITER_FUNC, & JGS_USE_JACOBI, & JGS_BLOCK_GAUSS_SEIDEL, & JGS_MAXITER, & @@ -3642,7 +3656,7 @@ SUBROUTINE W3GRID() END SELECT IF (FSTOTALIMP .or. FSTOTALEXP) THEN - LPDLIB = .TRUE. + LPDLIB = .TRUE. ENDIF ! IF (SUM(UNSTSCHEMES).GT.1) WRITE(NDSO,1035) @@ -6234,7 +6248,9 @@ SUBROUTINE W3GRID() ' SWELLF =',F8.5,', SWELLF2 =',F8.5, & ', SWELLF3 =',F8.5,', SWELLF4 =',F9.1,','/ & ' SWELLF5 =',F8.5,', SWELLF6 =',F8.5, & - ', SWELLF7 =',F12.2,', Z0RAT =',F8.5,', SINBR =',F8.5,' /') + ', SWELLF7 =',F12.2,', Z0RAT =',F8.5,', SINBR =',F8.5,','/ & + ' SINTABLE =',I2,', TAUWBUG =',I2, & + ', VISCSTRESS =',F8.5,', SINTAIL1 =',F8.5,', SINTAIL2 =',F8.5,' /') #endif ! #ifdef W3_ST6 @@ -6407,7 +6423,7 @@ SUBROUTINE W3GRID() ' SPMSS = ',F5.2, ', SDKOF =',F5.2, & ', SDSMWD =',F5.2,', SDSFACMTF =',F5.1,', '/ & ' SDSMWPOW =',F3.1,', SDSNMTF =', F5.2, & - ', SDSCUMP =', F3.1,', SDSNUW =', E8.3,', '/, & + ', SDSCUMP =', F3.1,', CUMSIGP =', F3.1,', SDSNUW =', E10.3,', '/, & ' WHITECAPWIDTH =',F5.2, ' WHITECAPDUR =',F5.2,' /') #endif ! @@ -6519,12 +6535,12 @@ SUBROUTINE W3GRID() 947 FORMAT (/' Ice scattering ',A,/ & ' --------------------------------------------------') 948 FORMAT (' IS2 Scattering ... '/& - ' scattering coefficient : ',E9.3/ & - ' 0: no back-scattering : ',E9.3/ & + ' scattering coefficient : ',E10.3/ & + ' 0: no back-scattering : ',E10.3/ & ' TRUE: istropic back-scattering : ',L3/ & ' TRUE: update of ICEDMAX : ',L3/ & ' TRUE: keeps updated ICEDMAX : ',L3/ & - ' flexural strength : ',E9.3/ & + ' flexural strength : ',E10.3/ & ' TRUE: uses Robinson-Palmer disp.: ',L3/ & ' attenuation : ',F5.2/ & ' fragility : ',F5.2/ & @@ -6532,7 +6548,7 @@ SUBROUTINE W3GRID() ' pack scattering coef 1 : ',F5.2/ & ' pack scattering coef 2 : ',F5.2/ & ' scaling by concentration : ',F5.2/ & - ' creep B coefficient : ',E9.3/ & + ' creep B coefficient : ',E10.3/ & ' creep C coefficient : ',F5.2/ & ' creep D coefficient : ',F5.2/ & ' creep N power : ',F5.2/ & @@ -6543,7 +6559,7 @@ SUBROUTINE W3GRID() ' energy of activation : ',F5.2/ & ' anelastic coefficient : ',E11.3/ & ' anelastic exponent : ',F5.2) -2948 FORMAT ( ' &SIS2 ISC1 =',E9.3,', IS2BACKSCAT =',E9.3, & +2948 FORMAT ( ' &SIS2 ISC1 =',E10.3,', IS2BACKSCAT =',E10.3, & ', IS2ISOSCAT =',L3,', IS2BREAK =',L3, & ', IS2DUPDATE =',L3,','/ & ' IS2FLEXSTR =',E11.3,', IS2DISP =',L3, & diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 4f211402d5..f8723d8123 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -1065,12 +1065,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & READ(NDSM,END=801,ERR=802,IOSTAT=IERR)GRIDSHIFT #ifdef W3_SEC1 - READ (NDSM) NITERSEC1 + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) NITERSEC1 #endif ! #ifdef W3_RTD !! Read rotated Polat/lon and AnglD from mod_def JGLi12Jun2012 - READ (NDSM) PoLat, PoLon, AnglD, FLAGUNR + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) PoLat, PoLon, AnglD, FLAGUNR #endif ! @@ -1313,35 +1313,35 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & FFACBERG, DELAB, FWTABLE #ifdef W3_RWND - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & RWINDC #endif #ifdef W3_WCOR - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & WWCOR #endif #ifdef W3_REF1 - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & RREF, REFPARS, REFLC, REFLD #endif #ifdef W3_IG1 - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IGPARS(1:12) #endif #ifdef W3_IC2 - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IC2PARS(1:8) #endif #ifdef W3_IC3 - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IC3PARS #endif #ifdef W3_IC4 - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IC4PARS,IC4_KI,IC4_FC #endif #ifdef W3_IC5 - READ (NDSM) & + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & IC5PARS #endif END IF @@ -1506,10 +1506,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & - SSDSHCK, DELUST, DELTAIL, DELTAUW, & - DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW + DIKCUMUL, CUMULW, SINTAILPAR #ifdef W3_ASCII WRITE (NDSA,*) & 'ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1520,10 +1519,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & - SSDSHCK, DELUST, DELTAIL, DELTAUW, & - DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW:', & + DIKCUMUL, CUMULW, SINTAILPAR:', & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & ZZ0RAT, SSDSC, & @@ -1532,11 +1530,22 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & - SSDSHCK, DELUST, DELTAIL, DELTAUW, & - DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW + DIKCUMUL, CUMULW, SINTAILPAR #endif + IF (SINTAILPAR(1).GT.0.5) THEN + WRITE (NDSM) DELUST, DELTAIL, DELTAUW, DELU, DELALP, & + TAUT, TAUHFT + IF (TTAUWSHELTER.GT.0) WRITE (NDSM) TAUHFT2 +#ifdef W3_ASCII + WRITE (NDSA,*) 'DELUST, DELTAIL, DELTAUW, DELU, DELALP,& + TAUT, TAUHFT:', & + DELUST, DELTAIL, DELTAUW, DELU, DELALP, & + TAUT, TAUHFT + IF (TTAUWSHELTER.GT.0) WRITE (NDSA,*) 'TAUHFT2:', TAUHFT2 +#endif + END IF ELSE READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1547,10 +1556,16 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSTXFTFTAIL, SSTXFTWN, SSTXFTF, SSTXFTWN, & SSDSBRF1, SSDSBRF2, SSDSBRFDF,SSDSBCK, SSDSABK, & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & - SSDSHCK, DELUST, DELTAIL, DELTAUW, & - DELU, DELALP, TAUT, TAUHFT, TAUHFT2, & + SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW + DIKCUMUL, CUMULW, SINTAILPAR + IF (SINTAILPAR(1).GT.0.5) THEN + CALL INSIN4(.FALSE.) + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + DELUST, DELTAIL, DELTAUW, DELU, DELALP, & + TAUT, TAUHFT + IF (TTAUWSHELTER.GT.0) READ(NDSM,END=801,ERR=802,IOSTAT=IERR) TAUHFT2 + END IF END IF #endif ! diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index a1d4423bf2..32eadaf824 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -39,6 +39,7 @@ MODULE W3SRC4MD !/ 02-Sep-2011 : Clean up and time optimization ( version 4.04 ) !/ 04-Sep-2011 : Estimation of whitecap stats. ( version 4.04 ) !/ 13-Nov-2013 : Reduced frequency range with IG ( version 4.13 ) + !/ 01-Mar-2023 : Clean up of SDS4 ( version 7.14 ) !/ ! 1. Purpose : ! @@ -90,11 +91,9 @@ MODULE W3SRC4MD !air kinematic viscosity (used in WAM) INTEGER, PARAMETER :: ITAUMAX=200,JUMAX=200 INTEGER, PARAMETER :: IUSTAR=100,IALPHA=200, ILEVTAIL=50 - REAL :: TAUT(0:ITAUMAX,0:JUMAX), DELTAUW, DELU - ! Table for H.F. stress as a function of 2 variables - REAL :: TAUHFT(0:IUSTAR,0:IALPHA), DELUST, DELALP - ! Table for H.F. stress as a function of 3 variables - REAL :: TAUHFT2(0:IUSTAR,0:IALPHA,0:ILEVTAIL) + ! Tables for total stress and H.F. stress as a function of 2 or 3 variables + REAL, ALLOCATABLE :: TAUT(:,:),TAUHFT(:,:),TAUHFT2(:,:,:) + REAL :: DELUST, DELALP,DELTAUW, DELU ! Table for swell damping REAL :: DELTAIL REAL, PARAMETER :: UMAX = 50. @@ -231,7 +230,7 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, DDEN, WWNMEANP, & WWNMEANPTAIL, FTE, FTF, SSTXFTF, SSTXFTWN,& SSTXFTFTAIL, SSWELLF, ESIN, ECOS, AAIRCMIN, & - AAIRGB, AALPHA, ZZWND + AAIRGB, AALPHA, ZZWND, SSDSC #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -267,7 +266,7 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & #endif REAL :: TAUW, EBAND, EMEANWS,UNZ, & - EB(NK),EB2(NK),ELCS, ELSN + EB(NK),EB2(NK),ELCS, ELSN, SIGFAC !/ !/ ------------------------------------------------------------------- / !/ @@ -294,17 +293,18 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & DO IK=1, NK EB(IK) = 0. EB2(IK) = 0. + SIGFAC=SIG(IK)**SSDSC(12) * DDEN(IK) / CG(IK) DO ITH=1, NTH IS=ITH+(IK-1)*NTH EB(IK) = EB(IK) + A(ITH,IK) - ELCS = ELCS + A(ITH,IK)*ECOS(IS)*DDEN(IK) / CG(IK) - ELSN = ELSN + A(ITH,IK)*ESIN(IS)*DDEN(IK) / CG(IK) + ELCS = ELCS + A(ITH,IK)*ECOS(IS)*SIGFAC + ELSN = ELSN + A(ITH,IK)*ESIN(IS)*SIGFAC IF (LLWS(IS)) EB2(IK) = EB2(IK) + A(ITH,IK) AMAX = MAX ( AMAX , A(ITH,IK) ) END DO END DO - - DLWMEAN=ATAN2(ELSN,ELCS); + ! + DLWMEAN=ATAN2(ELSN,ELCS) ! ! 2. Integrate over directions -------------------------------------- * ! @@ -358,7 +358,6 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & CALL W3FLX5 ( ZZWND, U, UDIR, TAUA, TAUADIR, DAIR, & USTAR, USDIR, Z0, CD, CHARN ) #else - Z0=0. CALL CALC_USTAR(U,TAUW,USTAR,Z0,CHARN) UNZ = MAX ( 0.01 , U ) CD = (USTAR/UNZ)**2 @@ -510,7 +509,7 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & USE W3GDATMD, ONLY: NK, NTH, NSPEC, DDEN, SIG, SIG2, TH, & ESIN, ECOS, EC2, ZZWND, AALPHA, BBETA, ZZALP,& TTAUWSHELTER, SSWELLF, DDEN2, DTH, SSINTHP, & - ZZ0RAT, SSINBR + ZZ0RAT, SSINBR, SINTAILPAR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -561,13 +560,21 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & REAL XI,DELI1,DELI2 REAL XJ,DELJ1,DELJ2 REAL XK,DELK1,DELK2 - REAL :: CONST, CONST0, CONST2, TAU1 + REAL :: CONST, CONST0, CONST2, TAU1, TAU1NT, ZINF, TENSK REAL X,ZARG,ZLOG,UST REAL :: COSWIND, XSTRESS, YSTRESS, TAUHF REAL TEMP, TEMP2 INTEGER IND,J,I,ISTAB REAL DSTAB(3,NSPEC), DVISC, DTURB REAL STRESSSTAB(3,2),STRESSSTABN(3,2) + ! + INTEGER, PARAMETER :: JTOT=50 + REAL , PARAMETER :: KM=363.,CMM=0.2325 ! K and C at phase speed minimum in rad/m + REAL :: OMEGACC, OMEGA, ZZ0, ZX, ZBETA, USTR, TAUR, & + CONST1, LEVTAIL0, X0, Y, DELY, YC, ZMU, & + LEVTAIL, CGTAIL, ALPHAM, FM, ALPHAT, FMEAN + + REAL, ALLOCATABLE :: W(:) #ifdef W3_T0 REAL :: DOUT(NK,NTH) #endif @@ -591,6 +598,11 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & STRESSSTAB =0. STRESSSTABN =0. ! + ! Coupling coefficient times density ratio DRAT + ! + CONST1=BBETA/KAPPA**2 ! needed for the tail + CONST0=CONST1*DRAT ! needed for the resolved spectrum + ! ! 1.a estimation of surface roughness parameters ! Z0VISC = 0.1*nu_air/MAX(USTAR,0.0001) @@ -615,9 +627,9 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & ! At this point UORB and AORB are the variances of the orbital velocity and surface elevation ! UORB = UORB + EB *SIG(IK)**2 * DDEN(IK) / CG(IK) - AORB = AORB + EB * DDEN(IK) / CG(IK) !deep water only + AORB = AORB + EB * DDEN(IK) / CG(IK) !correct for deep water only END DO - + ! FMEAN = SQRT((UORB+1E-6)/(AORB+1E-6)) UORB = 2*SQRT(UORB) ! significant orbital amplitude AORB1 = 2*AORB**(1-0.5*SSWELLF(6)) ! half the significant wave height ... if SWELLF(6)=1 RE = 4*UORB*AORB1 / NU_AIR ! Reynolds number @@ -695,10 +707,6 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & STRESSSTAB(ISTAB,:)=0. STRESSSTABN(ISTAB,:)=0. ! - ! Coupling coefficient times density ratio DRAT - ! - CONST0=BBETA*DRAT/(kappa**2) - ! DO IK=1, NK TAUPX=TAUX-ABS(TTAUWSHELTER)*STRESSSTAB(ISTAB,1) TAUPY=TAUY-ABS(TTAUWSHELTER)*STRESSSTAB(ISTAB,2) @@ -813,13 +821,22 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & DOUT(IK,ITH) = D(ITH+(IK-1)*NTH) END DO END DO - CALL PRT2DS (NDST, NK, NK, NTH, DOUT, SIG(1:NK), ' ', 1., & + CALL PRT2DS (NDST, NK, NK, NTH, DOUT, SIG(1), ' ', 1., & 0.0, 0.001, 'Diag Sin', ' ', 'NONAME') #endif ! #ifdef W3_T1 CALL OUTMAT (NDST, D, NTH, NTH, NK, 'diag Sin') #endif + ! + TAUPX=TAUX-ABS(TTAUWSHELTER)*XSTRESS + TAUPY=TAUY-ABS(TTAUWSHELTER)*YSTRESS + USTP=(TAUPX**2+TAUPY**2)**0.25 + USDIRP=ATAN2(TAUPY,TAUPX) + + UST=USTP + ! + ! Computes HF tail ! ! Computes the high-frequency contribution ! the difference in spectal density (kx,ky) to (f,theta) @@ -832,36 +849,115 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & COSWIND=(ECOS(IS)*COSU+ESIN(IS)*SINU) TEMP=TEMP+A(IS)*(MAX(COSWIND,0.))**3 END DO + ! + LEVTAIL0= CONST0*TEMP ! LEVTAIL is sum over theta of A(k,theta)*cos^3(theta-wind)*DTH*SIG^5/(g^2*2pi)*2*pi*SIG/CG + ! which is the same as sum of E(f,theta)*cos^3(theta-wind)*DTH*SIG^5/(g^2*2pi) + ! reminder: sum of E(f,theta)*DTH*SIG^5/(g^2*2pi) is 2*k^3*E(k) +! +! Computation of stress supported by tail: uses table if SINTAILPAR(1)=1 , correspoding to SINTABLE = 1 +! + IF (SINTAILPAR(1).LT.0.5) THEN + ALLOCATE(W(JTOT)) + W(2:JTOT-1)=1. + W(1)=0.5 + W(JTOT)=0.5 + X0 = 0.05 + ! + USTR= UST + ZZ0=Z0 + OMEGACC = MAX(SIG(NK),X0*GRAV/UST) + YC = OMEGACC*SQRT(ZZ0/GRAV) - TAUPX=TAUX-ABS(TTAUWSHELTER)*XSTRESS - TAUPY=TAUY-ABS(TTAUWSHELTER)*YSTRESS - USTP=(TAUPX**2+TAUPY**2)**0.25 - USDIRP=ATAN2(TAUPY,TAUPX) + ! DELY = MAX((1.-YC)/REAL(JTOT),0.) + ! Changed integration variable from Y to LOG(Y) and to log(K) + !ZINF = LOG(YC) + !DELY = MAX((1.-ZINF)/REAL(JTOT),0.) + ZINF = LOG(SIG(NK)**2/GRAV) + DELY = (LOG(TPI/0.005)-ZINF)/REAL(JTOT) - UST=USTP - ! finds the values in the tabulated stress TAUHFT - XI=UST/DELUST - IND = MAX(1,MIN (IUSTAR-1, INT(XI))) - DELI1= MAX(MIN (1. ,XI-FLOAT(IND)),0.) - DELI2= 1. - DELI1 - XJ=MAX(0.,(GRAV*Z0/MAX(UST,0.00001)**2-AALPHA) / DELALP) - J = MAX(1 ,MIN (IALPHA-1, INT(XJ))) - DELJ1= MAX(0.,MIN (1. , XJ-FLOAT(J))) - DELJ2=1. - DELJ1 - IF (TTAUWSHELTER.GT.0) THEN - XK = CONST0*TEMP / DELTAIL - I = MIN (ILEVTAIL-1, INT(XK)) - DELK1= MIN (1. ,XK-FLOAT(I)) - DELK2=1. - DELK1 - TAU1 =((TAUHFT2(IND,J,I)*DELI2+TAUHFT2(IND+1,J,I)*DELI1 )*DELJ2 & - +(TAUHFT2(IND,J+1,I)*DELI2+TAUHFT2(IND+1,J+1,I)*DELI1)*DELJ1)*DELK2 & - +((TAUHFT2(IND,J,I+1)*DELI2+TAUHFT2(IND+1,J,I+1)*DELI1 )*DELJ2 & - +(TAUHFT2(IND,J+1,I+1)*DELI2+TAUHFT2(IND+1,J+1,I+1)*DELI1)*DELJ1)*DELK1 + TAUR=UST**2 + TAU1=0. + + ! Integration loop over the tail wavenumbers or frequencies ... + DO J=1,JTOT + !Y = YC+REAL(J-1)*DELY + !OMEGA = Y*SQRT(GRAV/ZZ0) + !OMEGA = SQRT(GRAV*Y) + ! This is the deep water phase speed... No surface tension !! + !CM = GRAV/OMEGA + ! With this form, Y is the wavenumber in the tail; + Y= EXP(ZINF+REAL(J-1)*DELY) + TENSK =1+(Y/KM)**2 + OMEGA = SQRT(GRAV*Y*TENSK) + CM = SQRT(GRAV*TENSK/Y) + CGTAIL = 0.5*(3*(Y/KM)**2+1)*SQRT(GRAV/(Y*TENSK)) + !this is the inverse wave age, shifted by ZZALP (tuning) + ZX = USTR/CM +ZZALP + ZARG = MIN(KAPPA/ZX,20.) + ! ZMU corresponds to EXP(ZCN) + ZMU = MIN(GRAV*ZZ0/CM**2*EXP(ZARG),1.) + ZLOG = MIN(ALOG(ZMU),0.) + ZBETA = CONST1*ZMU*ZLOG**4 + ! + ! Optional addition of capillary wave peak if SINTAIL2=1 + ! + IF (SINTAILPAR(3).GT.0) THEN + IF (USTR.LT.CM) THEN + ALPHAM=MAX(0.,0.01*(1.+ALOG(USTR/CM))) + ELSE + ALPHAM=0.01*(1+3.*ALOG(USTR/CM)) + END IF + FM=EXP(-0.25*(Y/KM-1)**2) + + ALPHAT=ALPHAM*(CMM/CM)*FM ! equivalent to 2*Bh in Elfouhaily et al. + LEVTAIL=LEVTAIL0*0.5*(1-tanh((Y-20)/5))+SINTAILPAR(3)*0.5*(1+TANH((Y-20)/5))*ALPHAT + ELSE + LEVTAIL=LEVTAIL0 + END IF + ! WRITE(991,*) 'TAIL??',SINTAILPAR(3),LEVTAIL0,LEVTAIL,ALPHAT,Y,Y/KM,OMEGA/(TPI) + + !TAU1=TAU1+W(J)*ZBETA*(USTR/UST)**2/Y*DELY ! integration over LOG(Y) + TAU1=TAU1+W(J)*ZBETA*USTR**2*LEVTAIL*DELY*CGTAIL/CM ! integration over LOG(K) + + ! NB: the factor ABS(TTAUWSHELTER) was forgotten in the TAUHFT2 table + !TAUR=TAUR-W(J)*ABS(TTAUWSHELTER)*USTR**2*ZBETA*LEVTAIL/Y*DELY + !TAUR=TAUR-W(J)*USTR**2*ZBETA*LEVTAIL*DELY ! integration over LOG(Y) + TAUR=TAUR-W(J)*SINTAILPAR(2)*USTR**2*ZBETA*LEVTAIL*DELY*CGTAIL/CM ! DK/K*CG/C = D OMEGA / OMEGA + USTR=SQRT(MAX(TAUR,0.)) + END DO + DEALLOCATE(W) + TAU1NT=TAU1 + TAUHF = TAU1 + ! + ! In this case, uses tables for high frequency contribution to TAUW. + ! ELSE - TAU1 =(TAUHFT(IND,J)*DELI2+TAUHFT(IND+1,J)*DELI1 )*DELJ2 & - +(TAUHFT(IND,J+1)*DELI2+TAUHFT(IND+1,J+1)*DELI1)*DELJ1 - END IF - TAUHF = CONST0*TEMP*UST**2*TAU1 + ! finds the values in the tabulated stress TAUHFT + XI=UST/DELUST + IND = MAX(1,MIN (IUSTAR-1, INT(XI))) + DELI1= MAX(MIN (1. ,XI-FLOAT(IND)),0.) + DELI2= 1. - DELI1 + XJ=MAX(0.,(GRAV*Z0/MAX(UST,0.00001)**2-AALPHA) / DELALP) + J = MAX(1 ,MIN (IALPHA-1, INT(XJ))) + DELJ1= MAX(0.,MIN (1. , XJ-FLOAT(J))) + DELJ2=1. - DELJ1 + IF (TTAUWSHELTER.GT.0) THEN + XK = LEVTAIL0/ DELTAIL + I = MIN (ILEVTAIL-1, INT(XK)) + DELK1= MIN (1. ,XK-FLOAT(I)) + DELK2=1. - DELK1 + TAU1 =((TAUHFT2(IND,J,I)*DELI2+TAUHFT2(IND+1,J,I)*DELI1 )*DELJ2 & + +(TAUHFT2(IND,J+1,I)*DELI2+TAUHFT2(IND+1,J+1,I)*DELI1)*DELJ1)*DELK2 & + +((TAUHFT2(IND,J,I+1)*DELI2+TAUHFT2(IND+1,J,I+1)*DELI1 )*DELJ2 & + +(TAUHFT2(IND,J+1,I+1)*DELI2+TAUHFT2(IND+1,J+1,I+1)*DELI1)*DELJ1)*DELK1 + ELSE + TAU1 =(TAUHFT(IND,J)*DELI2+TAUHFT(IND+1,J)*DELI1 )*DELJ2 & + +(TAUHFT(IND,J+1)*DELI2+TAUHFT(IND+1,J+1)*DELI1)*DELJ1 + END IF + ! + TAUHF = LEVTAIL0*UST**2*TAU1 + END IF ! End of test on use of table + TAUWX = XSTRESS+TAUHF*COS(USDIRP) TAUWY = YSTRESS+TAUHF*SIN(USDIRP) ! @@ -975,7 +1071,8 @@ SUBROUTINE INSIN4(FLTABS) SSDSDTH, SSDSCOS, TH, DTH, XFR, ECOS, ESIN, & SSDSC, SSDSBRF1, SSDSBCK, SSDSBINT, SSDSPBK, & SSDSABK, SSDSHCK, IKTAB, DCKI, SATINDICES, & - SATWEIGHTS, CUMULW, NKHS, NKD, NDTAB, QBI + SATWEIGHTS, CUMULW, NKHS, NKD, NDTAB, QBI, & + SINTAILPAR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -1016,11 +1113,16 @@ SUBROUTINE INSIN4(FLTABS) ! ! These precomputed tables are written in mod_def.ww3 ! - IF (FLTABS) THEN - CALL TABU_STRESS - CALL TABU_TAUHF(SIG(NK) ) !tabulate high-frequency stress: 2D table + IF (SINTAILPAR(1).GT.0.5) THEN + IF (.NOT. ALLOCATED(TAUT)) ALLOCATE(TAUT(0:ITAUMAX,0:JUMAX)) + IF (.NOT. ALLOCATED(TAUHFT)) ALLOCATE(TAUHFT(0:IUSTAR,0:IALPHA)) + IF (FLTABS) THEN + CALL TABU_STRESS + CALL TABU_TAUHF(SIG(NK) ) !tabulate high-frequency stress: 2D table + END IF IF (TTAUWSHELTER.GT.0) THEN - CALL TABU_TAUHF2(SIG(NK) ) !tabulate high-frequency stress: 3D table + IF (.NOT. ALLOCATED(TAUHFT2)) ALLOCATE(TAUHFT2(0:IUSTAR,0:IALPHA,0:ILEVTAIL)) + IF (FLTABS) CALL TABU_TAUHF2(SIG(NK) ) !tabulate high-frequency stress: 3D table END IF END IF ! @@ -1146,7 +1248,7 @@ SUBROUTINE INSIN4(FLTABS) ! Precomputes the weights for the cumulative effect (TEST 441 and 500) ! DIKCUMUL = 0 - IF (SSDSC(3).NE.0) THEN + IF (SSDSC(3).LT.0.) THEN ! DIKCUMUL is the integer difference in frequency bands ! between the "large breakers" and short "wiped-out waves" DIKCUMUL = NINT(SSDSBRF1/(XFR-1.)) @@ -1264,7 +1366,7 @@ SUBROUTINE TABU_STRESS ! ---------------------------------------------------------------------- INTEGER I,J,ITER REAL ZTAUW,UTOP,CDRAG,WCD,USTOLD,TAUOLD - REAL X,UST,ZZ0,ZNU,F,DELF,ZZ00 + REAL X,UST,ZZ0,F,DELF,ZZ00 ! ! DELU = UMAX/FLOAT(JUMAX) @@ -1755,6 +1857,7 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) ! 2. Method : ! ! Computation of u* based on Quasi-linear theory + ! uses Charnock relation with modified roughness Z1=Z0/SQRT(1-TAUW/TAU) ! ! 3. Parameters : ! @@ -1791,8 +1894,8 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) ! ! 10. Source code : !-----------------------------------------------------------------------------! - USE CONSTANTS, ONLY: GRAV, KAPPA - USE W3GDATMD, ONLY: ZZWND, AALPHA + USE CONSTANTS, ONLY: GRAV, KAPPA, NU_AIR + USE W3GDATMD, ONLY: ZZWND, AALPHA, ZZ0MAX, SINTAILPAR #ifdef W3_T USE W3ODATMD, ONLY: NDST #endif @@ -1800,22 +1903,60 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) REAL, intent(in) :: WINDSPEED,TAUW REAL, intent(out) :: USTAR, Z0, CHARN ! local variables - REAL SQRTCDM1 - REAL XI,DELI1,DELI2,XJ,delj1,delj2 - REAL TAUW_LOCAL - INTEGER IND,J - ! - TAUW_LOCAL=MAX(MIN(TAUW,TAUWMAX),0.) - XI = SQRT(TAUW_LOCAL)/DELTAUW - IND = MIN ( ITAUMAX-1, INT(XI)) ! index for stress table - DELI1 = MIN(1.,XI - REAL(IND)) !interpolation coefficient for stress table - DELI2 = 1. - DELI1 - XJ = WINDSPEED/DELU - J = MIN ( JUMAX-1, INT(XJ) ) - DELJ1 = MIN(1.,XJ - REAL(J)) - DELJ2 = 1. - DELJ1 - USTAR=(TAUT(IND,J)*DELI2+TAUT(IND+1,J )*DELI1)*DELJ2 & - + (TAUT(IND,J+1)*DELI2+TAUT(IND+1,J+1)*DELI1)*DELJ1 + REAL :: SQRTCDM1 + REAL :: XI,DELI1,DELI2,XJ,delj1,delj2 ! used for table version + INTEGER :: IND,J + REAL :: TAUW_LOCAL + REAL :: TAUOLD,CDRAG,WCD,USTOLD,X,UST,ZZ0,ZNU,ZZ00,F,DELF + INTEGER, PARAMETER :: NITER=10 + REAL , PARAMETER :: XM=0.50, EPS1=0.00001 + INTEGER :: ITER + ! 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. + + ! + IF (SINTAILPAR(1).GT.0.5) THEN + TAUW_LOCAL=MAX(MIN(TAUW,TAUWMAX),0.) + XI = SQRT(TAUW_LOCAL)/DELTAUW + IND = MIN ( ITAUMAX-1, INT(XI)) ! index for stress table + DELI1 = MIN(1.,XI - REAL(IND)) !interpolation coefficient for stress table + DELI2 = 1. - DELI1 + XJ = WINDSPEED/DELU + J = MIN ( JUMAX-1, INT(XJ) ) + DELJ1 = MIN(1.,XJ - REAL(J)) + DELJ2 = 1. - DELJ1 + USTAR=(TAUT(IND,J)*DELI2+TAUT(IND+1,J )*DELI1)*DELJ2 & + + (TAUT(IND,J+1)*DELI2+TAUT(IND+1,J+1)*DELI1)*DELJ1 + ELSE + ! This max is for comparison ... to be removed later + ! TAUW_LOCAL=MAX(MIN(TAUW,TAUWMAX),0.) + TAUW_LOCAL=TAUW + CDRAG = 0.0012875 + WCD = SQRT(CDRAG) + USTOLD = WINDSPEED*WCD + TAUOLD = MAX(USTOLD**2, TAUW_LOCAL+EPS1) + ! Newton method to solve for ustar in U=ustar*log(Z/Z0) + DO ITER=1,NITER + X = TAUW_LOCAL/TAUOLD + UST = SQRT(TAUOLD) + ZZ00=AALPHA*TAUOLD/GRAV + IF (ZZ0MAX.NE.0) ZZ00=MIN(ZZ00,ZZ0MAX) + ! Corrects roughness ZZ00 for quasi-linear effect + ZZ0 = ZZ00/(1.-X)**XM + ZNU = 0.11*nu_air/MAX(UST,1E-6) + ZZ0 = SINTAILPAR(5)*ZNU+ZZ0 + F = UST-KAPPA*WINDSPEED/(ALOG(ZZWND/ZZ0)) + DELF= 1.-KAPPA*WINDSPEED/(ALOG(ZZWND/ZZ0))**2*2./UST & + *(1.-(XM+1)*X)/(1.-X) + UST = UST-F/DELF + TAUOLD= MAX(UST**2., TAUW_LOCAL+EPS1) + END DO + USTAR=UST + END IF ! ! Determines roughness length ! @@ -1832,6 +1973,7 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) END IF CHARN = AALPHA END IF + ! WRITE(6,*) 'CALC_USTAR:',WINDSPEED,TAUW,AALPHA,CHARN,Z0,USTAR ! RETURN END SUBROUTINE CALC_USTAR @@ -1882,10 +2024,11 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & !/ 06-Jun-2018 : Add optional DEBUGSRC ( version 6.04 ) !/ 22-Feb-2020 : Option to use Romero (GRL 2019) ( version 7.06 ) !/ 13-Aug-2021 : Consider DAIR a variable ( version 7.14 ) + !/ 01-Mar-2023 : Clean up of SDS4 ( version 7.xx ) !/ ! 1. Purpose : ! - ! Calculate whitecapping source term and diagonal term of derivative. + ! Calculate wave dissipation source term and diagonal term of derivative. ! ! 2. Method : ! @@ -1949,7 +2092,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & SSDSISO, SSDSDTH, SSDSBM, AAIRCMIN, & SSDSBRFDF, SSDSBCK, IKTAB, DCKI, & SATINDICES, SATWEIGHTS, CUMULW, NKHS, NKD, & - NDTAB, QBI + NDTAB, QBI, DSIP, SSDSBRF1,XFR #ifdef W3_IG1 USE W3GDATMD, ONLY: IGPARS #endif @@ -1989,7 +2132,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & INTEGER :: IK, IK1, ITH, IK2, JTH, ITH2, & IKHS, IKD, SDSNTH, IT, IKM, NKM INTEGER :: NSMOOTH(NK) - REAL :: C, COSWIND, ASUM, SDIAGISO + REAL :: C, C2, CUMULWISO, COSWIND, ASUM, SDIAGISO REAL :: COEF1, COEF2, COEF4(NK), & COEF5(NK) @@ -2004,19 +2147,15 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & REAL :: FACSAT, DKHS, FACSTRAINB, FACSTRAINL REAL :: BTH0(NK) !saturation spectrum REAL :: BTH(NSPEC) !saturation spectrum - REAL :: BTH0S(NK) !smoothed saturation spectrum - REAL :: BTHS(NSPEC) !smoothed saturation spectrum - INTEGER :: IMSSMAX(NK), NTHSUM - REAL :: MSSSUM(NK,5), WTHSUM(NTH), FACHF - REAL :: MSSSUM2(NK,NTH) - REAL :: MSSLONG(NK,NTH) + REAL :: MSSSUM(NK,5), FACHF + REAL :: MSSLONG REAL :: MSSPCS, MSSPC2, MSSPS2, MSSP, MSSD, MSSTH REAL :: MICHE, X, KLOC #ifdef W3_T0 REAL :: DOUT(NK,NTH) #endif REAL :: QB(NK), S2(NK) - REAL :: TSTR, TMAX, DT, T, MFT + REAL :: TSTR, TMAX, DT, T, MFT, DIRFORCUM REAL :: PB(NSPEC), PB2(NSPEC), BRM12(NK), BTOVER REAL :: KO, LMODULATION(NTH) !/ @@ -2034,10 +2173,10 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! found in certain compilers NSMOOTH=0 S1=0.; E1=0. - NTIMES=0;IKSUP=0;IMSSMAX=0 + NTIMES=0;IKSUP=0 DK=0.; HS=0.; KBAR=0.; DCK=0.; EFDF=0. - BTH0=0.; BTH=0.; BTH0S=0.; DDIAG=0.; SRHS=0.; PB=0. - BTHS=0.; MSSSUM(:,:)=0. + BTH0=0.; BTH=0.; DDIAG=0.; SRHS=0.; PB=0. + MSSSUM(:,:)=0. #ifdef W3_T0 DOUT=0. #endif @@ -2047,50 +2186,33 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! 1. Initialization and numerical factors ! FACTURB=SSDSC(5)*USTAR**2/GRAV*DAIR/DWAT + DIKCUMUL = NINT(SSDSBRF1/(XFR-1.)) BREAKFRACTION=0. RENEWALFREQ=0. IK1=1 #ifdef W3_IG1 IK1=NINT(IGPARS(5))+1 #endif - NTHSUM=MIN(FLOOR(SSDSC(10)+0.5),NTH-1) ! number of angular bins for enhanced modulation - IF (NTHSUM.GT.0) THEN - WTHSUM(1:NTHSUM)=1 - WTHSUM(NTHSUM+1)=SSDSC(10)+0.5-NTHSUM - ELSE - WTHSUM(1)=2*SSDSC(10) - END IF ! - ! 1.b MSS parameters used for Modulation factors for B or lambda + ! 1.b MSS parameters used for Modulation factors for lambda (Romero ) ! IF (SSDSC(8).GT.0.OR.SSDSC(11).GT.0.OR.SSDSC(18).GT.0) THEN - MSSSUM2(:,:)=0. DO IK=1,NK - IMSSMAX (IK) = 1 MSSP = 0. MSSPC2 = 0. MSSPS2 = 0. MSSPCS = 0. ! - ! Sums the contributions to the directional MSS for all ITH + ! Sums the contributions to the directional MSS for all angles ! DO ITH=1,NTH IS=ITH+(IK-1)*NTH - MSSLONG(IK,ITH) = K(IK)**SSDSC(20) * A(IS) * DDEN(IK) / CG(IK) ! contribution to MSS - END DO - DO ITH=1,NTH - DO JTH=-NTHSUM,NTHSUM - ITH2 = 1+MOD(ITH-1+JTH+NTH,NTH) - MSSSUM2(IK,ITH) = MSSSUM2(IK,ITH)+MSSLONG(IK,ITH2)*WTHSUM(ABS(JTH)+1) - END DO - MSSPC2 = MSSPC2 +MSSLONG(IK,ITH)*EC2(ITH) - MSSPS2 = MSSPS2 +MSSLONG(IK,ITH)*ES2(ITH) - MSSPCS = MSSPCS +MSSLONG(IK,ITH)*ESC(ITH) - MSSP = MSSP +MSSLONG(IK,ITH) + MSSLONG = K(IK)**SSDSC(20) * A(IS) * DDEN(IK) / CG(IK) ! contribution to MSS + MSSPC2 = MSSPC2 +MSSLONG*EC2(ITH) + MSSPS2 = MSSPS2 +MSSLONG*ES2(ITH) + MSSPCS = MSSPCS +MSSLONG*ESC(ITH) + MSSP = MSSP +MSSLONG END DO - ! - ! Now sums over IK - ! MSSSUM (IK:NK,1) = MSSSUM (IK:NK,1) +MSSP MSSSUM (IK:NK,3) = MSSSUM (IK:NK,3) +MSSPC2 MSSSUM (IK:NK,4) = MSSSUM (IK:NK,4) +MSSPS2 @@ -2100,18 +2222,13 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! MSSD=0.5*(ATAN2(2*MSSSUM(IK,5),MSSSUM(IK,3)-MSSSUM(IK,4))) IF (MSSD.LT.0) MSSD = MSSD + PI - IMSSMAX (IK)=1+NINT(MSSD *NTH/TPI) - ! - ! mss along perpendicular direction - ! - MSSSUM (IK,2) = MAX(0.,MSSSUM(IK,4)*COS(MSSD)**2 & - -2*MSSSUM(IK,5)*SIN(MSSD)*COS(MSSD)+ & - MSSSUM(IK,3)*SIN(MSSD)**2 ) + MSSSUM (IK,2) = MSSD END DO END IF ! SSDSC(8).GT.0) THEN ! ! 2. Estimation of spontaneous breaking from local saturation ! + !############################################################################################" SELECT CASE (NINT(SSDSC(1))) CASE (1) ! @@ -2121,10 +2238,6 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! ! 2.a.1 Computes saturation ! - SDSNTH = MIN(NINT(SSDSDTH/(DTH*RADE)),NTH/2-1) - ! SSDSDIK is the integer difference in frequency bands - ! between the "large breakers" and short "wiped-out waves" - ! BTH(:) = 0. DO IK=IK1, NK @@ -2134,99 +2247,20 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & BTH(IS0+1)=0. ASUM = SUM(A(IS0+1:IS0+NTH)) BTH0(IK)=ASUM*FACSAT - IKC = MAX(1,IK-DIKCUMUL) - KLOC=K(IK)**(2-SSDSC(20)) ! local wavenumber factor, if mss not used. - + ! IF (SSDSDTH.GE.180) THEN ! integrates around full circle BTH(IS0+1:IS0+NTH)=BTH0(IK) ELSE DO ITH=1,NTH ! partial integration IS=ITH+(IK-1)*NTH - - ! straining effect of long waves on short waves - ! extended from Longuet-Higgins and Stewart (JFM 1960, eq. 2.27) the amplitude modulation - ! in deep water is equal to the long wave slope k*a cos(theta1-theta2) - ! Here we assume that the saturation is modulated as (1 + SSDSC(8) * sqrt(mss) ) - ! where mss_theta is the mss in direction ITH. - ! - ! Note: SSDSC(8) is sqrt(2)*times the mss MTF: equal to 4*sqrt(2) according to Longuet-Higgins and Stewart - ! - IF (SSDSC(8).GT.0.OR.SSDSC(11).GT.0) THEN - ! - MSSTH=(MSSSUM(IKC,1)-MSSSUM(IKC,2))*EC2(1+ABS(ITH-IMSSMAX (IKC))) & - +MSSSUM(IKC,2)*ES2(1+ABS(ITH-IMSSMAX (IKC)))*KLOC - ! - FACSTRAINB=1+SSDSC(8)*SQRT(MSSTH)+SSDSC(11)*SQRT(MSSSUM2(IKC,ITH)*KLOC) - ELSE - FACSTRAINB=1 - END IF - ! BTH(IS)=DOT_PRODUCT(SATWEIGHTS(:,ITH), A(IS0+SATINDICES(:,ITH)) ) & - *FACSAT*FACSTRAINB + *FACSAT END DO - IF (SSDSISO.NE.1) THEN - BTH0(IK)=MAXVAL(BTH(IS0+1:IS0+NTH)) - END IF + BTH0(IK)=MAXVAL(BTH(IS0+1:IS0+NTH)) END IF ! - END DO !NK END - ! - ! Optional smoothing of B and B0 over frequencies - ! - IF (SSDSBRFDF.GT.0.AND.SSDSBRFDF.LT.NK/2) THEN - BTH0S(:)=BTH0(:) - BTHS(:)=BTH(:) - NSMOOTH(:)=1 - DO IK=1, SSDSBRFDF - BTH0S(1+SSDSBRFDF)=BTH0S(1+SSDSBRFDF)+BTH0(IK) - NSMOOTH(1+SSDSBRFDF)=NSMOOTH(1+SSDSBRFDF)+1 - DO ITH=1,NTH - IS=ITH+(IK-1)*NTH - BTHS(ITH+SSDSBRFDF*NTH)=BTHS(ITH+SSDSBRFDF*NTH)+BTH(IS) - END DO - END DO - DO IK=IK1+1+SSDSBRFDF,1+2*SSDSBRFDF - BTH0S(1+SSDSBRFDF)=BTH0S(1+SSDSBRFDF)+BTH0(IK) - NSMOOTH(1+SSDSBRFDF)=NSMOOTH(1+SSDSBRFDF)+1 - DO ITH=1,NTH - IS=ITH+(IK-1)*NTH - BTHS(ITH+SSDSBRFDF*NTH)=BTHS(ITH+SSDSBRFDF*NTH)+BTH(IS) - END DO - END DO - DO IK=SSDSBRFDF,IK1,-1 - BTH0S(IK)=BTH0S(IK+1)-BTH0(IK+SSDSBRFDF+1) - NSMOOTH(IK)=NSMOOTH(IK+1)-1 - DO ITH=1,NTH - IS=ITH+(IK-1)*NTH - BTHS(IS)=BTHS(IS+NTH)-BTH(IS+(SSDSBRFDF+1)*NTH) - END DO - END DO - ! - DO IK=IK1+1+SSDSBRFDF,NK-SSDSBRFDF - BTH0S(IK)=BTH0S(IK-1)-BTH0(IK-SSDSBRFDF-1)+BTH0(IK+SSDSBRFDF) - NSMOOTH(IK)=NSMOOTH(IK-1) - DO ITH=1,NTH - IS=ITH+(IK-1)*NTH - BTHS(IS)=BTHS(IS-NTH)-BTH(IS-(SSDSBRFDF+1)*NTH)+BTH(IS+(SSDSBRFDF)*NTH) - END DO - END DO - ! - DO IK=NK-SSDSBRFDF+1,NK - BTH0S(IK)=BTH0S(IK-1)-BTH0(IK-SSDSBRFDF) - NSMOOTH(IK)=NSMOOTH(IK-1)-1 - DO ITH=1,NTH - IS=ITH+(IK-1)*NTH - BTHS(IS)=BTHS(IS-NTH)-BTH(IS-(SSDSBRFDF+1)*NTH) - END DO - END DO - ! division by NSMOOTH - BTH0(:)=MAX(0.,BTH0S(:)/NSMOOTH(:)) - DO IK=IK1,NK - IS0=(IK-1)*NTH - BTH(IS0+1:IS0+NTH)=MAX(0.,BTHS(IS0+1:IS0+NTH)/NSMOOTH(IK)) - END DO - END IF ! end of optional smoothing + END DO !IK=NK ! ! 2.a.2 Computes spontaneous breaking dissipation rate ! @@ -2238,7 +2272,8 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & MICHE=1. ELSE X=TANH(MIN(K(IK)*DEPTH,10.)) - MICHE=(X*(SSDSBM(1)+X*(SSDSBM(2)+X*(SSDSBM(3)+X*SSDSBM(4)))))**2 ! Correction of saturation level for shallow-water kinematics + ! Correction of saturation threshold for shallow-water kinematics + MICHE=(X*(SSDSBM(1)+X*(SSDSBM(2)+X*(SSDSBM(3)+X*SSDSBM(4)))))**2 END IF COEF1=(SSDSBR*MICHE) ! @@ -2268,7 +2303,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & BRLAMBDA = PB / (2.*PI**2.) SRHS = DDIAG * A - ! + !############################################################################################" CASE(2) ! ! 2.b Computes spontaneous breaking for T500 (Filipot et al. JGR 2010) @@ -2412,7 +2447,8 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! Compute Lambda = PB* l(k,th) ! with l(k,th)=1/(2*pi²)= the breaking crest density BRLAMBDA = PB / (2.*PI**2.) - ! + SRHS = DDIAG * A + !############################################################################################" CASE(3) ! ! 2c Romero (GRL 2019) @@ -2425,27 +2461,15 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & KLOC=K(IK)**(2-SSDSC(20)) ! local wavenumber factor, if mss not used. BTH(1:NTH)=MAX(A(IS0+1:IS0+NTH)*SIG(IK)*K(IK)**3,.00000000000001) ! - IF (SSDSC(8).GT.0) THEN ! Applies modulation factor on B - DO ITH=1,NTH - MSSTH=(MSSSUM(IK,1)-MSSSUM(IK,2))*EC2(1+ABS(ITH-IMSSMAX (IK))) & - +MSSSUM(IK,2)*ES2(1+ABS(ITH-IMSSMAX (IK)))*KLOC - FACSTRAINB=(1.+SSDSC(8)*SQRT(MSSTH)+SSDSC(11)*SQRT(MSSSUM2(IK,ITH))*KLOC) - BTH(ITH)=BTH(ITH)*FACSTRAINB - END DO - END IF - ! + DIRFORCUM=DLWMEAN + IF (SSDSC(11).GT.0) DIRFORCUM=MSSSUM(IK,2) + C=SIG(IK)/K(IK) BTH0(IK)=sum(BTH(1:NTH)*DTH) IF (SSDSC(18).GT.0) THEN ! Applies modulation factor on Lambda DO ITH=1,NTH - IF (SSDSC(11).GT.0) THEN - MSSTH=(MSSSUM(IK,1)-MSSSUM(IK,2))*EC2(1+ABS(ITH-IMSSMAX (IK))) & - +MSSSUM(IK,2)*ES2(1+ABS(ITH-IMSSMAX (IK)))*KLOC - FACSTRAINL=1.+SSDSC(18)*SQRT(MSSTH)+SSDSC(11)*SQRT(MSSSUM2(IK,ITH)*KLOC) - ELSE - FACSTRAINL=1.+SSDSC(18)*((MSSSUM(IK,1)*KLOC)**SSDSC(14) * & ! Romero - (ECOS(ITH)*COS(DLWMEAN)+ESIN(ITH)*SIN(DLWMEAN))**2) - ENDIF + FACSTRAINL=1.+SSDSC(18)*((MSSSUM(IK,1)*KLOC)**SSDSC(14) * & ! Romero + (ECOS(ITH)*COS(DIRFORCUM)+ESIN(ITH)*SIN(DIRFORCUM))**2) LMODULATION(ITH)= FACSTRAINL**SSDSC(19) END DO ELSE @@ -2470,7 +2494,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & PB = BRLAMBDA *C ! END SELECT - ! + !############################################################################################" ! ! !/ ------------------------------------------------------------------- / @@ -2482,16 +2506,29 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! IF ( (SSDSC(3).NE.0.) .OR. (SSDSC(5).NE.0.) .OR. (SSDSC(21).NE.0.) ) THEN DO IK=IK1, NK + RENEWALFREQ = 0. FACTURB2=-2.*SIG(IK)*K(IK)*FACTURB DVISC=-4.*SSDSC(21)*K(IK)*K(IK) + C = SIG(IK)/K(IK) ! phase speed ! + IF (SSDSC(3).GT.0 .AND. IK.GT.DIKCUMUL) THEN + ! this is the cheap isotropic version + DO IK2=IK1,IK-DIKCUMUL + C2 = SIG(IK2)/K(IK2) + IS2=(IK2-1)*NTH + CUMULWISO=ABS(C2-C)*DSIP(IK2)/(0.5*C2) * DTH + RENEWALFREQ=RENEWALFREQ-CUMULWISO*SUM(BRLAMBDA(IS2+1:IS2+NTH)) + END DO + END IF + DO ITH=1,NTH IS=ITH+(IK-1)*NTH ! ! Computes cumulative effect from Breaking probability ! - RENEWALFREQ = 0. - IF (SSDSC(3).NE.0 .AND. IK.GT.DIKCUMUL) THEN + IF (SSDSC(3).LT.0 .AND. IK.GT.DIKCUMUL) THEN + RENEWALFREQ = 0. + ! this is the expensive and largely useless version DO IK2=IK1,IK-DIKCUMUL IF (BTH0(IK2).GT.SSDSBR) THEN IS2=(IK2-1)*NTH diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index a846605d8f..e90ba88ebe 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -555,7 +555,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_ST4 USE W3SRC4MD, ONLY : W3SPR4, W3SIN4, W3SDS4 - USE W3GDATMD, ONLY : ZZWND, FFXFM, FFXPM, FFXFA + USE W3GDATMD, ONLY : ZZWND, FFXFM, FFXPM, FFXFA, SINTAILPAR #endif #ifdef W3_ST6 USE W3SRC6MD @@ -1034,10 +1034,14 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & TWS = 1./FMEANWS #endif #ifdef W3_ST4 - TAUWX=0. - TAUWY=0. - IF ( IT .eq. 0 ) THEN + IF (SINTAILPAR(4).GT.0.5) THEN ! this is designed to keep the bug as an option + TAUWX=0. + TAUWY=0. + END IF + IF ( IT .EQ. 0 ) THEN LLWS(:) = .TRUE. + TAUWX=0. + TAUWY=0. USTAR=0. USTDIR=0. ELSE @@ -1061,7 +1065,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_ST4 - CALL W3SIN4 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & + IF (SINTAILPAR(4).GT.0.5) CALL W3SIN4 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & U10DIR, Z0, CD, TAUWX, TAUWY, TAUWAX, TAUWAY, & VSIN, VDIN, LLWS, IX, IY, BRLAMBDA ) END IF @@ -1907,6 +1911,13 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & CALL W3SIN4 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & U10DIR, Z0, CD, TAUWX, TAUWY, TAUWAX, TAUWAY, & VSIN, VDIN, LLWS, IX, IY, BRLAMBDA ) + IF (SINTAILPAR(4).LT.0.5) CALL W3SPR4 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEAN1, WNMEAN,& + AMAX, U10ABS, U10DIR, & +#ifdef W3_FLX5 + TAUA, TAUADIR, DAIR, & +#endif + USTAR, USTDIR, & + TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) #endif ! diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index 499e0371fb..c35ff6e98e 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -2158,7 +2158,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) RHOAIR, USTAR, USTD, Z0, CD, CHARN ) #endif ! - DO ITT=1, 3 + DO ITT=1, 4 #ifdef W3_ST2 CALL W3SIN2 (A, CG, WN2, UABS, UDIRR, CD, Z0, & FPI, XIN, DIA ) diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 3d1d84f16d..3fcf651d6a 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -906,12 +906,16 @@ echo "$rtst -s ST2 -w work_ST2 $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST3 -w work_ST3 $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST4 -w work_ST4 $ww3 ww3_ts1" >> matrix.body + echo "$rtst -s ST4 -w work_ST4_T500 -g ST4_T500 -N $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST4 -w work_ST4_T700 -g ST4_T700 -N $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST4_WRT -w work_ST4_WRT $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST4_GMD -w work_ST4_GMD $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST4_TSA -w work_ST4_TSA $ww3 ww3_ts1" >> matrix.body echo "$rtst -s ST6 -w work_ST6 $ww3 ww3_ts1" >> matrix.body echo "$rtst -w work_NL5 -i input_nl5_matrix $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g Romero -w work_Romero -i input_10ms -N $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g ST4_T701 -w work_T701 -i input_10ms -N $ww3 ww3_ts1" >> matrix.body + echo "$rtst -g ST4_T702 -w work_T702 -i input_10ms -N $ww3 ww3_ts1" >> matrix.body echo "$rtst -g ST4_T707 -w work_T707GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body echo "$rtst -g ST4_T713 -w work_T713GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body fi diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index 86248bb4ed..844f3e23e8 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -109,7 +109,7 @@ EOF # --------------------------------------------------------------------------- # echo ' ' -echo " Running now options: run_test $*" +echo " Running now options: run_cmake_test $*" echo ' ' # 2.a Setup array of command-line arguments @@ -377,7 +377,7 @@ fi if [ $time_count ] then # Add time counter if -T - echo " REGTESTS Time counter: run_test $ARGS" >> time_count.txt + echo " REGTESTS Time counter: run_cmake_test $ARGS" >> time_count.txt Tstart=`date +"%s.%2N"` fi diff --git a/regtests/ww3_ts1/input/namelists_ST4_T500.nml b/regtests/ww3_ts1/input/namelists_ST4_T500.nml new file mode 100644 index 0000000000..317705f938 --- /dev/null +++ b/regtests/ww3_ts1/input/namelists_ST4_T500.nml @@ -0,0 +1,3 @@ + &SDS4 SDSBCHOICE=2, SDSC2 = 0.0, SDSBR = 0.005, + FXFM3 = 9., SDSBCK = 0.185, SDSHCK = 1.5/ +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input/namelists_ST4_T707.nml b/regtests/ww3_ts1/input/namelists_ST4_T707.nml index 16f81517d2..b1d0a9727d 100644 --- a/regtests/ww3_ts1/input/namelists_ST4_T707.nml +++ b/regtests/ww3_ts1/input/namelists_ST4_T707.nml @@ -2,7 +2,7 @@ TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., GQAMP2=0.0022, GQAMP3=1., GQAMP4=1.0 / &SIN4 BETAMAX = 1.6, TAUWSHELTER = 0.0 / - &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, + &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, CUMSIGP =2.0, FXFM3 = 20, SDSFACMTF = 400., SDSMWD = 2., SDSCUM = 0.35, SDSNUW =0, SDSC5=1., SDSBRF1=0.5 / &SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / diff --git a/regtests/ww3_ts1/input/ww3_grid_ST4_T500.nml b/regtests/ww3_ts1/input/ww3_grid_ST4_T500.nml new file mode 100644 index 0000000000..bef18d975a --- /dev/null +++ b/regtests/ww3_ts1/input/ww3_grid_ST4_T500.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input/namelists_ST4_T500.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/namelists_Romero.nml b/regtests/ww3_ts1/input_10ms/namelists_Romero.nml new file mode 100644 index 0000000000..919c786d95 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_Romero.nml @@ -0,0 +1,20 @@ +&SIN4 BETAMAX = 1.43, SWELLF = 0.66, TAUWSHELTER = 0.3, Z0MAX = 0.0008, + SWELLF3 = 0.022, SWELLF4 = 150000.0, SWELLF7 = 360000.00, ZALP = 0.006 / +&SDS4 SDSBCHOICE = 3, SDSC2 = -3.80, FXFM3 = 20.00, WNMEANP = 1.0 , + SDSSTRAINA = 0.00, SDSSTRAIN = 0.00, SDSSTRAIN2 = 0.00, + SDSBR = 0.005, SDSBT = 0.0011, SDSCUM = 0.300, SDSC5 = 1.0, + SDSMWD = 0.90, SDSFACMTF = 400 / +&SNL1 NLPROP = 25000000.0 / + +&OUTS P2SF = 1, E3D = 1, I1P2SF = 1, I2P2SF = 36 / +&PRO3 WDTHCG = 1.50, WDTHTH = 1.50 / +&REF1 REFCOAST = 0.1, REFCOSP_STRAIGHT = 4, REFFREQ = 0., REFICEBERG = 0.4, + REFMAP = 0., REFSLOPE = 0., REFSUBGRID = 0.2, REFRMAX = 0.5 / +&SIC2 IC2DISPER = F, IC2TURB = 0.5 , IC2ROUGH = 0.0001, + IC2REYNOLDS = 150000, IC2SMOOTH = 200000., IC2VISC = 1.0 / +&SIS2 ISC1 = 1., IS2C2 = 0.000000, IS2C3 = 0. , IS2BACKSCAT = 1. , + IS2BREAK = T, IS2DUPDATE = F , IS2CREEPB = 5E8 , IS2CREEPD = 0.3 / +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T471.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T471.nml new file mode 100644 index 0000000000..5ab7abb58d --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T471.nml @@ -0,0 +1,2 @@ +! T471 corresponds to the default parameter values for ST4. +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T475.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T475.nml new file mode 100644 index 0000000000..e104247aa6 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T475.nml @@ -0,0 +1,7 @@ +&SIN4 BETAMAX = 1.75, SWELLF = 0.66, TAUWSHELTER = 0.3, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 FXFM3 = 2.5 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / + +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T701.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T701.nml new file mode 100644 index 0000000000..b107fef73d --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T701.nml @@ -0,0 +1,20 @@ +&SIN4 BETAMAX = 1.7, SWELLF = 0.60, TAUWSHELTER = 0.3, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 SDSBCHOICE = 3, SDSC2 = -3.80, FXFM3 = 20.00, CUMSIGP = 2, + SDSBR = 0.005, SDSBT = 0.0011, SDSCUM = 0.300, SDSC5 = 1.0, + SDSMWD = 2.00, SDSFACMTF = 400 / +&SNL1 NLPROP = 25000000.0 / + +&OUTS P2SF = 1, E3D = 1, I1P2SF = 1, I2P2SF = 36 / +&PRO3 WDTHCG = 1.50, WDTHTH = 1.50 / +&REF1 REFCOAST = 0.1, REFCOSP_STRAIGHT = 4, REFFREQ = 0., REFICEBERG = 0.4, + REFMAP = 0., REFSLOPE = 0., REFSUBGRID = 0.2, REFRMAX = 0.5 / + +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08, + IS2CREEPD = 0.50 / + +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T702.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T702.nml new file mode 100644 index 0000000000..1b673567af --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T702.nml @@ -0,0 +1,14 @@ +&SIN4 BETAMAX = 1.7, SWELLF = 0.60, TAUWSHELTER = 0.2, + SWELLF3 = 0.022, SWELLF4 = 115000.0, SWELLF7 = 432000.00 / +&SDS4 SDSBCHOICE = 3, SDSC2 = -3.80, FXFM3 = 20.00, CUMSIGP = 2, + SDSSTRAINA = 0.00, SDSSTRAIN = 0.00, SDSSTRAIN2 = 0.00, + SDSBR = 0.005, SDSBT = 0.0011, SDSCUM = 0.300, SDSC5 = 1.0, + SDSMWD = 0.00, SDSFACMTF = 400 / +&SNL1 NLPROP = 25000000.0 / +&SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / +&SIS2 ISC1 =0.200E+00, IS2BREAK = T, IS2DUPDATE = F, IS2CREEPB = 0.200E+08 / +! DO NOT FORGET TO ADD FLAGTR = 4 for real life runs ... +&MISC ICEHINIT = 0.5, ICEHMIN = 0.1, CICE0 = 0.25, NOSW =6, + CICEN = 2.00, LICE = 40000., FACBERG = 0.2 , + WCOR1=21., WCOR2=0.5 / +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml index 0458cd7753..8d19dd444e 100644 --- a/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T707.nml @@ -2,7 +2,7 @@ TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., GQAMP2=0.0022, GQAMP3=1., GQAMP4=1.0 / &SIN4 BETAMAX = 1.6, TAUWSHELTER = 0.0 / - &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, + &SDS4 SDSBCHOICE=3, SDSC2 = -2.3, SDSBR = 0.005, CUMSIGP =2.0, FXFM3 = 20, SDSFACMTF = 400., SDSMWD = 2., SDSCUM = 0.35, SDSNUW =0, SDSC5=1., SDSBRF1=0.5 / &SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / diff --git a/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml b/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml index 8786044301..fa4a7eb784 100644 --- a/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml +++ b/regtests/ww3_ts1/input_10ms/namelists_ST4_T713.nml @@ -1,8 +1,9 @@ &SNL1 IQTYPE = -2, GQMNF1 = 11, GQMNT1 = 6, GQMNQ_OM2 = 6, TAILNL=-5.0, GQMTHRSAT=5E-5, GQMTHRCOU = 0.05, GQAMP1=1., GQAMP2=0.0022, GQAMP3=2. / -&SIN4 BETAMAX = 1.1, TAUWSHELTER = 0.0 / -&SDS4 SDSBCHOICE=3, SDSC2 = -2.5, SDSBR = 0.005, +&SIN4 BETAMAX = 1.1, TAUWSHELTER = 0.0, TAUWBUG = 0, + VISCSTRESS =1., SINTABLE=0 / +&SDS4 SDSBCHOICE=3, SDSC2 = -2.5, SDSBR = 0.005, CUMSIGP =2.0, SDSSTRAIN2 =1.,SDSCUMP=1., FXFM3 = 20, SDSFACMTF = 200., SDSMWD = 0.9, SDSCUM = 0.3, SDSNUW =0, SDSC5=0.5, SDSBRF1=0.5 / &SIC2 IC2ROUGH = 0.001000, IC2VISC = 2.000, IC2DMAX =0.300 / diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_Romero.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_Romero.nml new file mode 100644 index 0000000000..c510784c12 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_Romero.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 1s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_Romero.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T471.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T471.nml new file mode 100644 index 0000000000..80069e4a12 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T471.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 1s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T471.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T475.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T475.nml new file mode 100644 index 0000000000..7d41e0b7d6 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T475.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN ~= 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T475.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T701.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T701.nml new file mode 100644 index 0000000000..d7aca045cb --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T701.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 1s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T701.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T702.nml b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T702.nml new file mode 100644 index 0000000000..7669b24c65 --- /dev/null +++ b/regtests/ww3_ts1/input_10ms/ww3_grid_ST4_T702.nml @@ -0,0 +1,225 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! SPECTRUM%XFR = 0. ! frequency increment +! SPECTRUM%FREQ1 = 0. ! first frequency (Hz) +! SPECTRUM%NK = 0 ! number of frequencies (wavenumbers) +! SPECTRUM%NTH = 0 ! number of direction bins +! SPECTRUM%THOFF = 0. ! relative offset of first direction [-0.5,0.5] +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.034 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 36 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! +! * namelist must be terminated with / +! * definitions & defaults: +! RUN%FLDRY = F ! dry run (I/O only, no calculation) +! RUN%FLCX = F ! x-component of propagation +! RUN%FLCY = F ! y-component of propagation +! RUN%FLCTH = F ! direction shift +! RUN%FLCK = F ! wavenumber shift +! RUN%FLSOU = F ! source terms +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! +! * It is highly recommended to set up time steps which are multiple +! between them. +! +! * The first time step to calculate is the maximum CFL time step +! which depend on the lowest frequency FREQ1 previously set up and the +! lowest spatial grid resolution in meters DXY. +! reminder : 1 degree=60minutes // 1minute=1mile // 1mile=1.852km +! The formula for the CFL time is : +! Tcfl = DXY / (G / (FREQ1*4*Pi) ) with the constants Pi=3,14 and G=9.8m/s²; +! DTXY ~= 90% Tcfl +! DTMAX ~= 3 * DTXY (maximum global time step limit) +! +! * The refraction time step depends on how strong can be the current velocities +! on your grid : +! DTKTH ~= DTMAX / 2 ! in case of no or light current velocities +! DTKTH ~= DTMAX / 10 ! in case of strong current velocities +! +! * The source terms time step is usually defined between 5s and 60s. +! A common value is 10s. +! DTMIN = 10 +! +! * namelist must be terminated with / +! * definitions & defaults: +! TIMESTEPS%DTMAX = 0. ! maximum global time step (s) +! TIMESTEPS%DTXY = 0. ! maximum CFL time step for x-y (s) +! TIMESTEPS%DTKTH = 0. ! maximum CFL time step for k-th (s) +! TIMESTEPS%DTMIN = 0. ! minimum source term time step (s) +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! +! * the tunable parameters for source terms, propagation schemes, and +! numerics are read using namelists. +! * Any namelist found in the folowing sections is temporarily written +! to param.scratch, and read from there if necessary. +! * The order of the namelists is immaterial. +! * Namelists not needed for the given switch settings will be skipped +! automatically +! +! * grid type can be : +! 'RECT' : rectilinear +! 'CURV' : curvilinear +! 'UNST' : unstructured (triangle-based) +! +! * coordinate system can be : +! 'SPHE' : Spherical (degrees) +! 'CART' : Cartesian (meters) +! +! * grid closure can only be applied in spherical coordinates +! +! * grid closure can be : +! 'NONE' : No closure is applied +! 'SMPL' : Simple grid closure. Grid is periodic in the +! : i-index and wraps at i=NX+1. In other words, +! : (NX+1,J) => (1,J). A grid with simple closure +! : may be rectilinear or curvilinear. +! 'TRPL' : Tripole grid closure : Grid is periodic in the +! : i-index and wraps at i=NX+1 and has closure at +! : j=NY+1. In other words, (NX+1,J<=NY) => (1,J) +! : and (I,NY+1) => (NX-I+1,NY). Tripole +! : grid closure requires that NX be even. A grid +! : with tripole closure must be curvilinear. +! +! * The coastline limit depth is the value which distinguish the sea +! points to the land points. All the points with depth values (ZBIN) +! greater than this limit (ZLIM) will be considered as excluded points +! and will never be wet points, even if the water level grows over. +! It can only overwrite the status of a sea point to a land point. +! The value must have a negative value under the mean sea level +! +! * The minimum water depth allowed to compute the model is the absolute +! depth value (DMIN) used in the model if the input depth is lower to +! avoid the model to blow up. +! +! * namelist must be terminated with / +! * definitions & defaults: +! GRID%NAME = 'unset' ! grid name (30 char) +! GRID%NML = 'namelists.nml' ! namelists filename +! GRID%TYPE = 'unset' ! grid type +! GRID%COORD = 'unset' ! coordinate system +! GRID%CLOS = 'unset' ! grid closure +! +! GRID%ZLIM = 0. ! coastline limit depth (m) +! GRID%DMIN = 0. ! abs. minimum water depth (m) +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_10ms/namelists_ST4_T702.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! - only for RECT grids - +! +! * The minimum grid size is 3x3. +! +! * If the grid increments SX and SY are given in minutes of arc, the scaling +! factor SF must be set to 60. to provide an increment factor in degree. +! +! * If CSTRG='SMPL', then SX is forced to 360/NX. +! +! * value <= value_read / scale_fac +! +! * namelist must be terminated with / +! * definitions & defaults: +! RECT%NX = 0 ! number of points along x-axis +! RECT%NY = 0 ! number of points along y-axis +! +! RECT%SX = 0. ! grid increment along x-axis +! RECT%SY = 0. ! grid increment along y-axis +! RECT%SF = 1. ! scaling division factor for x-y axis +! +! RECT%X0 = 0. ! x-coordinate of lower-left corner (deg) +! RECT%Y0 = 0. ! y-coordinate of lower-left corner (deg) +! RECT%SF0 = 1. ! scaling division factor for x0,y0 coord +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! - for RECT and CURV grids - +! +! * if no obstruction subgrid, need to set &MISC FLAGTR = 0 +! +! * The depth value must have negative values under the mean sea level +! +! * value <= value_read * scale_fac +! +! * IDLA : Layout indicator : +! 1 : Read line-by-line bottom to top. (default) +! 2 : Like 1, single read statement. +! 3 : Read line-by-line top to bottom. +! 4 : Like 3, single read statement. +! * IDFM : format indicator : +! 1 : Free format. (default) +! 2 : Fixed format. +! 3 : Unformatted. +! * FORMAT : element format to read : +! '(....)' : auto detected (default) +! '(f10.6)' : float type +! +! * Example : +! IDF SF IDLA IDFM FORMAT FILENAME +! 50 0.001 1 1 '(....)' 'GLOB-30M.bot' +! +! * namelist must be terminated with / +! * definitions & defaults: +! DEPTH%SF = 1. ! scale factor +! DEPTH%FILENAME = 'unset' ! filename +! DEPTH%IDF = 50 ! file unit number +! DEPTH%IDLA = 1 ! layout indicator +! DEPTH%IDFM = 1 ! format indicator +! DEPTH%FORMAT = '(....)' ! formatted read format +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! From 026fcdd66de9cd94644fd527eb1eced4a6dd66f6 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Mon, 22 Jan 2024 11:43:45 -0500 Subject: [PATCH 031/136] initialize USSP_WN for mod_def (#1165) --- model/src/w3gridmd.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 5af38fc12e..51aa3d1594 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -2976,6 +2976,7 @@ SUBROUTINE W3GRID() CALL EXTCDE( 31) ENDIF + USSP_WN = 0.0 ! initialize to 0s DO J=1,USSPF(2) USSP_WN(j) = STK_WN(J) ENDDO From 9a718fc86fb0d4658dfcdd9295e156c7ce437d19 Mon Sep 17 00:00:00 2001 From: "W. Erick Rogers" <156342000+ErickRogers@users.noreply.github.com> Date: Tue, 23 Jan 2024 15:20:34 -0600 Subject: [PATCH 032/136] Introduce IC4M8 and IC4M9 to WW3 (#1176) --- manual/eqs/ICE4.tex | 16 +- manual/eqs/ICE5.tex | 4 +- manual/manual.bib | 81 ++++++- model/nml/ww3_shel.nml | 4 +- model/src/w3gdatmd.F90 | 21 +- model/src/w3gridmd.F90 | 15 +- model/src/w3iogrmd.F90 | 8 +- model/src/w3sic4md.F90 | 229 +++++++++++++++--- regtests/bin/matrix.base | 2 + regtests/ww3_tic1.1/info | 6 +- .../ww3_tic1.1/input_IC4_M8/namelists_1-D.nml | 2 + regtests/ww3_tic1.1/input_IC4_M8/points.list | 16 ++ regtests/ww3_tic1.1/input_IC4_M8/switch | 1 + regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.inp | 42 ++++ regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.nml | 81 +++++++ regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.inp | 20 ++ regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.nml | 29 +++ regtests/ww3_tic1.1/input_IC4_M8/ww3_outf.inp | 13 + .../ww3_tic1.1/input_IC4_M8/ww3_outp_spec.inp | 19 ++ .../input_IC4_M8/ww3_outp_tab50.inp | 19 ++ .../input_IC4_M8/ww3_outp_tab51.inp | 10 + .../input_IC4_M8/ww3_prep_icecon.inp | 38 +++ regtests/ww3_tic1.1/input_IC4_M8/ww3_shel.inp | 68 ++++++ regtests/ww3_tic1.1/input_IC4_M8/ww3_strt.inp | 17 ++ .../ww3_tic1.1/input_IC4_M9/namelists_1-D.nml | 2 + regtests/ww3_tic1.1/input_IC4_M9/points.list | 16 ++ regtests/ww3_tic1.1/input_IC4_M9/switch | 1 + regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.inp | 42 ++++ regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.nml | 81 +++++++ regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.inp | 20 ++ regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.nml | 29 +++ regtests/ww3_tic1.1/input_IC4_M9/ww3_outf.inp | 13 + .../ww3_tic1.1/input_IC4_M9/ww3_outp_spec.inp | 19 ++ .../input_IC4_M9/ww3_outp_tab50.inp | 19 ++ .../input_IC4_M9/ww3_outp_tab51.inp | 10 + .../input_IC4_M9/ww3_prep_icecon.inp | 38 +++ regtests/ww3_tic1.1/input_IC4_M9/ww3_shel.inp | 68 ++++++ regtests/ww3_tic1.1/input_IC4_M9/ww3_strt.inp | 17 ++ 38 files changed, 1071 insertions(+), 65 deletions(-) create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/namelists_1-D.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/points.list create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/switch create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_outf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_spec.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab50.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab51.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_prep_icecon.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_shel.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M8/ww3_strt.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/namelists_1-D.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/points.list create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/switch create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_outf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_spec.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab50.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab51.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_prep_icecon.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_shel.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M9/ww3_strt.inp diff --git a/manual/eqs/ICE4.tex b/manual/eqs/ICE4.tex index 7e4332ce5c..1ee257d606 100644 --- a/manual/eqs/ICE4.tex +++ b/manual/eqs/ICE4.tex @@ -52,6 +52,20 @@ \subsubsection{~$S_{ice}$: Empirical/parametric damping by sea ice} \label{sec:I {\code IC4M7}: This is a formula for dissipation from \cite{art:Dob15}, developed for a mixture of pancake and frazil ice, using data collected in the Weddell Sea (Antarctica). The formula depends on wave frequency and ice thickness: \begin{equation}\label{eq:ice7} - {\alpha=0.2T^{-2.13}h} \:\:\: . + {\alpha=2k_i=0.2h^1f^{2.13}} \:\:\: . \end{equation} This method is described in \cite{rep:RPLA18}. + +{\code IC4M8}: Like {\code IC4M7}, this method is in the general form of +\begin{equation}\label{eq:ice8} + {k_i=C_{hf}h^mf^n} \:\:\: . +\end{equation} +The formula is taken from \cite{Meylan2018}, where it is described as a ``Model with Order 3 Power Law''. It is applied by \cite{Liu2020}, where it is referred to as the ``M2'' model. The model specifies $m=1$ and $n=3$, and $C_{hf}$ is a user-specified calibration coefficient. \cite{Liu2020} provide calibration to two field cases and \cite{rep:RYW2021} provides a calibration to a third field case, \cite{art:RMK2021}. The third calibration is set as the default for {\code IC4M8}, $C_{hf}=0.059$, but can be changed in using the namelist parameter (constant and uniform) {\code IC4CN}, or using the spatially and/or temporally variable parameter ${C_{ice,2}}$ . Further details on the calibrations are available in the inline documentation in {\file w3sic4md.F90}. This method is functionally the same as the ``{\code M2}'' model in {\code IC5} (i.e., {\code IC5} with {\code IC5VEMOD=3}) and is redundantly included here as {\code IC4M8} because it is in the same ``family'' as {\code IC4M7} and {\code IC4M9}, being in the form of Eq. (\ref{eq:ice8}). + +For an example of setting the namelist parameter, see {\file /regtests/ww3\_tic1.1/input\_IC4\_M8}. + +{\code IC4M9}: This formula is taken from the ``monomial power fit'' given in section 2.2.3 of \cite{rep:RYW2021}. Like {\code IC4M7} and {\code IC4M8}, it is a specific case of the general form of Eq. (\ref{eq:ice8}). The specificity is the constraint that $m=n/2-1$. This constraint is derived by \cite{rep:RYW2021} by invoking the scaling from \cite{art:YRW2019}, which is based on Reynolds number with ice thickness as the relevant length scale. This is also given as equation 2 in \cite{art:YRW2022}. The default namelist settings are $C_{hf}=2.9$ and $n=4.5$, from calibration by \cite{rep:RYW2021} to \cite{art:RMK2021}. Further details, including alternative calibrations such as \cite{art:Yu2022}, are available in the inline documentation in {\file w3sic4md.F90}. Constant values can be set using namelist parameters, where $C_{hf}$ and $n$ are {\code IC4CN(1)} and {\code IC4CN(2)}, respectively. Spatially and/or temporally versions of the same can be specified as ${C_{ice,2}}$ and ${C_{ice,3}}$, respectively. + +The namelist default $C_{hf}$ values in {\code IC4M8} and {\code IC4M9} are consistent with those of identical formulae implemented in \cite{man:SWAN4145A}. + + diff --git a/manual/eqs/ICE5.tex b/manual/eqs/ICE5.tex index f5fac80fab..4d5ab25b0c 100755 --- a/manual/eqs/ICE5.tex +++ b/manual/eqs/ICE5.tex @@ -25,7 +25,7 @@ \subsubsection{~$S_{ice}$: Damping by sea ice (effective medium models)} \label{ \begin{align} k_i^{EFS} &\propto \eta h_i^3 \sigma^{11},\label{eq:fspw}\\ k_i^{RP} &\propto \frac{\eta}{\rho_w g^2} \sigma^3,\label{eq:rppw} \end{align} -whereas previous field measurements \citep[e.g.,][]{Meylan2018, Rogers2021} support a power law $k_i \propto \sigma^n$, with $n$ between 2 and 4. Eqs.~(\ref{eq:fspw}) and (\ref{eq:rppw}) indicate at certain regimes (i.e., $k_r \approx k_0$ and low $k_i$), $k_i$ of the EFS model is too sensitive to wave frequency and $k_i$ of the RP model shows no dependence on ice thickness. +whereas previous field measurements \citep[e.g.,][]{Meylan2018, RMK21} support a power law $k_i \propto \sigma^n$, with $n$ between 2 and 4. Eqs.~(\ref{eq:fspw}) and (\ref{eq:rppw}) indicate at certain regimes (i.e., $k_r \approx k_0$ and low $k_i$), $k_i$ of the EFS model is too sensitive to wave frequency and $k_i$ of the RP model shows no dependence on ice thickness. The third model included in the {\code IC5} module is based on the ``Model with Order 3 Power Law'' proposed by \citet[][their section 6.2; hereafter the M2 model]{Meylan2018}, which assumes the loss of wave energy is proportional to the horizontal ice velocity squared times the ice thickness. The attenuation rate is given by \begin{equation} @@ -52,4 +52,4 @@ \subsubsection{~$S_{ice}$: Damping by sea ice (effective medium models)} \label{ % \cit{IC5VEMOD} {the sea ice model to be selected: 1 - {\code EFS}, 2 - {\code RP}, 3 - {\code M2}; Default=3 (i.e., \textbf{the {\code M2} model is chosen}).} \end{clist} -The first 6 parameters were introduced to improve the stability of the numerical solver for the EFS model \citep[the solver may fail for small wave periods in some rare cases, particularly for shallow water depth $d$ and low $G$; see][]{Liu2020}. Nonetheless, since version 7.12, the M2 model becomes the default option and these limiters are therefore not used by default. \ No newline at end of file +The first 6 parameters were introduced to improve the stability of the numerical solver for the EFS model \citep[the solver may fail for small wave periods in some rare cases, particularly for shallow water depth $d$ and low $G$; see][]{Liu2020}. Nonetheless, since version 7.12, the M2 model becomes the default option and these limiters are therefore not used by default. diff --git a/manual/manual.bib b/manual/manual.bib index c49e3340b8..3da650ea21 100644 --- a/manual/manual.bib +++ b/manual/manual.bib @@ -524,7 +524,7 @@ @TECHREPORT{rep:CR17 INSTITUTION = "{N}aval {R}esearch {L}aboratory, {S}tennis {S}pace {C}enter, {MS}", TYPE = "NRL Memorandum Report", NUMBER = "NRL/MR/7320--17-9726", - NOTE = "25 pp., www7320.nrlssc.navy.mil/pubs.php" } + NOTE = "25 pp., www7320.nrlssc.navy.mil/pubs" } % item art:CRT17 @@ -1764,7 +1764,7 @@ @INPROCEEDINGS{pro:RZ14 TITLE = "New wave-ice interaction physics in {WAVEWATCH III}", BOOKTITLE = Ice14, PUBLISHER = "IAHR", - NOTE = "8 pp., www7320.nrlssc.navy.mil/pubs.php" } + NOTE = "8 pp., www7320.nrlssc.navy.mil/pubs" } % item rep:RPLA18 @@ -1775,7 +1775,18 @@ @TECHREPORT{rep:RPLA18 INSTITUTION = "{N}aval {R}esearch {L}aboratory, {S}tennis {S}pace {C}enter, {MS}", TYPE = "NRL Memorandum Report", NUMBER = "NRL/MR/7320--18-9786", - NOTE = "179 pp., www7320.nrlssc.navy.mil/pubs.php" } + NOTE = "179 pp., www7320.nrlssc.navy.mil/pubs" } + +% item rep:RYW2021 + +@TECHREPORT{rep:RYW2021, + AUTHOR = "W. E. Rogers and J. Yu and D. W. Wang", + YEAR = "2021", + TITLE = "Incorporating dependencies on ice thickness in empirical parameterizations of wave dissipation by sea ice", + INSTITUTION = "{N}aval {R}esearch {L}aboratory, {S}tennis {S}pace {C}enter, {MS}", + TYPE = "NRL Technical Report", + NUMBER = "NRL/OT/7320-21-5145", + NOTE = "35 pp., https://arxiv.org/abs/2104.01246" } % item rep:RMK18 @@ -1786,7 +1797,7 @@ @TECHREPORT{rep:RMK18 INSTITUTION = "{N}aval {R}esearch {L}aboratory, {S}tennis {S}pace {C}enter, {MS}", TYPE = "NRL Memorandum Report", NUMBER = "NRL/MR/7320--18-9801", - NOTE = "25 pp., www7320.nrlssc.navy.mil/pubs.php" } + NOTE = "25 pp., www7320.nrlssc.navy.mil/pubs" } % item art:RH09 @@ -1811,6 +1822,33 @@ @ARTICLE{art:RTS16 doi = "doi:10.1002/2016JC012251" } +% item art:YRW2019 + +@ARTICLE{art:YRW2019, + AUTHOR = "J. Yu and W. E. Rogers and D. W. Wang", + YEAR = 2019, + TITLE = "A Scaling for Wave Dispersion Relationships in Ice-Covered Waters", + JOURNAL = JGR, + VOLUME = "124", + PAGES = "8429--8438" , + doi = "doi:10.1029/2018JC014870" + } + +% item art:Yu2022 + +@Article{art:Yu2022, +AUTHOR = {Yu, Jie}, +TITLE = {Wave Boundary Layer at the Ice-Water Interface}, +JOURNAL = {Journal of Marine Science and Engineering}, +VOLUME = {10}, +YEAR = {2022}, +NUMBER = {10}, +ARTICLE-NUMBER = {1472}, +URL = {https://www.mdpi.com/2077-1312/10/10/1472}, +ISSN = {2077-1312}, +DOI = {10.3390/jmse10101472} +} + % item art:CFSRR10 @ARTICLE{art:CFSRR10, @@ -2346,7 +2384,7 @@ @TECHREPORT{rep:RC09 INSTITUTION = "{N}aval {R}esearch {L}aboratory, {S}tennis {S}pace {C}enter, {MS}", TYPE = "NRL Memorandum Report", NUMBER = "NRL/MR/7320--09-9193", - NOTE = "42 pp., www7320.nrlssc.navy.mil/pubs.php" } + NOTE = "42 pp., www7320.nrlssc.navy.mil/pubs" } % item rep:RO13 @@ -2357,7 +2395,7 @@ @TECHREPORT{rep:RO13 INSTITUTION = "{N}aval {R}esearch {L}aboratory, {S}tennis {S}pace {C}enter, {MS}", TYPE = "NRL Memorandum Report", NUMBER = "NRL/MR/7320--13-9462", - NOTE = "31 pp., www7320.nrlssc.navy.mil/pubs.php" } + NOTE = "31 pp., www7320.nrlssc.navy.mil/pubs" } % item rep:Roland2008 @@ -2606,6 +2644,17 @@ @MANUAL{man:SWAN3 ADDRESS = "P.O. Box 5048, 2600 GA Delft, The Netherlands", NOTE = "see http://swan.ct.tudelft.nl" } +% item man:SWAN4145A + +@MANUAL{man:SWAN4145A, + AUTHOR = "{SWAN team}", + YEAR = "2023", + TITLE = "{SWAN Cycle III} version 41.45A User Manual", + ORGANIZATION = "Delft University of Technology, + Faculty of Civil Engineering and Geosciences", + ADDRESS = "P.O. Box 5048, 2600 GA Delft, The Netherlands", + NOTE = "see https://swanmodel.sourceforge.io/" } + % item man:Jones98 @MANUAL{man:Jones98, @@ -3485,10 +3534,14 @@ @article{Liu2021 title={{Global Wave Hindcasts Using the Observation-based Source Terms: Description and Validation}}, author={Liu, Qingxiang and Babanin, Alexander and Rogers, W Erick and Zieger, Stefan and Young, Ian and Bidlot, Jean-Raymond and Durrant, Tom and Ewans, Kevin and Guan, Changlong and Kirezci, Cagil and Lemos, Gil and MacHutchon, Keith and Moon, Il-Ju and Rapizo, Henrique and Ribal, Agustinus and Semedo, Alvaro and Wang, Juanjuan}, journal={Journal of Advances in Modeling Earth Systems (JAMES)}, - year={submitted} + year = {2021}, + volume = {13}, + number = {8}, + pages = {e2021MS002493}, + doi = {https://doi.org/10.1029/2021MS002493}, } -@article{Rogers2021, +@article{art:RMK2021, title = {Estimates of spectral wave attenuation in Antarctic sea ice, using model/data inversion}, journal = {Cold Regions Science and Technology}, volume = {182}, @@ -3499,6 +3552,18 @@ @article{Rogers2021 author = {W. Erick Rogers and Michael H. Meylan and Alison L. Kohout} } +@article{art:YRW2022, + title = {A new method for parameterization of wave dissipation by sea ice}, + journal = {Cold Regions Science and Technology}, + volume = {199}, + pages = {103582}, + year = {2022}, + issn = {0165-232X}, + doi = {https://doi.org/10.1016/j.coldregions.2022.103582}, + url = {https://www.sciencedirect.com/science/article/pii/S0165232X2200101X}, + author = {Jie Yu and W. Erick Rogers and David W. Wang}, +} + @article{Forristall1981, author = {Forristall, George Z.}, doi = {10.1029/JC086iC09p08075}, diff --git a/model/nml/ww3_shel.nml b/model/nml/ww3_shel.nml index f6700ca8a8..97beaf6a0b 100644 --- a/model/nml/ww3_shel.nml +++ b/model/nml/ww3_shel.nml @@ -319,9 +319,9 @@ ! * the number of each homogeneous input is defined by HOMOG_COUNT ! * the total number of homogeneous input is automatically calculated ! * the homogeneous input must start from index 1 to N -! * if VALUE1 is equal 0, then the homogeneous input is desactivated +! * if VALUE1 is equal 0, then the homogeneous input is deactivated ! * NAME can be IC1, IC2, IC3, IC4, IC5, MDN, MTH, MVS, LEV, CUR, WND, ICE, MOV -! * each homogeneous input is defined over a maximum of 3 values detailled below : +! * each homogeneous input is defined over a maximum of 3 values detailed below : ! - IC1 is defined by thickness ! - IC2 is defined by viscosity ! - IC3 is defined by density diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 59d3bcddf5..bde5bf9998 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -199,10 +199,14 @@ MODULE W3GDATMD ! Default is 1.0, meaning that 100% ice ! concentration result in zero source term ! If set to 0.0, then ice has no direct impact on Sln / Sin / Snl / Sds - ! IC3PARS R.A. Public various parameters for use in IC4, handled as + ! IC3PARS R.A. Public various parameters for use in IC3, handled as ! an array for simplicity - ! IC4_KI R.A. Public KI (dissipation rate) values for use in IC4 - ! IC4_FC R.A. Public FC (frequency bin separators) for use in IC4 + ! IC4_KI R.A. Public KI (dissipation rate) values for use in IC4M6 + ! IC4_FC R.A. Public FC (frequency bin separators) for use in IC4M6 + ! IC4_CN R.A. Public Coefficients for use in IC4M2 + ! IC4_FMIN Real Public Minimum frequency below which ki is set to + ! some background level dissipation (for S_ice) + ! IC4_KIBK Real Public Low, background level dissipation (for S_ice) ! PFMOVE Real Public Tunable parameter in GSE correction ! for moving grids. ! GRIDSHIFT Real Public Grid offset for multi-grid w/SCRIP @@ -615,7 +619,7 @@ MODULE W3GDATMD IPARS = -1, NAUXGR ! #ifdef W3_IC4 - INTEGER, PARAMETER :: NIC4=10 + INTEGER, PARAMETER :: NIC4=16 , NIC42=5 #endif INTEGER, PARAMETER :: RLGTYPE = 1 INTEGER, PARAMETER :: CLGTYPE = 2 @@ -732,6 +736,8 @@ MODULE W3GDATMD INTEGER, POINTER :: IC4PARS(:) REAL, POINTER :: IC4_KI(:) REAL, POINTER :: IC4_FC(:) + REAL, POINTER :: IC4_CN(:) + REAL :: IC4_FMIN, IC4_KIBK #endif #ifdef W3_IC5 REAL, POINTER :: IC5PARS(:) @@ -1144,6 +1150,8 @@ MODULE W3GDATMD INTEGER, POINTER :: IC4PARS(:) REAL, POINTER :: IC4_KI(:) REAL, POINTER :: IC4_FC(:) + REAL, POINTER :: IC4_CN(:) + REAL, POINTER :: IC4_FMIN, IC4_KIBK #endif #ifdef W3_IC5 REAL, POINTER :: IC5PARS(:) @@ -1840,6 +1848,8 @@ SUBROUTINE W3DIMX ( IMOD, MX, MY, MSEA, NDSE, NDST & CHECK_ALLOC_STATUS ( ISTAT ) ALLOCATE ( GRIDS(IMOD)%IC4_FC(NIC4), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( GRIDS(IMOD)%IC4_CN(NIC42), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) #endif #ifdef W3_IC5 ALLOCATE ( GRIDS(IMOD)%IC5PARS(9), STAT=ISTAT ) @@ -2314,6 +2324,9 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) IC4PARS => GRIDS(IMOD)%IC4PARS IC4_KI => GRIDS(IMOD)%IC4_KI IC4_FC => GRIDS(IMOD)%IC4_FC + IC4_CN => GRIDS(IMOD)%IC4_CN + IC4_FMIN => GRIDS(IMOD)%IC4_FMIN + IC4_KIBK => GRIDS(IMOD)%IC4_KIBK #endif #ifdef W3_IC5 IC5PARS => GRIDS(IMOD)%IC5PARS diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 51aa3d1594..977a203ae7 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -114,6 +114,7 @@ MODULE W3GRIDMD !/ 07-Jun-2021 : S_{nl} GKE NL5 (Q. Liu) ( version 7.13 ) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) !/ 28-Feb-2023 : GQM as an alternative for NL1 ( version 7.15 ) + !/ 11-Jan-2024 : New namelist parameters for IC4 ( version 7.15 ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -764,9 +765,10 @@ MODULE W3GRIDMD #ifdef W3_IC4 INTEGER :: IC4METHOD - REAL :: IC4KI(NIC4), IC4FC(NIC4) + REAL :: IC4KI(NIC4), IC4FC(NIC4), & + IC4CN(NIC42), IC4FMIN, IC4KIBK #endif - ! + #ifdef W3_IC5 REAL :: IC5MINIG, IC5MINWT, & IC5MAXKRATIO, IC5MAXKI, IC5MINHW, & @@ -970,7 +972,8 @@ MODULE W3GRIDMD IC3VISC, IC3ELAS, IC3DENS, IC3HICE #endif #ifdef W3_IC4 - NAMELIST /SIC4/ IC4METHOD, IC4KI, IC4FC + NAMELIST /SIC4/ IC4METHOD, IC4KI, IC4FC, IC4CN, IC4FMIN, & + IC4KIBK #endif #ifdef W3_IC5 NAMELIST /SIC5/ IC5MINIG, IC5MINWT, IC5MAXKRATIO, & @@ -2891,6 +2894,9 @@ SUBROUTINE W3GRID() IC4METHOD = 1 !switch for methods within IC4 IC4KI=0.0 IC4FC=0.0 + IC4CN=0.0 + IC4FMIN=0.0 + IC4KIBK=0.0 #endif ! #ifdef W3_IC5 @@ -5313,6 +5319,9 @@ SUBROUTINE W3GRID() IC4PARS(1)=IC4METHOD IC4_KI=IC4KI IC4_FC=IC4FC + IC4_CN=IC4CN + IC4_FMIN=IC4FMIN + IC4_KIBK=IC4KIBK #endif ! #ifdef W3_IC5 diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index f8723d8123..ce4403ba38 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -1292,11 +1292,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif #ifdef W3_IC4 WRITE (NDSM) & - IC4PARS,IC4_KI,IC4_FC + IC4PARS,IC4_KI,IC4_FC,IC4_CN,IC4_FMIN,IC4_KIBK #ifdef W3_ASCII WRITE (NDSA,*) & - 'IC4PARS,IC4_KI,IC4_FC:', & - IC4PARS,IC4_KI,IC4_FC + 'IC4PARS,IC4_KI,IC4_FC,IC4_CN,IC4_FMIN,IC4_KIBK:', & + IC4PARS,IC4_KI,IC4_FC,IC4_CN,IC4_FMIN,IC4_KIBK #endif #endif #ifdef W3_IC5 @@ -1338,7 +1338,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif #ifdef W3_IC4 READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IC4PARS,IC4_KI,IC4_FC + IC4PARS,IC4_KI,IC4_FC,IC4_CN,IC4_FMIN,IC4_KIBK #endif #ifdef W3_IC5 READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & diff --git a/model/src/w3sic4md.F90 b/model/src/w3sic4md.F90 index 7b1c9c67ab..3cc7da357d 100644 --- a/model/src/w3sic4md.F90 +++ b/model/src/w3sic4md.F90 @@ -58,13 +58,6 @@ MODULE W3SIC4MD ! ! 5. Remarks : ! - ! Source material : - ! 1) Wadhams et al. JGR 1988 - ! 2) Meylan et al. GRL 2014 - ! 3) Kohout & Meylan JGR 2008 in Horvat & Tziperman Cryo. 2015 - ! 4) Kohout et al. Nature 2014 - ! 5) Doble et al. GRL 2015 - ! 6) Rogers et al. JGR 2016 ! Documentation of IC4: ! 1) Collins and Rogers, NRL Memorandum report 2017 ! ---> "A Source Term for Wave Attenuation by Sea @@ -82,6 +75,21 @@ MODULE W3SIC4MD ! ---> New recommendations for IC4 Method 2 (polynomial fit) ! and IC4 Method 6 (step function via namelist) ! + ! Other source material : + ! *** Wadhams et al. JGR 1988 + ! *** Meylan et al. GRL 2014 + ! *** Kohout & Meylan JGR 2008 in Horvat & Tziperman Cryo. 2015 + ! *** Kohout et al. Nature 2014 + ! *** Doble et al. GRL 2015 + ! *** Rogers et al. JGR 2016 + ! *** Meylan et al. JGR 2018 + ! *** Yu et al. JGR 2019 + ! *** Liu et al. JPO 2020 + ! *** Rogers et al. CRST 2021 (RMK2021) + ! *** Rogers et al. tech. rep. 2021 (RYW2021) + ! *** Yu et al. CRST 2022 + ! *** Yu JMSE 2022 + ! ! 6. Switches : ! ! See subroutine documentation. @@ -127,6 +135,9 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) !/ 08-Apr-2016 : Method 6 added (namelist step funct.) (E. Rogers) !/ 24-Feb-2017 : Corrections to Methods 1,2,3,4 (E. Rogers) !/ 13-Apr-2017 : Method 7 added (Doble et al. 2015) (E. Rogers) + !/ 11-Jan-2024 : Method 8 added (Meylan et al. 2018) (E. Rogers) + !/ 11-Jan-2024 : Method 9 added (Rogers et al., 2021) + !/ denoted "RYW2021" (E. Rogers) !/ !/ FIXME : Move field input to W3SRCE and provide !/ (S.Zieger) input parameter to W3SIC1 to make the subroutine @@ -155,7 +166,24 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ! 2) Polynomial fit, Eq. 3 from Meylan et al. 2014 ! 3) Quadratic fit to Kohout & Meylan'08 in Horvat & Tziperman'15 ! Here, note that their eqn is given as ln(alpha)=blah, so we - ! have alpha=exp(blah) + ! have alpha=exp(blah). + ! Note from ER: + ! This implementation has two things to keep in mind: + ! 1) This is a scattering model, applied as dissipation, + ! which is not correct. + ! 2) This is not actually HT15! The alpha of HT15 has + ! different meaning from alpha of CR17, as follows: + ! HT15: decay is exp(-alpha*Lambda) where Lambda + ! is the number of floes encountered. + ! CR17: decay is exp(-alpha*x) + ! Thus, CR17's implementation of HT15 is equivalent to + ! the actual HT15 only if one assumes one floe encountered + ! per meter. This is very strong attenuation, as shown in + ! Figure 3 of CR17! This problem might be fixed by computing + ! an encounter interval length scale from an a_ice and d_ice + ! provided by the user...or a length scale provided by the + ! user. + ! See also: page 3 of Rogers et al. (RYW2021). ! 4) Eq. 1 from Kohout et al. 2014 ! ! 5) Simple step function for ki as a function of frequency @@ -208,9 +236,10 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ! 'MTH' 19680606 000000 0.16 ! ! 6) Simple step function for ki as a function of frequency - ! with up to 10 "steps". Controlling parameters KIx and FCx are + ! with up to 16 "steps". Controlling parameters KIx and FCx are ! read in as namelist parameters, so they are stationary and - ! uniform. + ! uniform. (If 16 steps is not enough, the number of steps can be + ! increased at compile time by changing NIC4 in w3gdatmd.ftn.) ! The last non-zero FCx value should be a large number, e.g. 99 Hz ! ! 4444444444 <--- ki=ic4_ki(4) @@ -237,6 +266,62 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ! ALPHA = 0.2*(T^(-2.13)*HICE or ! ALPHA = 0.2*(FREQ^2.13)*HICE ! + ! 8) Meylan et al. (JGR 2018), eq. 48. "Model with Order 3 Power + ! Law". The is denoted as the "M2" model by Liu et al. (JPO 2020) + ! It is a function of ice thickness and wave period. + ! ki = ChfM2*h_ice*freq^3 + ! where ChfM2 is a coefficient of proportionality which formally + ! includes viscosity, density, and gravity parameters, see + ! Meylan et al. (JGR 2018) for details. + ! ChfM2 has units of s3/m2 + ! It is equation 53 in Meylan et al. (2018) and equation 16 in + ! Liu et al. (2020). + ! This method is functionally the same as the "M2" model in IC5 + ! in WW3 (IC5 w/IC5VEMOD=3) and is redundantly included here as + ! IC4M8 because it is in the same "family" as IC4M7 and IC4M9, + ! being in the form of: + ! ki=Chf * h_ice^m * freq^n . + ! Calibrations: + ! * Liu et al. has ChfM2=eta*(2*pi)^3/(1025*9.81^2) + ! ** eta=14.0 for "Sikuliaq" case of Liu et al., so ChfM2=0.035 + ! ** eta=3.0 for "SIPEX" case of Liu et al., so ChfM2=0.0075 + ! * Rogers et al. (tech rep. 2021, "RYW2021") : + ! ** Fit to Rogers et al. (CRST 2021 "RMK2021") ChfM2=0.059 (*SD*) + ! suggested default is marked with "(*SD*)", for consistency + ! with SWAN (v41.31AB or later) + ! + ! 9) Rogers et al. (tech. rep. 2021, "RYW2021"): the "monomial power + ! fit" described in section 2.2.3. It is the general form above, + ! ki=Chf * h_ice^m * freq^n but is constrained such that m=n/2-1. + ! This constraint is derived by RYW2021 by invoking the scaling from + ! Yu et al. (2019), which is based on Reynolds number with ice + ! thickness as the relevant length scale. + ! This is also given as equation 2 in Yu et al. (CRST 2022). + ! Some calibrations are as follows: + ! * RYW2021, calibration to RMK2021: Chf=2.9 and n=4.5 (*SD*) + ! * Yu et al. (2022) calibration to RMK2021 : Chf=2.4 and n=4.46 + ! (noting that c_n=0.108 and Chf=c_n*(2*pi/sqrt(g))^n) + ! * Yu (2022) adjusted the prior calibration to get better fit + ! to higher frequency lab measurements and got: + ! Chf=7.89 and n=4.8 + ! suggested default is marked with "(*SD*)", for consistency + ! with SWAN (v41.31AB or later) + ! + ! ------------------------------------------------------------------ + ! + ! For all methods, the user can specify namelist + ! variables IC4FMIN and IC4KIBK such as: + ! &SIC4 IC4METHOD = [...], IC4FMIN=0.08, IC4KIBK=1.0e-7, [...] + ! This accomodates the situation where the empirically-derived + ! dissipation is uncertain for the lowest frequencies, which can be + ! the case if estimated dissipation rate is so small that it falls + ! in the noise level for the estimation method. (This is common, + ! since some ice types cause only very weak dissipation + ! to low frequencies.) In the example above, the amplitude + ! dissipation rate ki is set to some low background level + ! dissipation IC4KIBK=1.0e-7 1/m when model frequency is less than + ! 0.08 Hz. + ! ! More verbose description of implementation of Sice in WW3: ! See documentation for IC1 ! @@ -315,9 +400,10 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) USE W3ODATMD, ONLY: NDSE USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, MAPWN, IC4PARS, DDEN, & - IC4_KI, IC4_FC, NIC4 + IC4_KI, IC4_FC, IC4_CN, NIC4, IC4_FMIN, & + IC4_KIBK USE W3IDATMD, ONLY: ICEP1, ICEP2, ICEP3, ICEP4, ICEP5, & - MUDT, MUDV, MUDD, INFLAGS2 + MUDT, MUDV, MUDD, INFLAGS2 #ifdef W3_T USE W3ODATMD, ONLY: NDST @@ -353,14 +439,18 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) INTEGER :: IKTH, IK, ITH, IC4METHOD, IFC REAL :: D1D(NK), EB(NK) REAL :: ICECOEF1, ICECOEF2, ICECOEF3, & - ICECOEF4, ICECOEF5, ICECOEF6, & - ICECOEF7, ICECOEF8 - REAL :: KI1,KI2,KI3,KI4,FC5,FC6,FC7,FREQ + ICECOEF4, ICECOEF5, ICECOEF6, & + ICECOEF7, ICECOEF8 + REAL :: CICE1,CICE2,CICE3,CICE4,CICE5 ! temporary variables + REAL :: KI1,KI2,KI3,KI4,FC5,FC6,FC7 REAL :: HS, EMEAN, HICE + REAL :: Chf,mpow,npow REAL, ALLOCATABLE :: WN_I(:) ! exponential decay rate for amplitude REAL, ALLOCATABLE :: ALPHA(:) ! exponential decay rate for energy + REAL, ALLOCATABLE :: FREQ(:) ! wave frequency REAL, ALLOCATABLE :: MARG1(:), MARG2(:) ! Arguments for M2 REAL, ALLOCATABLE :: KARG1(:), KARG2(:), KARG3(:) !Arguments for M3 + LOGICAL :: NML_INPUT ! if using namelist input for M2 !/ !/ ------------------------------------------------------------------- / @@ -380,6 +470,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ALLOCATE(KARG1(0:NK+1)) ALLOCATE(KARG2(0:NK+1)) ALLOCATE(KARG3(0:NK+1)) + ALLOCATE(FREQ(0:NK+1)) MARG1 = 0.0 MARG2 = 0.0 KARG1 = 0.0 @@ -398,12 +489,12 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) HS = 0.0 HICE = 0.0 EMEAN = 0.0 + FREQ=SIG/TPI ! ! IF (.NOT.INFLAGS2(-7))THEN ! WRITE (NDSE,1001) 'ICE PARAMETER 1' ! CALL EXTCDE(201) ! ENDIF - ! ! We cannot remove the other use of INFLAGS below, ! because we would get 'array not allocated' error for the methods @@ -430,20 +521,8 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) IC4METHOD = IC4PARS(1) ! - ! x. No ice --------------------------------------------------------- / - ! - ! IF ( ICECOEF1==0. ) THEN - ! D = 0. - ! WRITE(*,*) '!!!No Ice!!!' - ! - ! x. Ice ------------------------------------------------------------ / - ! ELSE - ! - ! x.x Set constant(s) and write test output -------------------------- / - ! - ! (none) - ! #ifdef W3_T38 + ! Write test output ---------------------------------------------- / WRITE (NDST,9000) DEPTH,ICECOEF1,ICECOEF2,ICECOEF3,ICECOEF4 #endif ! @@ -461,8 +540,32 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) !NB: Eq. 3 only includes T^2 and T^4 terms, ! which correspond to ICECOEF3, ICECOEF5, so in ! regtest: ICECOEF1=ICECOEF2=ICECOEF4=0 - MARG1 = ICECOEF1 + ICECOEF2*(SIG/TPI) + ICECOEF3*(SIG/TPI)**2 - MARG2 = ICECOEF4*(SIG/TPI)**3 + ICECOEF5*(SIG/TPI)**4 + + NML_INPUT=.TRUE. + IF (INFLAGS2(-7).OR.INFLAGS2(-6).OR.INFLAGS2(-5).OR. & + INFLAGS2(-4).OR.INFLAGS2(-3)) NML_INPUT=.FALSE. + + IF(NML_INPUT)THEN ! get from namelist array + + CICE1=IC4_CN(1) + CICE2=IC4_CN(2) + CICE3=IC4_CN(3) + CICE4=IC4_CN(4) + CICE5=IC4_CN(5) + + ELSE ! get from input-field array (ICEP1 etc.) + + CICE1=ICECOEF1 + CICE2=ICECOEF2 + CICE3=ICECOEF3 + CICE4=ICECOEF4 + CICE5=ICECOEF5 + + ENDIF + + ! CICE1 is C_{ice,1} in Collins and Rogers (2017), for example. + MARG1 = CICE1 + CICE2*FREQ + CICE3*FREQ**2 + MARG2 = CICE4*FREQ**3 + CICE5*FREQ**4 ALPHA = MARG1 + MARG2 WN_I = 0.5 * ALPHA @@ -510,13 +613,12 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) CALL EXTCDE(201) END IF DO IK=1, NK - FREQ=SIG(IK)/TPI ! select ki - IF(FREQ.LT.FC5)THEN + IF(FREQ(IK).LT.FC5)THEN WN_I(IK)=KI1 - ELSEIF(FREQ.LT.FC6)THEN + ELSEIF(FREQ(IK).LT.FC6)THEN WN_I(IK)=KI2 - ELSEIF(FREQ.LT.FC7)THEN + ELSEIF(FREQ(IK).LT.FC7)THEN WN_I(IK)=KI3 ELSE WN_I(IK)=KI4 @@ -534,10 +636,9 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) END IF DO IK=1, NK - FREQ=SIG(IK)/TPI ! select ki DO IFC=1,NIC4 - IF(FREQ.LT.IC4_FC(IFC))THEN + IF(FREQ(IK).LT.IC4_FC(IFC))THEN WN_I(IK)=IC4_KI(IFC) EXIT END IF @@ -548,11 +649,57 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) HICE=ICECOEF1 ! For this method, ICECOEF1=ice thickness DO IK=1,NK - FREQ=SIG(IK)/TPI - ALPHA(IK) = 0.2*(FREQ**2.13)*HICE + ALPHA(IK) = 0.2*(FREQ(IK)**2.13)*HICE END DO WN_I= 0.5 * ALPHA + CASE (8) ! Meylan et al. (JGR 2018), Liu et al. (JPO 2020) + + NML_INPUT=.TRUE. + IF (INFLAGS2(-6)) NML_INPUT=.FALSE. + + IF(NML_INPUT)THEN ! get from namelist array + + Chf=IC4_CN(1) ! Denoted "ChfM2" in documentation + + ELSE ! get from input-field array (ICEP1 etc.) + + Chf=ICECOEF2 ! Denoted "ChfM2" in documentation + + ENDIF + + ! Rename variable, for clarity + hice=ICECOEF1 ! For this method, ICECOEF1 is ice thickness + + DO IK=1,NK + WN_I(IK) = Chf*hice*(FREQ(IK)**3) + END DO + + CASE (9) ! Rogers et al. (2021) (RYW2021), Yu et al. (JGR 2022) + + NML_INPUT=.TRUE. + IF (INFLAGS2(-6).OR.INFLAGS2(-5)) NML_INPUT=.FALSE. + + IF(NML_INPUT)THEN ! get from namelist array + + Chf=IC4_CN(1) ! Denoted as same in documentation + npow=IC4_CN(2) ! Denoted "n" in documentation + + ELSE ! get from input-field array (ICEP1 etc.) + + Chf=ICECOEF2 ! Denoted as same in documentation + npow=ICECOEF3 ! Denoted "n" in documentation + + ENDIF + + ! Rename variable, for clarity + hice=ICECOEF1 ! For this method, ICECOEF1 is ice thickness + ! Compute + mpow=0.5*npow-1.0 ! Denoted "m" in documentation + DO IK=1,NK + WN_I(IK) = Chf*(hice**mpow)*(FREQ(IK)**npow) + END DO + CASE DEFAULT WN_I = ICECOEF1 !Default to IC1: Uniform in k @@ -564,6 +711,8 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) DO IK=1, NK ! SBT1 has: D1D(IK) = FACTOR * MAX(0., (CG(IK)*WN(IK)/SIG(IK)-0.5) ) ! recall that D=S/E=-2*Cg*k_i + IF(FREQ(IK).LT.IC4_FMIN)WN_I(IK)=IC4_KIBK + ! write(*,*)freq(ik),wn_i(ik),ICECOEF1,' % :: freq,ki,hice' ! temporary code: do not commit to repo uncommented D1D(IK) = -2. * CG(IK) * WN_I(IK) END DO @@ -598,7 +747,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3SIC4 : '/ & - ' ',A,' REQUIRED BUT NOT SELECTED'/) + ' ',A,' REQUIRED BUT NOT SELECTED'/) ! #ifdef W3_T 9000 FORMAT (' TEST W3SIC4 : DEPTH,ICECOEF1 : ',2E10.3) diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 3fcf651d6a..97ae213f45 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -1953,6 +1953,8 @@ echo "$rtst -g 206H -w work_IC4_M6H -i input_IC4_M6 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 206L -w work_IC4_M6L -i input_IC4_M6 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -w work_IC4_M7 -i input_IC4_M7 $ww3 ww3_tic1.1" >> matrix.body + echo "$rtst -w work_IC4_M8 -i input_IC4_M8 $ww3 ww3_tic1.1" >> matrix.body + echo "$rtst -w work_IC4_M9 -i input_IC4_M9 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M1 -i input_IC5_M1 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M2 -i input_IC5_M2 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M3 -i input_IC5_M3 $ww3 ww3_tic1.1" >> matrix.body diff --git a/regtests/ww3_tic1.1/info b/regtests/ww3_tic1.1/info index 89f046a37d..589317ea53 100644 --- a/regtests/ww3_tic1.1/info +++ b/regtests/ww3_tic1.1/info @@ -51,6 +51,9 @@ # IC4METHOD = 5 - Simple ki step function # # IC4METHOD = 6 - Simple ki step function via namelist # # IC4METHOD = 7 - Doble et al. (GRL 2015) # +# IC4METHOD = 8 - Meylan et al. (2018) ; Liu et al. (2020) # +# (NB: redundant with IC5+IC5VEMOD=3) # +# IC4METHOD = 9 - RYW (2021) ; Yu et al. (2022) # # IC5 = Choose from three different effective medium models # # IC5VEMOD = 1 - Extended Fox and Squire model (EFS) # # IC5VEMOD = 2 - Robinson and Palmer model (RP) # @@ -170,7 +173,8 @@ # updated: Erick Rogers, Apr 2016 # # updated: Jessica Meixner, May 2016 # # updated: Qingxiang Liu, Jul 2018 # -# last updated: Qingxiang Liu, May 2021 # +# updated: Qingxiang Liu, May 2021 # +# last updated: Erick Rogers, Jan 2024 # # Copyright 2009-2014 National Weather Service (NWS), # # National Oceanic and Atmospheric Administration. All rights # # reserved. WAVEWATCH III is a trademark of the NWS. # diff --git a/regtests/ww3_tic1.1/input_IC4_M8/namelists_1-D.nml b/regtests/ww3_tic1.1/input_IC4_M8/namelists_1-D.nml new file mode 100644 index 0000000000..281a0b12f8 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/namelists_1-D.nml @@ -0,0 +1,2 @@ +&SIC4 IC4METHOD = 8 / +END OF NAMELISTS diff --git a/regtests/ww3_tic1.1/input_IC4_M8/points.list b/regtests/ww3_tic1.1/input_IC4_M8/points.list new file mode 100644 index 0000000000..e2a0afe3d4 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/points.list @@ -0,0 +1,16 @@ +0.00 0. 'Point 1 ' +1.00E3 0. 'Point 2 ' +2.00E3 0. 'Point 3 ' +3.00E3 0. 'Point 4 ' +4.00E3 0. 'Point 5 ' +5.00E3 0. 'Point 6 ' +6.00E3 0. 'Point 7 ' +7.00E3 0. 'Point 8 ' +8.00E3 0. 'Point 9 ' +9.00E3 0. 'Point 10 ' +10.00E3 0. 'Point 11 ' +11.00E3 0. 'Point 12 ' +12.00E3 0. 'Point 13 ' +13.00E3 0. 'Point 14 ' +14.00E3 0. 'Point 15 ' +15.00E3 0. 'Point 16 ' diff --git a/regtests/ww3_tic1.1/input_IC4_M8/switch b/regtests/ww3_tic1.1/input_IC4_M8/switch new file mode 100644 index 0000000000..31ef85baed --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/switch @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC4 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.inp new file mode 100644 index 0000000000..9356362ef3 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.inp @@ -0,0 +1,42 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + '1-D parameterized ice test ' +$ +$ 1.1 0.04118 25 24 0.0 + 1.1 0.0418 31 36 5.0 +$ + F T F F F T + 60. 60. 60. 60. +$ +$ IC4METHOD determines calculation +$ IC4METHOD = 1 - Wadhams et al. (1988) +$ IC4METHOD = 2 - Meylan et al. (2014) +$ IC4METHOD = 3 - Kohout & Meylan (2008) in Horvat & Tziperman (2015) +$ IC4METHOD = 4 - Kohout et al. (2014) +$ IC4METHOD = 5 - Simple ki step function +$ IC4METHOD = 6 - Simple ki step function via namelist +$ IC4METHOD = 7 - Doble et al. (GRL 2015) +$ IC4METHOD = 8 - Meylan et al. (2018) ; Liu et al. (2020) +$ IC4METHOD = 9 - RYW (2021) ; Yu et al. (2022) +$ IC4M8 Fit to R21A L ChfM2=0.059 + &SIC4 IC4METHOD = 8 , IC4CN = 0.059/ +END OF NAMELISTS +$ + 'RECT' F 'NONE' + 156 3 + 1.0E3 1.0E3 1. + -1.0E3 -1.0E3 1. +$ dlim dmin file# scale layout# format# formatdescrip filetype# filenm + -0.1 0.1 401 -1.0 1 1 '(....)' 'NAME' '../input_IC1/depth1d.flat' +$ + 10 1 1 '(....)' 'PART' 'input' +$ +$ First grid +$ + 2 2 F +$ + 0 0 F + 0 0 F + 0 0 +$ + 0. 0. 0. 0. 0 diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.nml b/regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.nml new file mode 100644 index 0000000000..87d4e38456 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_grid.nml @@ -0,0 +1,81 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.0418 + SPECTRUM%NK = 31 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 5.0 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 60. + TIMESTEPS%DTXY = 60. + TIMESTEPS%DTKTH = 60. + TIMESTEPS%DTMIN = 60. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = '1-D parameterized ice test' + GRID%NML = '../input_IC4_M8/namelists_1-D.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'CART' + GRID%CLOS = 'NONE' + GRID%ZLIM = -0.1 + GRID%DMIN = 0.1 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 156 + RECT%NY = 3 + RECT%SX = 1.0E3 + RECT%SY = 1.0E3 + RECT%X0 = -1.0E3 + RECT%Y0 = -1.0E3 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -1.0 + DEPTH%FILENAME = '../input_IC1/depth1d.flat' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 1 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 2 2 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.inp new file mode 100644 index 0000000000..4104d759ea --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.inp @@ -0,0 +1,20 @@ +$ WAVEWATCH III Grid output post-processing (netcdf) +$--------------------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 4 + 0 1 2 + F + ww3. + 4 + 1 999 1 999 3 2 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.nml b/regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.nml new file mode 100644 index 0000000000..46aa758fac --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '19680606 000000' + FIELD%TIMESTRIDE = '3600.' + FIELD%TIMECOUNT = '99' + FIELD%TIMESPLIT = 4 + FIELD%LIST = 'DPT WLV HS DIR' + FIELD%PARTITION = '0 1 2' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IXN = 999 + FILE%IYN = 999 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_outf.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outf.inp new file mode 100644 index 0000000000..2b4c6bca80 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outf.inp @@ -0,0 +1,13 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 0 +$ + 1 999 1 999 1 1 diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_spec.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_spec.inp new file mode 100644 index 0000000000..b500e0ca4d --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_spec.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 120000 3600. 1 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 1 + 2 -1. 0. 33 F diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab50.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab50.inp new file mode 100644 index 0000000000..826bd422d5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab50.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 600. 9999 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 2 + 2 50 diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab51.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab51.inp new file mode 100644 index 0000000000..e54faed463 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_outp_tab51.inp @@ -0,0 +1,10 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 900. 49 +$ +$ 1 + 11 + -1 +$ + 2 + 2 51 diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_prep_icecon.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_prep_icecon.inp new file mode 100644 index 0000000000..26a94221f5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_prep_icecon.inp @@ -0,0 +1,38 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : IC1, IC2, IC3, IC4, IC5 => Ice parameters (5) +$ MDN => Mud densities +$ MTH => Mud thicknesses +$ MVS => Mud viscosities +$ ICE => Ice concentrations. +$ LEV => Water levels. +$ WND => Winds. +$ WNS => Winds (including air-sea temp. dif.) +$ CUR => Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ Header flag : If true, write header on "*.ww3" data file +$ + 'ICE' 'AI' T T +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 000000 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F6.2))' + 2345 '../input_IC2_nondisp/icecon.156x3.txt' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_shel.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_shel.inp new file mode 100644 index 0000000000..c496220ff7 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_shel.inp @@ -0,0 +1,68 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + T T Ice parameter 1 + F F Ice parameter 2 + F F Ice parameter 3 + F F Ice parameter 4 + F F Ice parameter 5 + F F Mud parameter 1 + F F Mud parameter 2 + F F Mud parameter 3 + F F Water levels + F F Currents + F F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 19680606 000000 + 19680606 120000 +$ + 1 +$ + 19680606 000000 900 19680606 120000 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT HS ICE DIR EF + 19680606 000000 900 19680606 120000 + 0.00 0. 'Point 1 ' + 1.00E3 0. 'Point 2 ' + 2.00E3 0. 'Point 3 ' + 3.00E3 0. 'Point 4 ' + 4.00E3 0. 'Point 5 ' + 5.00E3 0. 'Point 6 ' + 6.00E3 0. 'Point 7 ' + 7.00E3 0. 'Point 8 ' + 8.00E3 0. 'Point 9 ' + 9.00E3 0. 'Point 10 ' + 10.00E3 0. 'Point 11 ' + 11.00E3 0. 'Point 12 ' + 12.00E3 0. 'Point 13 ' + 13.00E3 0. 'Point 14 ' + 14.00E3 0. 'Point 15 ' + 15.00E3 0. 'Point 16 ' + 0. 0. 'STOPSTRING' + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ constant case: + 'IC1' 19680606 000000 0.2 +$ 'IC1' 19680606 000000 2.00 + 'STP' +$ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M8/ww3_strt.inp b/regtests/ww3_tic1.1/input_IC4_M8/ww3_strt.inp new file mode 100644 index 0000000000..49747e41af --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M8/ww3_strt.inp @@ -0,0 +1,17 @@ +$ WAVEWATCH III Initial conditions input file +$ ------------------------------------------- + 2 +$ 0.1 0.0001 225. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 315. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 240. 2 0. -5.E3 0. 5.E3 1.0 +$ fp sip thm ncos xm six ym siy hmax +$ 0.1 0.0001 270. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 270. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 300. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 135. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 45. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 120. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 60. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ +$ alpha fp thm gamma sigA sigB xm six ym siy + 0.0081 0.1 270.0 1.0 0.07 0.09 0. -5.E3 0. 5.E3 diff --git a/regtests/ww3_tic1.1/input_IC4_M9/namelists_1-D.nml b/regtests/ww3_tic1.1/input_IC4_M9/namelists_1-D.nml new file mode 100644 index 0000000000..3c6dc824df --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/namelists_1-D.nml @@ -0,0 +1,2 @@ +&SIC4 IC4METHOD = 9 / +END OF NAMELISTS diff --git a/regtests/ww3_tic1.1/input_IC4_M9/points.list b/regtests/ww3_tic1.1/input_IC4_M9/points.list new file mode 100644 index 0000000000..e2a0afe3d4 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/points.list @@ -0,0 +1,16 @@ +0.00 0. 'Point 1 ' +1.00E3 0. 'Point 2 ' +2.00E3 0. 'Point 3 ' +3.00E3 0. 'Point 4 ' +4.00E3 0. 'Point 5 ' +5.00E3 0. 'Point 6 ' +6.00E3 0. 'Point 7 ' +7.00E3 0. 'Point 8 ' +8.00E3 0. 'Point 9 ' +9.00E3 0. 'Point 10 ' +10.00E3 0. 'Point 11 ' +11.00E3 0. 'Point 12 ' +12.00E3 0. 'Point 13 ' +13.00E3 0. 'Point 14 ' +14.00E3 0. 'Point 15 ' +15.00E3 0. 'Point 16 ' diff --git a/regtests/ww3_tic1.1/input_IC4_M9/switch b/regtests/ww3_tic1.1/input_IC4_M9/switch new file mode 100644 index 0000000000..31ef85baed --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/switch @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC4 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.inp new file mode 100644 index 0000000000..201517305f --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.inp @@ -0,0 +1,42 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + '1-D parameterized ice test ' +$ +$ 1.1 0.04118 25 24 0.0 + 1.1 0.0418 31 36 5.0 +$ + F T F F F T + 60. 60. 60. 60. +$ +$ IC4METHOD determines calculation +$ IC4METHOD = 1 - Wadhams et al. (1988) +$ IC4METHOD = 2 - Meylan et al. (2014) +$ IC4METHOD = 3 - Kohout & Meylan (2008) in Horvat & Tziperman (2015) +$ IC4METHOD = 4 - Kohout et al. (2014) +$ IC4METHOD = 5 - Simple ki step function +$ IC4METHOD = 6 - Simple ki step function via namelist +$ IC4METHOD = 7 - Doble et al. (GRL 2015) +$ IC4METHOD = 8 - Meylan et al. (2018) ; Liu et al. (2020) +$ IC4METHOD = 9 - RYW (2021) ; Yu et al. (2022) +$ IC4M9 Fit to R21A Chf=2.9 and n=4.5 + &SIC4 IC4METHOD = 9 , IC4CN = 2.9, 4.5/ +END OF NAMELISTS +$ + 'RECT' F 'NONE' + 156 3 + 1.0E3 1.0E3 1. + -1.0E3 -1.0E3 1. +$ dlim dmin file# scale layout# format# formatdescrip filetype# filenm + -0.1 0.1 401 -1.0 1 1 '(....)' 'NAME' '../input_IC1/depth1d.flat' +$ + 10 1 1 '(....)' 'PART' 'input' +$ +$ First grid +$ + 2 2 F +$ + 0 0 F + 0 0 F + 0 0 +$ + 0. 0. 0. 0. 0 diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.nml b/regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.nml new file mode 100644 index 0000000000..0717611553 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_grid.nml @@ -0,0 +1,81 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.0418 + SPECTRUM%NK = 31 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 5.0 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 60. + TIMESTEPS%DTXY = 60. + TIMESTEPS%DTKTH = 60. + TIMESTEPS%DTMIN = 60. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = '1-D parameterized ice test' + GRID%NML = '../input_IC4_M9/namelists_1-D.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'CART' + GRID%CLOS = 'NONE' + GRID%ZLIM = -0.1 + GRID%DMIN = 0.1 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 156 + RECT%NY = 3 + RECT%SX = 1.0E3 + RECT%SY = 1.0E3 + RECT%X0 = -1.0E3 + RECT%Y0 = -1.0E3 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -1.0 + DEPTH%FILENAME = '../input_IC1/depth1d.flat' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 1 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 2 2 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.inp new file mode 100644 index 0000000000..4104d759ea --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.inp @@ -0,0 +1,20 @@ +$ WAVEWATCH III Grid output post-processing (netcdf) +$--------------------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 4 + 0 1 2 + F + ww3. + 4 + 1 999 1 999 3 2 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.nml b/regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.nml new file mode 100644 index 0000000000..46aa758fac --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '19680606 000000' + FIELD%TIMESTRIDE = '3600.' + FIELD%TIMECOUNT = '99' + FIELD%TIMESPLIT = 4 + FIELD%LIST = 'DPT WLV HS DIR' + FIELD%PARTITION = '0 1 2' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IXN = 999 + FILE%IYN = 999 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_outf.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outf.inp new file mode 100644 index 0000000000..2b4c6bca80 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outf.inp @@ -0,0 +1,13 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 0 +$ + 1 999 1 999 1 1 diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_spec.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_spec.inp new file mode 100644 index 0000000000..b500e0ca4d --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_spec.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 120000 3600. 1 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 1 + 2 -1. 0. 33 F diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab50.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab50.inp new file mode 100644 index 0000000000..826bd422d5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab50.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 600. 9999 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 2 + 2 50 diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab51.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab51.inp new file mode 100644 index 0000000000..e54faed463 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_outp_tab51.inp @@ -0,0 +1,10 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 900. 49 +$ +$ 1 + 11 + -1 +$ + 2 + 2 51 diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_prep_icecon.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_prep_icecon.inp new file mode 100644 index 0000000000..26a94221f5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_prep_icecon.inp @@ -0,0 +1,38 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : IC1, IC2, IC3, IC4, IC5 => Ice parameters (5) +$ MDN => Mud densities +$ MTH => Mud thicknesses +$ MVS => Mud viscosities +$ ICE => Ice concentrations. +$ LEV => Water levels. +$ WND => Winds. +$ WNS => Winds (including air-sea temp. dif.) +$ CUR => Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ Header flag : If true, write header on "*.ww3" data file +$ + 'ICE' 'AI' T T +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 000000 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F6.2))' + 2345 '../input_IC2_nondisp/icecon.156x3.txt' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_shel.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_shel.inp new file mode 100644 index 0000000000..c496220ff7 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_shel.inp @@ -0,0 +1,68 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + T T Ice parameter 1 + F F Ice parameter 2 + F F Ice parameter 3 + F F Ice parameter 4 + F F Ice parameter 5 + F F Mud parameter 1 + F F Mud parameter 2 + F F Mud parameter 3 + F F Water levels + F F Currents + F F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 19680606 000000 + 19680606 120000 +$ + 1 +$ + 19680606 000000 900 19680606 120000 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT HS ICE DIR EF + 19680606 000000 900 19680606 120000 + 0.00 0. 'Point 1 ' + 1.00E3 0. 'Point 2 ' + 2.00E3 0. 'Point 3 ' + 3.00E3 0. 'Point 4 ' + 4.00E3 0. 'Point 5 ' + 5.00E3 0. 'Point 6 ' + 6.00E3 0. 'Point 7 ' + 7.00E3 0. 'Point 8 ' + 8.00E3 0. 'Point 9 ' + 9.00E3 0. 'Point 10 ' + 10.00E3 0. 'Point 11 ' + 11.00E3 0. 'Point 12 ' + 12.00E3 0. 'Point 13 ' + 13.00E3 0. 'Point 14 ' + 14.00E3 0. 'Point 15 ' + 15.00E3 0. 'Point 16 ' + 0. 0. 'STOPSTRING' + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ constant case: + 'IC1' 19680606 000000 0.2 +$ 'IC1' 19680606 000000 2.00 + 'STP' +$ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M9/ww3_strt.inp b/regtests/ww3_tic1.1/input_IC4_M9/ww3_strt.inp new file mode 100644 index 0000000000..49747e41af --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M9/ww3_strt.inp @@ -0,0 +1,17 @@ +$ WAVEWATCH III Initial conditions input file +$ ------------------------------------------- + 2 +$ 0.1 0.0001 225. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 315. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 240. 2 0. -5.E3 0. 5.E3 1.0 +$ fp sip thm ncos xm six ym siy hmax +$ 0.1 0.0001 270. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 270. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 300. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 135. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 45. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 120. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 60. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ +$ alpha fp thm gamma sigA sigB xm six ym siy + 0.0081 0.1 270.0 1.0 0.07 0.09 0. -5.E3 0. 5.E3 From ff0358a6a4c34e5c4a18788d5141970b207961cb Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 25 Jan 2024 16:23:51 +0100 Subject: [PATCH 033/136] clean up and add ST4 variables (#1181) --- model/nml/namelists.nml | 555 +++++++++++++++++++++++----------------- 1 file changed, 318 insertions(+), 237 deletions(-) diff --git a/model/nml/namelists.nml b/model/nml/namelists.nml index 390fdb8745..9fb59fe1cf 100644 --- a/model/nml/namelists.nml +++ b/model/nml/namelists.nml @@ -25,51 +25,68 @@ $ Define constants in source terms ----------------------------------- $ $ $ Stresses - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - $ TC 1996 with cap : Namelist FLX3 -$ CDMAX : Maximum allowed CD (cap) -$ CTYPE : Cap type : +$ CDMAX : Maximum allowed CD (cap) +$ CTYPE : Cap type : $ 0: Discontinuous (default). $ 1: Hyperbolic tangent. +$ $ Hwang 2011 : Namelist FLX4 -$ CDFAC : re-scaling of drag +$ CDFAC : re-scaling of drag $ $ Linear input - - - - - - - - - - - - - - - - - - - - - - - - - - - - $ Cavaleri and M-R : Namelist SLN1 -$ CLIN : Proportionality constant. -$ RFPM : Factor for fPM in filter. -$ RFHF : Factor for fh in filter. +$ CLIN : Proportionality constant. +$ RFPM : Factor for fPM in filter. +$ RFHF : Factor for fh in filter. $ $ Exponential input - - - - - - - - - - - - - - - - - - - - - - - - - $ WAM-3 : Namelist SIN1 -$ CINP : Proportionality constant. +$ CINP : Proportionality constant. $ $ Tolman and Chalikov : Namelist SIN2 -$ ZWND : Height of wind (m). +$ ZWND : Height of wind (m). $ SWELLF : swell factor in (n.nn). -$ STABSH, STABOF, CNEG, CPOS, FNEG : -$ c0, ST0, c1, c2 and f1 in . (n.nn) +$ STABSH, STABOF, CNEG, CPOS, FNEG : c0, ST0, c1, c2 and f1 in . (n.nn) $ through (2.65) for definition of $ effective wind speed (!/STAB2). -$ WAM4 and variants : Namelist SIN3 -$ ZWND : Height of wind (m). -$ ALPHA0 : minimum value of Charnock coefficient -$ Z0MAX : maximum value of air-side roughness z0 -$ BETAMAX : maximum value of wind-wave coupling -$ SINTHP : power of cosine in wind input -$ ZALP : wave age shift to account for gustiness -$ TAUWSHELTER : sheltering of short waves to reduce u_star -$ SWELLFPAR : choice of swell attenuation formulation +$ +$ WAM4 and variants : Namelist SIN3 +$ ZWND : Height of wind (m). +$ ALPHA0 : minimum value of Charnock coefficient +$ Z0MAX : maximum value of air-side roughness z0 +$ BETAMAX : maximum value of wind-wave coupling +$ SINTHP : power of cosine in wind input +$ ZALP : wave age shift to account for gustiness +$ SWELLF : swell attenuation factor +$ +$ Janssen / Ardhuin : Namelist SIN4 +$ ZWND : Height of wind (m). +$ ALPHA0 : minimum value of Charnock coefficient +$ Z0MAX : maximum value of air-side roughness z0 +$ BETAMAX : maximum value of wind-wave coupling +$ SINTHP : power of cosine in wind input +$ ZALP : wave age shift to account for gustiness +$ SWELLF : swell attenuation factor +$ TAUWSHELTER : sheltering of short waves to reduce u_star +$ SWELLFPAR : choice of swell attenuation formulation $ (1: TC 1996, 3: ACC 2008) -$ SWELLF : swell attenuation factor -$ Extra parameters for SWELLFPAR=3 only -$ SWELLF2, SWELLF3 : swell attenuation factors -$ SWELLF4 : Threshold Reynolds number for ACC2008 -$ SWELLF5 : Relative viscous decay below threshold -$ Z0RAT : roughness for oscil. flow / mean flow +$ Extra parameters for SWELLFPAR=3 only +$ SWELLF2, SWELLF3 : swell attenuation factors +$ SWELLF4 : Threshold Reynolds number for ACC2008 +$ SWELLF5 : Relative viscous decay below threshold +$ Z0RAT : roughness for oscil. flow / mean flow +$ SINBR : effect of wave breaking on wind input +$ SINTABLE : flag to enable or the table computation +$ SINTAIL1 : tauwshelter for tail (no table) +$ SINTAIL2 : additional peak in capillary range +$ TAUWBUG : Set to 1 to keep bug on TAUW +$ VISCSTRESS : coefficient for viscous part of wind stress +$ $ BYDRZ input : Namelist SIN6 -$ SINA0 : factor for negative input -$ SINWS : wind speed scaling option -$ SINFC : high-frequency extent of the -$ prognostic frequency region +$ SINA0 : factor for negative input +$ SINWS : wind speed scaling option +$ SINFC : high-frequency extent of the +$ prognostic frequency region $ $ Nonlinear interactions - - - - - - - - - - - - - - - - - - - - - - - $ Discrete I.A. : Namelist SNL1 @@ -78,8 +95,7 @@ $ NLPROP : C in sourc term. NOTE : default $ value depends on other source $ terms selected. $ KDCONV : Factor before kd in Eq. (n.nn). -$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : -$ Minimum kd, and constants c1-3 +$ KDMIN, SNLCS1, SNLCS2, SNLCS3 : Minimum kd, and constants c1-3 $ in depth scaling function. $ IQTYPE : Type of depth treatment $ -2 : Deep water GQM with scaling @@ -87,10 +103,11 @@ $ 1 : Deep water DIA $ 2 : Deep water DIA with scaling $ 3 : Shallow water DIA $ TAILNL : Parametric tail power. -$ GQMNF1, GQMNT1, GQMNQ_OM2 : Gaussian quadrature resolution -$ GQMTHRSAT : Threshold on saturation for SNL calculation -$ GQMTHRCOU : Threshold for filter on coupling coefficient -$ GQAMP1, GQAMP2, GQAMP3, GQAMP4 : Amplification factors +$ GQMNF1, GQMNT1, GQMNQ_OM2 : Gaussian quadrature resolution +$ GQMTHRSAT : Threshold on saturation for SNL calculation +$ GQMTHRCOU : Threshold for filter on coupling coefficient +$ GQAMP1, GQAMP2, GQAMP3, GQAMP4 : Amplification factors +$ $ Exact interactions : Namelist SNL2 $ IQTYPE : Type of depth treatment $ 1 : Deep water @@ -100,22 +117,26 @@ $ TAILNL : Parametric tail power. $ NDEPTH : Number of depths in for which $ integration space is established. $ Used for IQTYPE = 3 only +$ $ Namelist ANL2 $ DEPTHS : Array with depths for NDEPTH = 3 +$ $ Gen. Multiple DIA : Namelist SNL3 -$ NQDEF : Number of quadruplets. -$ MSC : Scaling constant 'm'. -$ NSC : Scaling constant 'N'. -$ KDFD : Deep water relative filter depth, -$ KDFS : Shallow water relative filter depth, +$ NQDEF : Number of quadruplets. +$ MSC : Scaling constant 'm'. +$ NSC : Scaling constant 'N'. +$ KDFD : Deep water relative filter depth, +$ KDFS : Shallow water relative filter depth, +$ $ Namelist ANL3 $ QPARMS : 5 x NQDEF paramaters describing the $ quadruplets, repeating LAMBDA, MU, DT12. $ Cdeep and Cshal. See examples below. +$ $ Two Scale Approx. : Namelist SNL4 $ INDTSA : Index for TSA/FBI computations $ (0 = FBI ; 1 = TSA) -$ ALTLP : Index for alternate looping +$ ALTLP : Index for alternate looping $ (1 = no ; 2 = yes) $ $ Traditional DIA setup (default): @@ -141,141 +162,182 @@ $ 0.369, 0.226, 11.5, 0.118E+08, 0.000E+00 / $ $ Nonlinear filter based on DIA - - - - - - - - - - - - - - - - - - - $ Namelist SNLS -$ A34 : Relative offset in quadruplet -$ FHFC : Proportionality constants. -$ DMN : Maximum relative change. -$ FC1-3 : Constants in frequency filter. +$ A34 : Relative offset in quadruplet +$ FHFC : Proportionality constants. +$ DMN : Maximum relative change. +$ FC1-3 : Constants in frequency filter. $ $ Whitecapping dissipation - - - - - - - - - - - - - - - - - - - - - $ WAM-3 : Namelist SDS1 -$ CDIS, APM : As in source term. +$ CDIS, APM : As in source term. $ $ Tolman and Chalikov : Namelist SDS2 -$ SDSA0, SDSA1, SDSA2, SDSB0, SDSB1, PHIMIN : -$ Constants a0, a1, a2, b0, b1 and -$ PHImin. +$ SDSA0,SDSA1,SDSA2,SDSB0,SDSB1 : Constants a0, a1, a2, b0, b1 and +$ PKIMIN : Constants PHImin $ $ WAM4 and variants : Namelist SDS3 -$ SDSC1 : WAM4 Cds coeffient -$ MNMEANP, WNMEANPTAIL : power of wavenumber +$ SDSC1 : WAM4 Cds coeffient +$ MNMEANP, WNMEANPTAIL : power of wavenumber $ for mean definitions in Sds and tail -$ SDSDELTA1, SDSDELTA2 : relative weights +$ SDSDELTA1, SDSDELTA2 : relative weights $ of k and k^2 parts of WAM4 dissipation -$ SDSLF, SDSHF : coefficient for activation of -$ WAM4 dissipation for unsaturated (SDSLF) and -$ saturated (SDSHF) parts of the spectrum -$ SDSC2 : Saturation dissipation coefficient -$ SDSC4 : Value of B0=B/Br for wich Sds is zero -$ SDSBR : Threshold Br for saturation -$ SDSP : power of (B/Br-B0) in Sds -$ SDSBR2 : Threshold Br2 for the separation of -$ WAM4 dissipation in saturated and non-saturated -$ SDSC5 : coefficient for turbulence dissipation -$ SDSC6 : Weight for the istropic part of Sds_SAT -$ SDSDTH: Angular half-width for integration of B +$ SDSLF, SDSHF : coefficient for activation of +$ WAM4 dissipation for unsaturated (SDSLF) and +$ saturated (SDSHF) parts of the spectrum +$ SDSC2 : Saturation dissipation coefficient +$ SDSC4 : Value of B0=B/Br for wich Sds is zero +$ SDSBR : Threshold Br for saturation +$ SDSP : power of (B/Br-B0) in Sds +$ SDSBR2 : Threshold Br2 for the separation of +$ WAM4 dissipation in saturated and non-saturated +$ SDSC5 : coefficient for turbulence dissipation +$ SDSC6 : Weight for the istropic part of Sds_SAT +$ SDSDTH : Angular half-width for integration of B +$ +$ Ardhuin : Namelist SDS4 +$ SDSBCHOICE : 1: Ardhuin et al., 2: Filipot & Ardhuin, 3: Romero +$ WNMEANP, WNMEANPTAIL : power of wavenumber +$ for mean definitions in Sds and tail +$ FXPM3 : Coefficient defining the diagnostic tail +$ FXFM3 : Coefficient defining the diagnostic tail +$ FXFMAGE : This does not do anything as FHIGI is not used in W3SRCE +$ SDSC2 : coefficient in front of dissipation term +$ SDSCUM : coefficient for cumulative breaking term +$ SDSSTRAIN : Straining coefficient +$ SDSSTRAINA : Not used anymore +$ SDSSTRAIN2 : If non-zero, uses a directionally-enhanced straining +$ SDSC4 : Not used anymore +$ SDSFACMTF : MTF factor for Lambda , Romero (2019) +$ SDSNMTF : MTF power +$ SDSCUMP : 2 for cumulative mss, 1 for cumulative orb. vel. +$ SDSC5 : coefficient for wave-turbulence interaction (Ardhuin & Jenkins +$ SDSC6 : delta_d in eq. (13) of Ardhuin et al. (2010) +$ SDSBR : saturation threshold +$ SDSBT : Saturation threshold for dissipation rate b +$ SDSP : power of saturation in diagonal term +$ SDSISO : Not used anymore +$ SDSBCK : Coefficient for Filipot & Ardhuin +$ SDSABK : Coefficient for Filipot & Ardhuin +$ SDSPBK : Coefficient for Filipot & Ardhuin +$ SDSBINT : frequency integration factor for Filipot & Ardhuin +$ SDSHCK : power of tanh(KD) in Filipot & Ardhuin +$ SDSDTH : half-widht of directional integration for Ardhuin saturation +$ SDSCOS : power of coside for saturation +$ SDSBRF1 : ratio of f_high / f for which cumulative term at f has an impact on f_high +$ SDSBRFDF : not used anymore +$ SDSNUW : viscous dissipation term (water side only) : DVISC = - 4 SDSNUW*k**2 +$ SDSBM0 : activates depth correction to Ardhuin et al. , with X = tanhs (kD) +$ SDSBM1 : coefficients of polynomial function to enhance saturation +$ SDSBM2 : based on Fig. 2 in Filipot et et al. (JGR 2010) +$ SDSBM3 : the code is MICHE=(X*(SSDSBM(1)+X*(SSDSBM(2)+X*(SSDSBM(3) +X*SSDSBM(4)))))**2 +$ SDSBM4 : it should be MICHE=(X*(SSDSBM(1)+X*(SSDSBM(2)+X**2*(SSDSBM(3)+X**3*SSDSBM(4)))))**2 +$ CUMSIGP : power of frequency for defining the direction of mean direction used in Romero (default is 0 but not optimal) +$ see Alday and Ardhuin (2023) with CUMSIGP=2 in T701-GQM +$ WHITECAPWIDTH : constant fraction of breaker wavelength +$ WHITECAPDUR : breaking duration factor +$ SDSMWD : new AFo +$ SDSMWPOW : (k)^pow +$ SDKOF : ko factor such that ko= g (SDKOF/(28 us))^2 $ $ BYDRZ : Namelist SDS6 -$ SDSET : Select threshold normalization spectra -$ SDSA1, SDSA2, SDSP1, SDSP2 : -$ Coefficients for dissipation terms T1 and T2 +$ SDSET : Select threshold normalization spectra +$ SDSA1, SDSA2, SDSP1, SDSP2 : Coefficients for dissipation terms T1 and T2 $ : Namelist SWL6 -$ SWLB1 : Coefficient for swell dissipation +$ SWLB1 : Coefficient for swell dissipation $ $ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - $ JONSWAP : Namelist SBT1 -$ GAMMA : Bottom friction emprical constant +$ GAMMA : Bottom friction emprical constant $ $ $ Surf breaking - - - - - - - - - - - - - - - - - - - - - - - - - - - $ Battjes and Janssen : Namelist SDB1 -$ BJALFA : Dissipation constant (default = 1) -$ BJGAM : Breaking threshold (default = 0.73) -$ BJFLAG : TRUE - Use Hmax/d ratio only (default) -$ FALSE - Use Hmax/d in Miche formulation +$ BJALFA : Dissipation constant (default = 1) +$ BJGAM : Breaking threshold (default = 0.73) +$ BJFLAG : TRUE - Use Hmax/d ratio only (default) +$ FALSE - Use Hmax/d in Miche formulation $ $ Dissipation in the ice - - - - - - - - - - - - - - - - - - - - - - $ Generalization of Liu et al. : Namelist SIC2 -$ IC2DISPER : If true uses Liu formulation with eddy viscosity -$ If false, uses the generalization with turbulent -$ to laminar transition -$ IC2TURB : empirical factor for the turbulent part -$ IC2ROUGH : under-ice roughness length -$ IC2REYNOLDS: Re number for laminar to turbulent transition -$ IC2SMOOTH : smoothing of transition reprensenting random waves -$ IC2VISC : empirical factor for viscous part +$ IC2DISPER : If true uses Liu formulation with eddy viscosity +$ If false, uses the generalization with turbulent +$ to laminar transition +$ IC2TURB : empirical factor for the turbulent part +$ IC2ROUGH : under-ice roughness length +$ IC2REYNOLDS : Re number for laminar to turbulent transition +$ IC2SMOOTH : smoothing of transition reprensenting random waves +$ IC2VISC : empirical factor for viscous part $ $ $ Scattering in the ice & creep dissipations- - - - - - - - - - - - - $ Generalization of Wiliams et al. : Namelist SIS2 -$ ISC1 : scattering coefficient (default = 1) -$ IS2BACKSCAT : fraction of energy back-scattered (default = 1 ) -$ IS2BREAK : TRUE - changes floe max diameter -$ : FALSE - does not change floe max diameter -$ IS2C1 : scattering in pack ice -$ IS2C2 : frequency dependance of scattering in pack ice -$ IS2C3 : frequency dependance of scattering in pack ice -$ ISBACKSCAT : fraction of scattered energy actualy redistributed -$ IS2DISP : use of ice-specific dispersion relation (T/F) -$ FRAGILITY : parameter between 0 and 1 that gives the shape of FSD -$ IS2DMIN : minimum floe diameter in meters -$ IS2DAMP : multiplicative coefficient for dissipation term from RP -$ IS2UPDATE : TRUE - updates the max floe diameter with forcing only -$ : FALSE - updates the max floe diameter at each time step +$ ISC1 : scattering coefficient (default = 1) +$ IS2BACKSCAT : fraction of energy back-scattered (default = 1 ) +$ IS2BREAK : TRUE - changes floe max diameter +$ FALSE - does not change floe max diameter +$ IS2C1 : scattering in pack ice +$ IS2C2 : frequency dependance of scattering in pack ice +$ IS2C3 : frequency dependance of scattering in pack ice +$ ISBACKSCAT : fraction of scattered energy actualy redistributed +$ IS2DISP : use of ice-specific dispersion relation (T/F) +$ FRAGILITY : parameter between 0 and 1 that gives the shape of FSD +$ IS2DMIN : minimum floe diameter in meters +$ IS2DAMP : multiplicative coefficient for dissipation term from RP +$ IS2UPDATE : TRUE - updates the max floe diameter with forcing only +$ FALSE - updates the max floe diameter at each time step $ $ Dissipation by sea ice $ Empirical/parametric representations : Namelist SIC4 -$ IC4METHOD : integer 1 to 7 -$ : In most cases, additional input -$ : is required. -$ : See examples in /regtests/ww3_tic1.1/ -$ : See also: 1) description in manual -$ : and 2) inline documentation in -$ w3sic4md.ftn +$ IC4METHOD : integer 1 to 7 +$ In most cases, additional input is required. +$ See examples in /regtests/ww3_tic1.1/ +$ See also: 1) description in manual +$ and 2) inline documentation in w3sic4md.ftn $ $ Triad nonlinear interactions - - - - - - - - - - - - - - - - - - - - $ Lumped Triad Interaction (LTA) : Namelist STR1 (To be implemented) -$ PTRIAD1 : Proportionality coefficient (default 1.) -$ PTRIAD2 : Multiple of Tm01 up to which interaction -$ is computed (2.5) -$ PTRIAD3 : Ursell upper limit for computing -$ interactions (not used, default 10.) -$ PTRIAD4 : Shape parameter for biphase -$ computation (0.2) -$ PTRIAD5 : Ursell number treshold for computing -$ interactions (0.01) +$ PTRIAD1 : Proportionality coefficient (default 1.) +$ PTRIAD2 : Multiple of Tm01 up to which interaction +$ is computed (2.5) +$ PTRIAD3 : Ursell upper limit for computing +$ interactions (not used, default 10.) +$ PTRIAD4 : Shape parameter for biphase +$ computation (0.2) +$ PTRIAD5 : Ursell number treshold for computing +$ interactions (0.01) $ $ Shoreline reflections - - - - - - - - - - - - - - - - - - - - - - - - $ ref. parameters : Namelist REF1 -$ REFCOAST : Reflection coefficient at shoreline -$ REFFREQ : Activation of freq-dependent ref. -$ REFMAP : Scale factor for bottom slope map -$ REFRMAX : maximum ref. coeffient (default 0.8) -$ REFFREQPOW: power of frequency -$ REFICEBERG: Reflection coefficient for icebergs -$ REFSUBGRID: Reflection coefficient for islands -$ REFCOSP_STRAIGHT: power of cosine used for -$ straight shoreline +$ REFCOAST : Reflection coefficient at shoreline +$ REFFREQ : Activation of freq-dependent ref. +$ REFMAP : Scale factor for bottom slope map +$ REFRMAX : maximum ref. coeffient (default 0.8) +$ REFFREQPOW : power of frequency +$ REFICEBERG : Reflection coefficient for icebergs +$ REFSUBGRID : Reflection coefficient for islands +$ REFCOSP_STRAIGHT : power of cosine used for +$ straight shoreline $ $ Bound 2nd order spectrum and free IG - - - - - - - - - - - - - - - - - $ IG1 parameters : Namelist SIG1 -$ IGMETHOD : 1: Hasselmann, 2: Krasitskii-Janssen -$ IGADDOUTP : activation of bound wave correction -$ in ww3_outp / ww3_ounp -$ IGSOURCE : 1: uses bound waves, 2: empirical -$ IGSTERMS : > 0 : no source term in IG band -$ IGMAXFREQ : maximum frequency of IG band -$ IGEMPIRICAL: constant in empirical free IG source -$ IGBCOVERWRITE: T: Replaces IG spectrum, does not add -$ IGSWELLMAX: T: activates free IG sources for all freq. +$ IGMETHOD : 1: Hasselmann, 2: Krasitskii-Janssen +$ IGADDOUTP : activation of bound wave correction +$ in ww3_outp / ww3_ounp +$ IGSOURCE : 1: uses bound waves, 2: empirical +$ IGSTERMS : > 0 : no source term in IG band +$ IGMAXFREQ : maximum frequency of IG band +$ IGEMPIRICAL : constant in empirical free IG source +$ IGBCOVERWRITE : T: Replaces IG spectrum, does not add +$ IGSWELLMAX : T: activates free IG sources for all freq. $ $ $ Propagation schemes ------------------------------------------------ $ $ First order : Namelist PRO1 -$ CFLTM : Maximum CFL number for refraction. +$ CFLTM : Maximum CFL number for refraction. $ $ UQ/UNO with diffusion : Namelist PRO2 -$ CFLTM : Maximum CFL number for refraction. -$ DTIME : Swell age (s) in garden sprinkler +$ CFLTM : Maximum CFL number for refraction. +$ DTIME : Swell age (s) in garden sprinkler $ correction. If 0., all diffusion $ switched off. If small non-zero $ (DEFAULT !!!) only wave growth @@ -284,7 +346,7 @@ $ LATMIN : Maximum latitude used in calc. of $ strength of diffusion for prop. $ $ UQ/UNO with averaging : Namelist PRO3 -$ CFLTM : Maximum CFL number for refraction. +$ CFLTM : Maximum CFL number for refraction. $ WDTHCG : Tuning factor propag. direction. $ WDTHTH : Tuning factor normal direction. $ @@ -294,54 +356,55 @@ $ limitation and the GSE alleviation. $ $ Unstructured grids ------------------------------------------------ $ $ UNST parameters : Namelist UNST -$ UGOBCAUTO : TRUE: OBC points are taken from type 15 elements -$ FALSE: OBC points must be listed in ww3_grid.inp -$ UGOBCDEPTH : Threshold ( < 0) depth for OBC points if UGOBCAUTO is TRUE -$ UGOBCFILE : Reading boundary files from a file -$ EXPFSN : Activation of N scheme (only one of the below 4, True - Active, False - not active) -$ EXPFSPSI : Activation of PSI scheme -$ EXPFSFCT : Activation of FCT scheme -$ IMPFSN : Activation of N implicit scheme -$ EXPTOTAL : Activation of the Block explicit N scheme solver -$ IMPTOTAL : Activation of fully implicit scheme | Non splitting -$ IMPREFRACTION : Turn on implicit freq. shift (only with imptotal) -$ IMPFREQSHIFT : Turn on implicit freq. shift terms (only with imptotal) -$ IMPSOURCE : Turn on implicit source terms (only with imptotal) -$ JGS_TERMINATE_MAXITER : max. Number of iterations -$ JGS_TERMINATE_DIFFERENCE : Terminate based on the total change of the unweightet sum of wave action -$ JGS_TERMINATE_NORM : Terminate based on the norm of the solution -$ JGS_USE_JACOBI : Use Jacobi solver family -$ JGS_BLOCK_GAUSS_SEIDEL : Use Block Gauss Seidel method for imptotal instead of the conservative jacobi iterator. -$ JGS_MAXITER : max. Number of solver iterations -$ JGS_PMIN : % of grid points that do not need to converge during solver iteration. -$ JGS_DIFF_THR : implicit solver threshold for JGS_TERMINATE_DIFFERENCE -$ JGS_NORM_THR : terminate based on the norm of the solution -$ JGS_LIMITER : use total (quasi-steady: limits whole equation) instead of local limiter (un-steady: limits only source terms) -$ JGS_LIMITER_FUNC : 1 - old limiter; 2 - alternatnive limiter -$ SETUP_APPLY_WLV : Compute wave setup (experimental) -$ SOLVERTHR_SETUP : Solver threshold for setup computations -$ CRIT_DEP_SETUP : Critical depths for setup computations +$ UGOBCAUTO : TRUE: OBC points are taken from type 15 elements +$ FALSE: OBC points must be listed in ww3_grid.inp +$ UGOBCDEPTH : Threshold ( < 0) depth for OBC points if UGOBCAUTO is TRUE +$ UGOBCFILE : Reading boundary files from a file +$ EXPFSN : Activation of N scheme (only one of the below 4, True - Active, False - not active) +$ EXPFSPSI : Activation of PSI scheme +$ EXPFSFCT : Activation of FCT scheme +$ IMPFSN : Activation of N implicit scheme +$ EXPTOTAL : Activation of the Block explicit N scheme solver +$ IMPTOTAL : Activation of fully implicit scheme | Non splitting +$ IMPREFRACTION : Turn on implicit freq. shift (only with imptotal) +$ IMPFREQSHIFT : Turn on implicit freq. shift terms (only with imptotal) +$ IMPSOURCE : Turn on implicit source terms (only with imptotal) +$ JGS_TERMINATE_MAXITER : max. Number of iterations +$ JGS_TERMINATE_DIFFERENCE : Terminate based on the total change of the unweightet sum of wave action +$ JGS_TERMINATE_NORM : Terminate based on the norm of the solution +$ JGS_USE_JACOBI : Use Jacobi solver family +$ JGS_BLOCK_GAUSS_SEIDEL : Use Block Gauss Seidel method for imptotal instead of the conservative jacobi iterator. +$ JGS_MAXITER : max. Number of solver iterations +$ JGS_PMIN : % of grid points that do not need to converge during solver iteration. +$ JGS_DIFF_THR : implicit solver threshold for JGS_TERMINATE_DIFFERENCE +$ JGS_NORM_THR : terminate based on the norm of the solution +$ JGS_LIMITER : use total (quasi-steady: limits whole equation) instead of local limiter (un-steady: limits only source terms) +$ JGS_LIMITER_FUNC : 1 - old limiter; 2 - alternatnive limiter +$ SETUP_APPLY_WLV : Compute wave setup (experimental) +$ SOLVERTHR_SETUP : Solver threshold for setup computations +$ CRIT_DEP_SETUP : Critical depths for setup computations $ $ SMC grid propagation : Namelist PSMC and default values -$ CFLTM : Maximum CFL no. for propagation, 0.7 -$ DTIME : Swell age for diffusion term (s), 0.0 +$ CFLTM : Maximum CFL no. for propagation, 0.7 +$ DTIME : Swell age for diffusion term (s), 0.0 $ LATMIN : Maximum latitude (deg) for GCT, 86.0 $ RFMAXD : Maximum refraction turning (deg), 80.0 -$ LvSMC : No. of refinement level, default 1 -$ ISHFT : Shift number of i-index, default 0 -$ JEQT : Shift number of j-index, default 0 +$ LvSMC : No. of refinement level, default 1 +$ ISHFT : Shift number of i-index, default 0 +$ JEQT : Shift number of j-index, default 0 $ NBISMC : No. of input boundary points, 0 -$ UNO3 : Use 3rd order advection scheme, .FALSE. -$ AVERG : Add extra spatial averaging, .FALSE. +$ UNO3 : Use 3rd order advection scheme, .FALSE. +$ AVERG : Add extra spatial averaging, .FALSE. $ SEAWND : Use sea-point only wind input. .FALSE. +$ $ &PSMC DTIME = 39600.0, LATMIN=85.0, RFMAXD = 36.0, LvSMC=3, JEQT=1344 / $ $ Rotated pole ------------------------------------------------------ $ $ Pole parameters : Namelist ROTD -$ PLAT : Rotated pole latitude -$ PLON : Rotated pole longitude -$ UNROT : Logical, un-rotate directions to -$ true north +$ PLAT : Rotated pole latitude +$ PLON : Rotated pole longitude +$ UNROT : Logical, un-rotate directions to +$ true north $ $ Compile switch /RTD required. $ @@ -361,8 +424,8 @@ $ $ Output boundary conditions to rotated pole grids ------------------ $ $ $ Pole parameters : Namelist ROTB -$ BPLAT(1:9) : Pole latitude of each destination grid -$ BPLON(1:9) : Pole longitude of each destination grid +$ BPLAT(1:9) : Pole latitude of each destination grid +$ BPLON(1:9) : Pole longitude of each destination grid $ $ Compile switch /RTD required. $ @@ -386,24 +449,24 @@ $ directional spectrum using, e.g. MEM (Lygre&Krogstad 1986). $ $ Parameters (integers) : Namelist OUTS $ For the frequency spectrum E(f) -$ E3D : <=0: not declared, > 0: declared -$ I1E3D : First frequency index of output (default is 1) -$ I2E3D : Last frequency index of output (default is NK) +$ E3D : <=0: not declared, > 0: declared +$ I1E3D : First frequency index of output (default is 1) +$ I2E3D : Last frequency index of output (default is NK) $ For the mean direction th1m(f), and spread sth1m(f) -$ TH1MF, STH1MF : <=0: not declared, > 0: declared -$ I1TH1MF, I1STH1MF: First frequency index of output (default is 1) -$ I2TH1MF, I2STH1MF: First frequency index of output (default is 1) +$ TH1MF, STH1MF : <=0: not declared, > 0: declared +$ I1TH1MF, I1STH1MF : First frequency index of output (default is 1) +$ I2TH1MF, I2STH1MF : First frequency index of output (default is 1) $ For the mean direction th2m(f), and spread sth2m(f) -$ TH2MF, STH2MF : <=0: not declared, > 0: declared -$ I1TH2MF, I1STH2MF: First frequency index of output (default is 1) -$ I2TH2MF, I2STH2MF: First frequency index of output (default is 1) +$ TH2MF, STH2MF : <=0: not declared, > 0: declared +$ I1TH2MF, I1STH2MF : First frequency index of output (default is 1) +$ I2TH2MF, I2STH2MF : First frequency index of output (default is 1) $ For 2nd order pressure at K=0 (source of microseisms & microbaroms) -$ P2SF : <=0: not declared, > 0: declared +$ P2SF : <=0: not declared, > 0: declared $ I1P2SF : First frequency index of output (default is 1) $ I2P2SF : Last frequency index of output (default is NK) $ For the surface Stokes drift partitions (USP) -$ USSP : First index (default is 1, should always be 1) -$ IUSSP : Last index (must be <= than NK and should be +$ USSP : First index (default is 1, should always be 1) +$ IUSSP : Last index (must be <= than NK and should be $ between 3 and ~10 with the tradeoff $ between accuracy and resources) $ STK_WN : List of wavenumbers (size of IUSSP) @@ -414,11 +477,10 @@ $ a climate model. $ $ Miscellaneous ------------------------------------------------------ $ $ Misc. parameters : Namelist MISC -$ CICE0 : Ice concentration cut-off. -$ CICEN : Ice concentration cut-off. -$ PMOVE : Power p in GSE aleviation for -$ moving grids in Eq. (D.4). -$ XSEED : Xseed in seeding alg. (!/SEED). +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ LICE : Length scale for sea ice damping +$ XSEED : Xseed in seeding alg. (!/SEED). $ FLAGTR : Indicating presence and type of $ subgrid information : $ 0 : No subgrid information. @@ -427,67 +489,86 @@ $ daries between grid points. $ 2 : Transp. at cell centers. $ 3 : Like 1 with cont. ice. $ 4 : Like 2 with cont. ice. -$ TRCKCMPR : Logical variable (T/F). Set to F to -$ disable "compression" of track output. -$ This simplifies post-processing. -$ Default is T and will create track -$ output in the traditional manner -$ (WW3 v3, v4, v5). -$ XP, XR, XFILT -$ Xp, Xr and Xf for the dynamic +$ XP, XR, XFILT : Xp, Xr and Xf for the dynamic $ integration scheme. -$ IHMAX : Number of discrete levels in part. -$ HSPMIN : Minimum Hs in partitioning. -$ WSM : Wind speed multiplier in part. -$ WSC : Cut of wind sea fraction for +$ PMOVE : Power p in GSE aleviation for +$ moving grids in Eq. (D.4). +$ IHM : Number of discrete levels in part. +$ HSPM : Minimum Hs in partitioning. +$ WSM : Wind speed multiplier in part. +$ WSC : Cut of wind sea fraction for $ identifying wind sea in part. -$ FLC : Flag for combining wind seas in +$ FLC : Flag for combining wind seas in $ partitioning. -$ NOSW : Number of partitioned swell fields +$ FMICHE : Constant in Miche limiter. +$ RWNDC : Coefficient for current in relative wind +$ FACBERG : Multiplicative factor for iceberg mask +$ NOSW : Number of partitioned swell fields $ in field output. -$ PTM : Partioning method: +$ GSHIFT : grid offset for multi-grid boundaries +$ WCOR1 : wind correction threshold +$ WCOR2 : wind wind correction factor +$ STDX : Space-Time Extremes X-Length +$ STDY : Space-Time Extremes Y-Length +$ STDT : Space-Time Extremes Duration +$ ICEHMIN : Minimum thickness of sea ice +$ ICEHINIT : Initial value of ice thickness +$ ICEDISP : Flag for use of the ice covered dispertion relation +$ ICESLN : +$ ICEWIND : Scale factor for reduction of wind input by ice concentration +$ ICESNL : +$ ICESDS : +$ ICEHFAC : Scale factor for sea ice thickness +$ ICEHDISP : Minimum thickness of sea ice in the dispersion +$ relation before relaxing the conv. criterion +$ ICEDDISP : +$ ICEFDISP : +$ CALTYPE : Calendar type. The only accepted +$ values are 'standard' (default), +$ '365_day', or '360_day'. +$ TRCKCMPR : Logical variable (T/F). Set to F to +$ disable "compression" of track output. +$ This simplifies post-processing. +$ Default is T and will create track +$ output in the traditional manner +$ (WW3 v3, v4, v5). +$ PTM : Partioning method: $ 1 : Default WW3 $ 2 : Watershedding + wind cutoff $ 3 : Watershedding only $ 4 : Wind speed cutoff only $ 5 : High/Low band cutoff (see PTFC) -$ PTFC : Cutouf frequency for High/Low band +$ PTFC : Cutouf frequency for High/Low band $ partioning (PTM=5). Default = 0.1Hz -$ FMICHE : Constant in Miche limiter. -$ STDX : Space-Time Extremes X-Length -$ STDY : Space-Time Extremes Y-Length -$ STDT : Space-Time Extremes Duration -$ P2SF : ...... -$ CALTYPE: Calendar type. The only accepted -$ values are 'standard' (default), -$ '365_day', or '360_day'. +$ BTBET : The constant used for separating wind sea +$ and swell when we estimate WBT $ $ Diagnostic Sea-state Dependent Stress- - - - - - - - - - - - - - - - - $ Reichl et al. 2014 : Namelist FLD1 -$ TAILTYPE : High Frequency Tail Method -$ 0: Constant value (prescribed) -$ 1: Wind speed dependent -$ (Based on GFDL Hurricane -$ Model Z0 relationship) -$ TAILLEV : Level of high frequency tail -$ (if TAILTYPE==0) -$ Valid choices: -$ Capped min: 0.001, max: 0.02 -$ TAILT1 : Tail transition ratio 1 -$ TAILT1*peak input frequency -$ is the first transition point of -$ the saturation specturm -$ Default is 1.25 -$ TAILT1 : Tail transition ratio 2 -$ TAILT2*peak input frequency -$ is the second transition point of -$ the saturation specturm -$ Default is 3.00 +$ TAILTYPE : High Frequency Tail Method +$ 0: Constant value (prescribed) +$ 1: Wind speed dependent +$ (Based on GFDL Hurricane +$ Model Z0 relationship) +$ TAILLEV : Level of high frequency tail +$ (if TAILTYPE==0) +$ Valid choices: +$ Capped min: 0.001, max: 0.02 +$ TAILT1 : Tail transition ratio 1 +$ TAILT1*peak input frequency +$ is the first transition point of +$ the saturation specturm +$ Default is 1.25 +$ TAILT1 : Tail transition ratio 2 +$ TAILT2*peak input frequency +$ is the second transition point of +$ the saturation specturm +$ Default is 3.00 $ Donelan et al. 2012 : Namelist FLD2 -$ TAILTYPE : See above (FLD1) -$ TAILLEV : See above (FLD1) -$ TAILT1 : See above (FLD1) -$ TAILT2 : See above (FLD1) +$ TAILTYPE : See above (FLD1) +$ TAILLEV : See above (FLD1) +$ TAILT1 : See above (FLD1) +$ TAILT2 : See above (FLD1) $ $ In the 'Out of the box' test setup we run with sub-grid obstacles $ and with continuous ice treatment. From ba5cd68fbb5a5be98e196b51aecda2f4bbb7f7a9 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 5 Feb 2024 13:45:25 -0500 Subject: [PATCH 034/136] w3fld1md.F90: fix divide by zero in CRIT2 parameter (#1184) --- model/src/w3fld1md.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 960fd185af..10b2fce080 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -550,9 +550,13 @@ SUBROUTINE W3FLD1( ASPC, FPI, WNDX,WNDY, ZWND, & TAUDIR=atan2(TAUY, TAUX) ! Note: add another criterion (stress direction) for iteration. CRIT1=(ABS(USTAR-USTRB)*100.0)/((USTAR+USTRB)*0.5) .GT. 0.1 - CRIT2=(ABS(TAUDIR-TAUDIRB)*100.0/(TAUDIR+TAUDIRB)*0.5) .GT. 0.1 + IF ((TAUDIR+TAUDIRB).NE.0.) THEN + CRIT2=(ABS(TAUDIR-TAUDIRB)*100.0/(TAUDIR+TAUDIRB)*0.5) .GT. 0.1 + ELSE + CRIT2=.TRUE. + ENDIF IF (CRIT1 .OR. CRIT2) THEN - ! IF ((ABS(USTAR-USTRB)*100.0)/((USTAR+USTRB)*0.5) .GT. 0.1) THEN + ! IF ((ABS(USTAR-USTRB)*100.0)/((USTAR+USTRB)*0.5) .GT. 0.1) THEN USTRB=USTAR TAUDIRB=TAUDIR CTR=CTR+1 From fd6d559e5dbcea001dec8f138edca90589098c42 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 5 Feb 2024 13:45:48 -0500 Subject: [PATCH 035/136] ww3_prnc.F90: fix out-of-scope grid index write statement (#1185) --- model/src/ww3_prnc.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index e77bbd918c..59747d32ab 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -1059,7 +1059,7 @@ PROGRAM W3PRNC ! Manages the simple closure of the grid ! IF (ICLO.EQ.ICLOSE_NONE) THEN - IF (IX21(IX,1).LT.1.OR.IX21(IX,1).GT.NXI-1) WRITE(NDSO,1042) IX, IY, X, Y + IF (IX21(IX,1).LT.1.OR.IX21(IX,1).GT.NXI-1) WRITE(NDSO,1041) IX, X, Y IX21(IX,1) = MAX ( 1 , MIN(IX21(IX,1),NXI-1) ) IX22(IX,1) = IX21(IX,1) + 1 ELSE @@ -1067,7 +1067,7 @@ PROGRAM W3PRNC IX22(IX,1) = MOD(IX21(IX,1),NXI)+1 END IF IY21(IX,1) = 1 + INT((Y-Y0I)/SYI) - IF (IY21(IX,1).LT.1.OR.IY21(IX,1).GT.NYI-1) WRITE(NDSO,1042) IX, IY, X, Y + IF (IY21(IX,1).LT.1.OR.IY21(IX,1).GT.NYI-1) WRITE(NDSO,1041) IX, X, Y IY21(IX,1) = MAX ( 1 , MIN(IY21(IX,1),NYI-1) ) IY22(IX,1) = IY21(IX,1) + 1 ! @@ -2438,6 +2438,9 @@ PROGRAM W3PRNC ' 2MS2 2MN2 2NK2 MNS2 MSN2 2SM2 3MSN2 ' & ' M4 MS4 MN4 M6 2MS6 2MN6'/) ! +1041 FORMAT (/' *** WAVEWATCH-III WARNING W3PRNC : '/ & + ' GRID POINT ',I6,2F7.2,/ & + ' NOT COVERED BY INPUT GRID.'/) 1042 FORMAT (/' *** WAVEWATCH-III WARNING W3PRNC : '/ & ' GRID POINT ',2I6,2F7.2,/ & ' NOT COVERED BY INPUT GRID.'/) From 6d420257c4e1439fd76f4b0d6185e0e4c46d3199 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Thu, 15 Feb 2024 08:39:18 -0500 Subject: [PATCH 036/136] Bugfix: address potential divide-by-zero in APPENDTAIL (#1188) Co-authored-by: Denise Worthen --- model/src/cmake/src_list.cmake | 2 -- model/src/w3fld1md.F90 | 18 +++++++++++++++--- 2 files changed, 15 insertions(+), 5 deletions(-) diff --git a/model/src/cmake/src_list.cmake b/model/src/cmake/src_list.cmake index a73f3b72b9..d745be388d 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -92,5 +92,3 @@ set(scripnc_src ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_write.f ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_read.f ) - - diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 10b2fce080..fdd5ad2304 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -1120,7 +1120,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) DO K=KA1, KA2-1 AVG=SUM(INSPC(K,:))/MAX(REAL(NTH),1.) DO T=1,NTH - INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG + if (avg /= 0.0) then + INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG + else + inspc(k,t) = 0.0 + end if ENDDO ENDDO !----------------------------------------------------------- @@ -1138,7 +1142,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) ENDDO AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.) DO T=1, NTH - INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG + if (avg /= 0.0) then + INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG + else + inspc(k,t) = 0.0 + end if ENDDO ENDDO DO T=1, NTH @@ -1152,7 +1160,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.)!1./4. DO K=KA3+1, NKT DO T=1, NTH - INSPC(K,T)=NORMSPC(T)*(SAT)/TPI/(WN2(K)**3.0)/AVG + if (avg /= 0.0) then + INSPC(K,T)=NORMSPC(T)*(SAT)/TPI/(WN2(K)**3.0)/AVG + else + inspc(k,t) = 0.0 + end if ENDDO ENDDO DEALLOCATE(ANGLE1) From e085bcfa4e735100dcb5a7185cd3cb655f0673e3 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Fri, 23 Feb 2024 19:06:28 +0000 Subject: [PATCH 037/136] Provide initial drying of cells with depth < ZLIM for SMC grid. (#1192) --- model/src/w3gridmd.F90 | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 977a203ae7..e81c4ea91a 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -678,6 +678,7 @@ MODULE W3GRIDMD #endif ! #ifdef W3_SMC + REAL :: DVSMC REAL :: TRNMX, TRNMY INTEGER, ALLOCATABLE :: NLvCelsk(:), NLvUFcsk(:), NLvVFcsk(:) INTEGER, ALLOCATABLE :: IJKCelin(:,:),IJKUFcin(:,:),IJKVFcin(:,:) @@ -3944,6 +3945,12 @@ SUBROUTINE W3GRID() IF (IDFM.EQ.2) WRITE (NDSO,973) TRIM(RFORM) IF (FROM.EQ.'NAME' .AND. NDSG.NE.NDSI) & WRITE (NDSO,974) TRIM(FNAME) + +#ifdef W3_SMC + !Li Save the depth conversion factor for SMC grid use. JGLi03Nov2023 + DVSMC = VSC +#endif + ! ! 7.e Read bottom depths ! @@ -5065,14 +5072,17 @@ SUBROUTINE W3GRID() CALL EXTCDE(65) END IF - !Li Minimum DMIN depth is used as well for SMC. - ZB(ISEA)= - MAX( DMIN, FLOAT( IJKDep(ISEA) ) ) - MAPFS(IY:IY+JS-1,IX:IX+IK-1) = ISEA - MAPSTA(IY:IY+JS-1,IX:IX+IK-1) = 1 - MAPST2(IY:IY+JS-1,IX:IX+IK-1) = 0 - MAPSF(ISEA,1) = IX - MAPSF(ISEA,2) = IY - MAPSF(ISEA,3) = IY + (IX -1)*NY + !Li Allow land cell to be defined by ZLIM value and only reset + !Li MAPST* land values for sea points. JGLi03Nov2023 + ZB(ISEA) = DVSMC * FLOAT(IJKDep(ISEA)) + IF( ZB(ISEA) .LT. ZLIM ) THEN + MAPSTA(IY:IY+JS-1,IX:IX+IK-1) = 1 + MAPST2(IY:IY+JS-1,IX:IX+IK-1) = 0 + ENDIF + MAPFS(IY:IY+JS-1,IX:IX+IK-1) = ISEA + MAPSF(ISEA,1) = IX + MAPSF(ISEA,2) = IY + MAPSF(ISEA,3) = IY + (IX-1) * NY !Li New variable CLATS to hold cosine latitude at cell centre. !Li Also added CLATIS and CTHG0S for version 4.08. From 156a46dfdc5bba3b9679e3a704197125ecaf6c52 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Mon, 11 Mar 2024 12:57:05 +0000 Subject: [PATCH 038/136] Output OMP threading info to screen when running ww3_shel/ww3_multi compiled with the OMPG switch. Also fixes truncation of build.log when running run_cmake_build. (#1191) * Added screen output showing number of threads when OMP enabled. * update build to get more info in logs (#46) --------- Co-authored-by: Jessica Meixner --- model/src/ww3_multi.F90 | 13 +++++++++++++ model/src/ww3_shel.F90 | 14 ++++++++++++++ regtests/bin/run_cmake_test | 18 +++++++++--------- 3 files changed, 36 insertions(+), 9 deletions(-) diff --git a/model/src/ww3_multi.F90 b/model/src/ww3_multi.F90 index 39a6b5bf3b..e3101b7c2a 100644 --- a/model/src/ww3_multi.F90 +++ b/model/src/ww3_multi.F90 @@ -91,6 +91,9 @@ PROGRAM W3MLTI !/ USE WMMDATMD, ONLY: MDSI, MDSO, MDSS, MDST, MDSE, & NMPROC, IMPROC, NMPSCR, NRGRD, ETIME +#ifdef W3_OMPG + USE OMP_LIB +#endif !/ IMPLICIT NONE ! @@ -144,6 +147,12 @@ PROGRAM W3MLTI #ifdef W3_OMPH IF ( IMPROC .EQ. NMPSCR ) WRITE (*,905) & MPI_THREAD_FUNNELED, THRLEV +#endif + ! +#ifdef W3_OMPG + IF( IMPROC .EQ. NMPSCR ) THEN + WRITE(*,906) omp_get_max_threads() + ENDIF #endif ! !/ ------------------------------------------------------------------- / @@ -210,6 +219,10 @@ PROGRAM W3MLTI 905 FORMAT ( ' Hybrid MPI/OMP thread support level:'/ & ' Requested: ', I2/ & ' Provided: ', I2/ ) +#endif + ! +#ifdef W3_OMPG +906 FORMAT ( ' OMP threading enabled. Number of threads: ', I3 / ) #endif ! 999 FORMAT(//' End of program '/ & diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index ee3464f44b..4bb888b489 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -304,6 +304,10 @@ PROGRAM W3SHEL #endif ! USE W3NMLSHELMD + +#ifdef W3_OMPG + USE OMP_LIB +#endif IMPLICIT NONE ! #ifdef W3_MPI @@ -481,6 +485,7 @@ PROGRAM W3SHEL #ifdef W3_OMPH ENDIF #endif + #ifdef W3_MPI MPI_COMM = MPI_COMM_WORLD #endif @@ -583,6 +588,11 @@ PROGRAM W3SHEL MPI_THREAD_FUNNELED, THRLEV #endif ! +#ifdef W3_OMPG + IF(IAPROC .EQ. NAPOUT) THEN + WRITE(NDSO, 906) omp_get_max_threads() + ENDIF +#endif ! ! 1.b For WAVEWATCH III (See W3INIT) @@ -2737,6 +2747,10 @@ PROGRAM W3SHEL 905 FORMAT ( ' Hybrid MPI/OMP thread support level:'/ & ' Requested: ', I2/ & ' Provided: ', I2/ ) +#endif + ! +#ifdef W3_OMPG +906 FORMAT ( ' OMP threading enabled. Number of threads: ', I3 / ) #endif 920 FORMAT (/' Input fields : '/ & ' --------------------------------------------------') diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index 844f3e23e8..9937450602 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -435,21 +435,21 @@ then echo "Switch file is $path_build/switch with switches:" >> $ofile cat $path_build/switch >> $ofile - cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install > $ofile 2>&1 + cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install >> $ofile 2>&1 rc=$? if [[ $rc -ne 0 ]] ; then echo "Fatal error in cmake." echo "The build log is in $ofile" exit fi - make -j 8 > $ofile 2>&1 + make -j 8 VERBOSE=1 >> $ofile 2>&1 rc=$? if [[ $rc -ne 0 ]] ; then echo "Fatal error in make." echo "The build log is in $ofile" exit fi - make install > $ofile 2>&1 + make install >> $ofile 2>&1 if [[ $rc -ne 0 ]] ; then echo "Fatal error in make install." echo "The build log is in $ofile" @@ -468,20 +468,20 @@ then \cp -f $file_c $path_build/switch echo "Switch file is $path_build/switch with switches:" >> $ofile cat $path_build/switch >> $ofile - cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install > $ofile 2>&1 + cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install >> $ofile 2>&1 rc=$? if [[ $rc -ne 0 ]] ; then echo "Fatal error in cmake." echo "The build log is in $ofile" exit fi - make -j 8 > $ofile 2>&1 + make -j 8 VERBOSE=1 >> $ofile 2>&1 if [[ $rc -ne 0 ]] ; then echo "Fatal error in make." echo "The build log is in $ofile" exit fi - make install > $ofile 2>&1 + make install >> $ofile 2>&1 if [[ $rc -ne 0 ]] ; then echo "Fatal error in make install." echo "The build log is in $ofile" @@ -507,20 +507,20 @@ else fi echo "Switch file is $path_build/switch with switches:" >> $ofile cat $path_build/switch >> $ofile - cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install > $ofile 2>&1 + cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install >> $ofile 2>&1 rc=$? if [[ $rc -ne 0 ]] ; then echo "Fatal error in cmake." echo "The build log is in $ofile" exit fi - make -j 8 > $ofile 2>&1 + make -j 8 VERBOSE=1 >> $ofile 2>&1 if [[ $rc -ne 0 ]] ; then echo "Fatal error in make." echo "The build log is in $ofile" exit fi - make install > $ofile 2>&1 + make install >> $ofile 2>&1 if [[ $rc -ne 0 ]] ; then echo "Fatal error in make install." echo "The build log is in $ofile" From 9d3799f2fd1cf0c366071a6de9c01c9fa3e06ee8 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 12 Mar 2024 09:06:31 -0400 Subject: [PATCH 039/136] update run_cmake_test to catch build errors and exit (#1194) --- regtests/bin/run_cmake_test | 57 ++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 26 deletions(-) diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index 9937450602..07ade5a8ba 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -437,23 +437,24 @@ then cat $path_build/switch >> $ofile cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install >> $ofile 2>&1 rc=$? - if [[ $rc -ne 0 ]] ; then + if (( rc != 0 )); then echo "Fatal error in cmake." - echo "The build log is in $ofile" - exit + echo "The build log is in ${ofile}" + exit ${rc} fi make -j 8 VERBOSE=1 >> $ofile 2>&1 rc=$? - if [[ $rc -ne 0 ]] ; then + if (( rc != 0 )); then echo "Fatal error in make." - echo "The build log is in $ofile" - exit + echo "The build log is in ${ofile}" + exit ${rc} fi make install >> $ofile 2>&1 - if [[ $rc -ne 0 ]] ; then + rc=$? + if (( rc != 0 )); then echo "Fatal error in make install." echo "The build log is in $ofile" - exit + exit ${rc} fi cp $path_build/install/bin/* $path_e/ @@ -470,22 +471,24 @@ then cat $path_build/switch >> $ofile cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install >> $ofile 2>&1 rc=$? - if [[ $rc -ne 0 ]] ; then + if (( rc != 0 )); then echo "Fatal error in cmake." - echo "The build log is in $ofile" - exit + echo "The build log is in ${ofile}" + exit ${rc} fi make -j 8 VERBOSE=1 >> $ofile 2>&1 - if [[ $rc -ne 0 ]] ; then + rc=$? + if (( rc != 0 )); then echo "Fatal error in make." - echo "The build log is in $ofile" - exit + echo "The build log is in ${ofile}" + exit ${rc} fi make install >> $ofile 2>&1 - if [[ $rc -ne 0 ]] ; then + rc=$? + if (( rc != 0 )); then echo "Fatal error in make install." echo "The build log is in $ofile" - exit + exit ${rc} fi path_e=$path_w/exe cp $path_build/install/bin/ww3_shel $path_e/ @@ -509,22 +512,24 @@ else cat $path_build/switch >> $ofile cmake $path_cmake ${CMAKE_OPTIONS} -DSWITCH=$path_build/switch -DCMAKE_INSTALL_PREFIX=install >> $ofile 2>&1 rc=$? - if [[ $rc -ne 0 ]] ; then + if (( rc != 0 )); then echo "Fatal error in cmake." - echo "The build log is in $ofile" - exit + echo "The build log is in ${ofile}" + exit ${rc} fi make -j 8 VERBOSE=1 >> $ofile 2>&1 - if [[ $rc -ne 0 ]] ; then + rc=$? + if (( rc != 0 )); then echo "Fatal error in make." - echo "The build log is in $ofile" - exit + echo "The build log is in ${ofile}" + exit ${rc} fi make install >> $ofile 2>&1 - if [[ $rc -ne 0 ]] ; then - echo "Fatal error in make install." - echo "The build log is in $ofile" - exit + rc=$? + if (( rc != 0 )); then + echo "Fatal error in make." + echo "The build log is in ${ofile}" + exit ${rc} fi cp $path_build/install/bin/* $path_e/ From e064dbf4c873b984e9ef29394282748442da9ca0 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Wed, 13 Mar 2024 20:42:08 +0000 Subject: [PATCH 040/136] Adds 360_day calendar support to ww3_prnc (#1193) --- model/src/w3timemd.F90 | 97 ++++++++++++++++++++++++++++-------------- model/src/ww3_prnc.F90 | 47 +++++++++++++++----- 2 files changed, 101 insertions(+), 43 deletions(-) diff --git a/model/src/w3timemd.F90 b/model/src/w3timemd.F90 index 11376969fb..0041866dbf 100644 --- a/model/src/w3timemd.F90 +++ b/model/src/w3timemd.F90 @@ -6,7 +6,7 @@ MODULE W3TIMEMD !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | - !/ | Last update : 12-Jan-2021 | + !/ | Last update : 23-Feb-2024 | !/ +-----------------------------------+ !/ !/ Copyright 2009 National Weather Service (NWS), @@ -1233,6 +1233,7 @@ SUBROUTINE D2J(DAT,JULIAN,IERR) !/ +-----------------------------------+ !/ !/ 04-Jan-2018 : Origination from m_time library ( version 6.04 ) + !/ 23-Feb-2024 : Updated to handle 360_day calendar ( version 7.14 ) !/ ! 1. Purpose : ! @@ -1251,6 +1252,8 @@ SUBROUTINE D2J(DAT,JULIAN,IERR) ! * There is no year zero ! * Julian Day must be non-negative ! * Julian Day starts at noon; while Civil Calendar date starts at midnight + ! * If CALTYPE is "360_day" a simpler calculation is used (30 days in every + ! month) with a reference date of 1800-01-01. ! ! 3. Parameters : ! @@ -1313,6 +1316,21 @@ SUBROUTINE D2J(DAT,JULIAN,IERR) JULIAN = -HUGE(99999) ! this is the date if an error occurs and IERR is < 0 + ! Special case for 360 day climate calendar; return a pseudo-Julian day + ! Assumes a reference date of 1800-01-01 00:00:00 + IF( CALTYPE .EQ. "360_day" ) THEN + JULIAN = (YEAR - 1800) * 360.0 + & ! Years since 1800 + (MONTH - 1) * 30.0 + & + (DAY - 1) + & + HOUR / 24.0_8 + & + MINUTE / 1440.0_8 + & + SECOND / 86400.0_8 + + IERR = 0 + RETURN + ENDIF + + ! Standard/Gregorian calendar - return standard Julian day calculation: IF(YEAR==0 .or. YEAR .lt. -4713) THEN IERR=-1 RETURN @@ -1356,6 +1374,7 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) !/ +-----------------------------------+ !/ !/ 04-Jan-2018 : Origination from m_time library ( version 6.04 ) + !/ 23-Feb-2024 : Upated to handle 360_day calendar ( version 7.14 ) !/ ! 1. Purpose : ! @@ -1364,6 +1383,8 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) ! * There is no year zero ! * Julian Day must be non-negative ! * Julian Day starts at noon; while Civil Calendar date starts at midnight + ! * If CALTYPE is "360_day" a simpler calculation is used (30 days in every + ! month) with a reference date of 1800-01-01. ! ! 3. Parameters : ! @@ -1397,7 +1418,7 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) DOUBLE PRECISION,INTENT(IN) :: JULIAN ! Julian Day (non-negative, but may be non-integer) INTEGER,INTENT(OUT) :: DAT(8) ! array like returned by DATE_AND_TIME(3f) INTEGER,INTENT(OUT) :: IERR ! Error return, 0 for successful execution - ! Otherwise returnb 1 + ! ! otherwise return 1 !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -1417,27 +1438,31 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) #ifdef W3_S CALL STRACE (IENT, 'J2D') #endif + ! - IF(JULIAN.LT.0.d0) THEN ! Negative Julian Day not allowed + IF(CALTYPE .EQ. 'standard' .AND. JULIAN .LT. 0.d0) THEN + ! Negative Julian Day not allowed IERR=1 RETURN - ELSE - IERR=0 END IF !CALL DATE_AND_TIME(values=TIMEZONE) ! Get the timezone !TZ=TIMEZONE(4) TZ=0 ! Force to UTC timezone + ! Calculation for time (hour,min,sec) same for Julian + ! and 360_day calendars: IJUL=IDINT(JULIAN) ! Integral Julian Day SECOND=SNGL((JULIAN-DBLE(IJUL))*SECDAY) ! Seconds from beginning of Jul. Day SECOND=SECOND+(tz*60) - IF(SECOND.GE.(SECDAY/2.0d0)) THEN ! In next calendar day - IJUL=IJUL+1 - SECOND=SECOND-(SECDAY/2.0d0) ! Adjust from noon to midnight - ELSE ! In same calendar day - SECOND=SECOND+(SECDAY/2.0d0) ! Adjust from noon to midnight + IF(CALTYPE .EQ. "standard") THEN + IF(SECOND.GE.(SECDAY/2.0d0)) THEN ! In next calendar day + IJUL=IJUL+1 + SECOND=SECOND-(SECDAY/2.0d0) ! Adjust from noon to midnight + ELSE ! In same calendar day + SECOND=SECOND+(SECDAY/2.0d0) ! Adjust from noon to midnight + END IF END IF IF(SECOND.GE.SECDAY) THEN ! Final check to prevent time 24:00:00 @@ -1450,31 +1475,38 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) HOUR=MINUTE/60 ! Integral hours from beginning of day MINUTE=MINUTE-HOUR*60 ! Integral minutes from beginning of hour - !--------------------------------------------- - JALPHA=IDINT((DBLE(IJUL-1867216)-0.25d0)/36524.25d0) ! Correction for Gregorian Calendar - JA=IJUL+1+JALPHA-IDINT(0.25d0*DBLE(JALPHA)) - !--------------------------------------------- + IF(CALTYPE .EQ. '360_day') THEN + ! Calculate date parts for 360 day climate calendar + YEAR = INT(JULIAN / 360) + 1800 ! (base year is 1800) + MONTH = MOD(INT(JULIAN / 30), 12) + 1 + DAY = MOD(INT(JULIAN), 30) + 1 + ELSE ! Stardard Julian day calculation + !--------------------------------------------- + JALPHA=IDINT((DBLE(IJUL-1867216)-0.25d0)/36524.25d0) ! Correction for Gregorian Calendar + JA=IJUL+1+JALPHA-IDINT(0.25d0*DBLE(JALPHA)) + !--------------------------------------------- - JB=JA+1524 - JC=IDINT(6680.d0+(DBLE(JB-2439870)-122.1d0)/365.25d0) - JD=365*JC+IDINT(0.25d0*DBLE(JC)) - JE=IDINT(DBLE(JB-JD)/30.6001d0) - DAY=JB-JD-IDINT(30.6001d0*DBLE(JE)) - MONTH=JE-1 + JB=JA+1524 + JC=IDINT(6680.d0+(DBLE(JB-2439870)-122.1d0)/365.25d0) + JD=365*JC+IDINT(0.25d0*DBLE(JC)) + JE=IDINT(DBLE(JB-JD)/30.6001d0) + DAY=JB-JD-IDINT(30.6001d0*DBLE(JE)) + MONTH=JE-1 - IF(MONTH.GT.12) THEN - MONTH=MONTH-12 - END IF - - YEAR=jc-4715 - IF(MONTH.GT.2) THEN - YEAR=YEAR-1 - END IF - - IF(YEAR.LE.0) THEN - YEAR=YEAR-1 - END IF + IF(MONTH.GT.12) THEN + MONTH=MONTH-12 + END IF + YEAR=jc-4715 + IF(MONTH.GT.2) THEN + YEAR=YEAR-1 + END IF + + IF(YEAR.LE.0) THEN + YEAR=YEAR-1 + END IF + ENDIF + DAT(1)=YEAR DAT(2)=MONTH DAT(3)=DAY @@ -1487,7 +1519,6 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) ! RETURN !/ - !/ End of J2D ----------------------------------------------------- / !/ END SUBROUTINE J2D diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index 59747d32ab..e107a1f431 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -766,6 +766,9 @@ PROGRAM W3PRNC CALL STME21 ( TIMESTOP , IDTIME ) IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2931) IDTIME END IF + IF(CALTYPE .NE. 'standard') THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2932) CALTYPE + ENDIF END IF IF (.NOT. FLTIME) THEN CALL STME21 ( TIMESHIFT , IDTIME ) @@ -797,11 +800,26 @@ PROGRAM W3PRNC CALL CHECK_ERR(IRET) IRET=NF90_GET_ATT(NCID,VARIDTMP,"calendar",CALENDAR) IF ( IRET/=NF90_NOERR ) THEN + ! No calendar attribute - default to "standard" WRITE(NDSE,1028) - ELSE IF ((INDEX(CALENDAR, "standard").EQ.0) .AND. & - (INDEX(CALENDAR, "gregorian").EQ.0)) THEN - WRITE(NDSE,1029) + CALENDAR = "standard" + ELSE IF ((INDEX(CALENDAR, "standard") .GT. 0) .OR. & + (INDEX(CALENDAR, "gregorian") .GT. 0)) THEN + CALENDAR = "standard" + ELSE IF (INDEX(CALENDAR, "360_day") .GT. 0) THEN + CALENDAR = "360_day" + ELSE + ! Calendar attribute set, but not a recognised calendar. + WRITE(NDSE,1029) CALENDAR + CALL EXTCDE( 25 ) END IF + + ! Check input calendar compatible with expected calendar + IF(CALENDAR .NE. CALTYPE) THEN + WRITE(NDSE,1027) CALTYPE, CALENDAR + CALL EXTCDE( 26 ) + ENDIF + IRET=NF90_GET_ATT(NCID,VARIDTMP,"units",TIMEUNITS) CALL CHECK_ERR(IRET) CALL U2D(TIMEUNITS,REFDATE,IERR) @@ -821,7 +839,7 @@ PROGRAM W3PRNC END DO IRET=NF90_GET_ATT(NCID,VARIDF(I),"_FillValue", FILLVALUE) IF ( IRET/=NF90_NOERR ) THEN - WRITE(NDSE,1027) TRIM(FIELDSNAME(I)) + WRITE(NDSE,1026) TRIM(FIELDSNAME(I)) CALL EXTCDE ( 27 ) END IF END DO @@ -2317,6 +2335,7 @@ PROGRAM W3PRNC 2930 FORMAT ( ' Field corrected for energy conservation.') 1931 FORMAT ( ' Start time : ',A) 2931 FORMAT ( ' Stop time : ',A) +2932 FORMAT ( ' Calendar : ',A) 3931 FORMAT ( ' Shifted time : ',A) 932 FORMAT (/' Input grid dim. :',I9,3X,I5) 1933 FORMAT ( ' Longitude range :',2F8.2,' (deg)'/ & @@ -2404,15 +2423,23 @@ PROGRAM W3PRNC 1011 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & ' NO GRID SELECTED'/) ! -1027 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & +1026 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & ' _FillValue ATTRIBUTE NOT DEFINED FOR : ',A/) - ! + ! +1027 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & + ' INCOMPATIBLE CALENDARS:' / & + ' MODEL CALENDAR : ', A / & + ' INPUT FILE CALENDAR : ', A /) 1028 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ & ' calendar ATTRIBUTE NOT DEFINED'/ & - ' IT MUST RESPECT STANDARD OR GREGORIAN CALENDAR') -1029 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ & - ' CALENDAR ATTRIBUTE NOT MATCH'/ & - ' IT MUST RESPECT STANDARD OR GREGORIAN CALENDAR') + ' DEFAULTING TO "standard" CALENDAR'/ & + ' INPUT FILE MUST RESPECT STANDARD/GREGORIAN CALENDAR') +1029 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & + ' UNKNOWN CALENDAR TYPE: ', A / & + ' "calendar" ATTRIBUTE MUST BE ONE OF: '/ & + ' - standard'/ & + ' - gregorian'/ & + ' - 360_day'/ ) 1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & ' ILLEGAL FIELD ID -->',A,'<--'/) 1031 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & From f66b6d46ad8204a74ad4112ef39d5a230525f8c8 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Wed, 13 Mar 2024 17:10:44 -0400 Subject: [PATCH 041/136] Fix compiler build 'remark's (#1201) --- model/src/w3arrymd.F90 | 6 +++--- model/src/w3gridmd.F90 | 2 +- model/src/w3tidemd.F90 | 4 ++-- model/src/ww3_outf.F90 | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/model/src/w3arrymd.F90 b/model/src/w3arrymd.F90 index 600e6f0149..845d6ccae5 100644 --- a/model/src/w3arrymd.F90 +++ b/model/src/w3arrymd.F90 @@ -2250,10 +2250,10 @@ SUBROUTINE PRT2DS (NDS, NFR0, NFR, NTH, E, FR, UFR, FACSP, FSC, & ! 900 FORMAT (/' Location : ',A/ & ' Spectrum : ',A,' (Normalized) ', & - ' Maximum value : ',E8.3,1X,A/) + ' Maximum value : ',E10.3,1X,A/) 901 FORMAT (/' Location : ',A/ & - ' Spectrum : ',A,' Units : ',E8.3,1X,A, & - ' Maximum value : ',E8.3,1X,A/) + ' Spectrum : ',A,' Units : ',E10.3,1X,A, & + ' Maximum value : ',E10.3,1X,A/) ! 910 FORMAT (5X,' ang.| frequencies (Hz) '/ & 5X,' deg.|',F6.3,15F8.3) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index e81c4ea91a..fe60c1e357 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -6439,7 +6439,7 @@ SUBROUTINE W3GRID() ' SDSBRF1 = ',F5.2,', SDSBRFDF =',I2,', '/ & ' SDSBM0 = ',F5.2, ', SDSBM1 =',F5.2, & ', SDSBM2 =',F5.2,', SDSBM3 =',F5.2,', SDSBM4 =', & - F5.2,', '/, & + F7.2,', '/, & ' SPMSS = ',F5.2, ', SDKOF =',F5.2, & ', SDSMWD =',F5.2,', SDSFACMTF =',F5.1,', '/ & ' SDSMWPOW =',F3.1,', SDSNMTF =', F5.2, & diff --git a/model/src/w3tidemd.F90 b/model/src/w3tidemd.F90 index 4f58afd4b2..00b7b047da 100644 --- a/model/src/w3tidemd.F90 +++ b/model/src/w3tidemd.F90 @@ -823,11 +823,11 @@ SUBROUTINE TIDE_READ_ANAPAR(KR1,LP,filename,KD1,KD2,XLON,XLAT,NDEF,ITREND,ITZ) ! read in inference information now as it will be used in the lsq matrix ! DO K=1,10 - READ(KR1,'(4X,A5,E16.10,i5)')TIDE_KONAN(K),TIDE_SIGAN(K),TIDE_NINF(k) + READ(KR1,'(4X,A5,E17.10,i5)')TIDE_KONAN(K),TIDE_SIGAN(K),TIDE_NINF(k) ! write(6,1010)TIDE_KONAN(K),TIDE_SIGAN(K),TIDE_NINF(k) IF (TIDE_KONAN(K).EQ.KBLANK) EXIT do k2=1,TIDE_NINF(k) - read(kr1,'(4X,A5,E16.10,2F10.3)') TIDE_KONIN(K,k2),TIDE_SIGIN(K,k2),TIDE_R(K,k2),TIDE_ZETA(K,k2) + read(kr1,'(4X,A5,E17.10,2F10.3)') TIDE_KONIN(K,k2),TIDE_SIGIN(K,k2),TIDE_R(K,k2),TIDE_ZETA(K,k2) END DO END DO TIDE_NIN=K-1 diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index 96f2751c81..e955f00ad1 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -2433,7 +2433,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & IOSTAT=IERR) IF (FSC.LT.1E-4) THEN - WRITE(FSCS,'(G7.1)') FSC + WRITE(FSCS,'(G8.1)') FSC ELSE WRITE(FSCS,'(F7.4)') FSC END IF From 399df7843b3fdba1f766a2eb9142e4b77a2c30f9 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 2 Apr 2024 12:37:55 -0400 Subject: [PATCH 042/136] For NCEP regtests, add option for gnu compiler and new machine Hercules (#1145) --- model/src/wminitmd.F90 | 6 ++ regtests/bin/matrix_cmake_ncep | 108 +++++++++++++++++++++++++-------- 2 files changed, 88 insertions(+), 26 deletions(-) diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 956490b5e2..768b6d91eb 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -1273,6 +1273,12 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF (WORDS(6) .EQ. 'T') THEN CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) READ (MDSI,*,END=2001,ERR=2002)(ODAT(I,1),I=5*(8-1)+1,5*8) + ELSE + ODAT(5*(8-1)+1,1)=0 + ODAT(5*(8-1)+2,1)=0 + ODAT(5*(8-1)+3,1)=0 + ODAT(5*(8-1)+4,1)=0 + ODAT(5*8,1)=0 END IF ELSE READ (MDSI,*,END=2001,ERR=2002)(ODAT(I,1),I=5*(J-1)+1,5*J) diff --git a/regtests/bin/matrix_cmake_ncep b/regtests/bin/matrix_cmake_ncep index 7d0d26bec8..2eafd89869 100755 --- a/regtests/bin/matrix_cmake_ncep +++ b/regtests/bin/matrix_cmake_ncep @@ -22,28 +22,37 @@ usage () { cat 2>&1 << EOF - Usage: $myname model_dir + Usage: $myname model_dir compiler Required: model_dir : path to model dir of WW3 source + Optional: + compiler : intel (default) or gnu EOF } - # Get required arguments if [ ! $# = 0 ] then main_dir="$1" ; shift + if [ ! $# = 0 ] + then + compiler="$1"; shift + else + compiler='intel' + fi else usage exit 1 fi + + # Convert main_dir to absolute path main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" # Module Versions from spack-stack that are common for all platforms modnetcdfc='netcdf-c/4.9.2' - modnetcdff='netcdf-fortran/4.6.0' + modnetcdff='netcdf-fortran/4.6.1' modjasper='jasper/2.0.32' modzlib='zlib/1.2.13' modpng='libpng/1.6.37' @@ -51,30 +60,71 @@ EOF modbacio='bacio/2.4.1' modg2='g2/3.4.5' modw3emc='w3emc/2.10.0' - modesmf='esmf/8.4.2' + modesmf='esmf/8.5.0' modscotch='scotch/7.0.4' # Set batchq queue, choose modules and other custom variables to fit system and # to define headers etc (default to original version if empty) ishera=`hostname | grep hfe` isorion=`hostname | grep Orion` + ishercules=`hostname | grep hercules` if [ $ishera ] then - # If no other h, assuming Hera batchq='slurm' - spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.5.0/envs/unified-env-noavx512/install/modulefiles/Core' - modcomp='stack-intel/2021.5.0' - modmpi='stack-intel-oneapi-mpi/2021.5.1' - metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/spack-stack/1.5.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + if [ $compiler = "intel" ] + then + spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.6.0/envs/unified-env-rocky8/install/modulefiles/Core' + modcomp='stack-intel/2021.5.0' + modmpi='stack-intel-oneapi-mpi/2021.5.1' + metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hera/intel/spack-stack/1.6.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' + elif [ $compiler = "gnu" ] + then + spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.6.0/envs/unified-env-rocky8/install/modulefiles/Core' + modcomp='stack-gcc/9.2.0' + modmpi='stack-openmpi/4.1.5' + metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hera/gnu/spack-stack/1.6.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' + else + echo "Compiler $compiler not supported on hera" + exit 1 + fi elif [ $isorion ] then + if [ $compiler = "intel" ] + then + batchq='slurm' + spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' + modcomp='stack-intel/2022.0.2' + modmpi='stack-intel-oneapi-mpi/2021.5.1' + metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/orion/intel/spack-stack/1.6.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' + else + echo "Compiler $compiler not supported on orion" + exit 1 + fi + elif [ $ishercules ] + then batchq='slurm' - spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.5.0/envs/unified-env/install/modulefiles/Core' - modcomp='stack-intel/2022.0.2' - modmpi='stack-intel-oneapi-mpi/2021.5.1' - metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/spack-stack/1.5.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + if [ $compiler = "intel" ] + then + spackstackpath='/work/noaa/epic/role-epic/spack-stack/hercules/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' + modcomp='stack-intel/2021.9.0' + modmpi='stack-intel-oneapi-mpi/2021.9.0' + metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/hercules/intel/spack-stack/1.6.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' + elif [ $compiler = "gnu" ] + then + spackstackpath='/work/noaa/epic/role-epic/spack-stack/hercules/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' + spackstackpath2='/work/noaa/epic/role-epic/spack-stack/hercules/modulefiles' + modcomp='stack-gcc/12.2.0' + modmpi='stack-mvapich2/2.3.7' + metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/hercules/gnu/spack-stack/1.6.0/parmetis-4.0.3/install' + modcmake='cmake/3.23.1' + else + echo "Compiler $compiler not supported on hercules" + exit 1 + fi else batchq= fi @@ -105,10 +155,19 @@ EOF echo '#SBATCH --exclusive' >> matrix.head echo ' ' >> matrix.head echo 'ulimit -s unlimited' >> matrix.head - echo 'ulimit -c 0' >> matrix.head - echo 'export KMP_STACKSIZE=2G' >> matrix.head - echo 'export FI_OFI_RXM_BUFFER_SIZE=128000' >> matrix.head - echo 'export FI_OFI_RXM_RX_SIZE=64000' >> matrix.head + elif [ $batchq = "slurm" ] && [ $ishercules ] + then + echo "#SBATCH -n ${np}" >> matrix.head + echo "##SBATCH --cpus-per-task=${nth}" >> matrix.head + echo '#SBATCH -q batch' >> matrix.head + echo '#SBATCH -t 08:00:00' >> matrix.head + echo '#SBATCH -A marine-cpu' >> matrix.head + echo '#SBATCH -J ww3_regtest' >> matrix.head + echo '#SBATCH -o matrix.out' >> matrix.head + echo '#SBATCH -p hercules' >> matrix.head + echo '#SBATCH --exclusive' >> matrix.head + echo ' ' >> matrix.head + echo 'ulimit -s unlimited' >> matrix.head elif [ $batchq = "slurm" ] then echo "#SBATCH -n ${np}" >> matrix.head @@ -133,13 +192,10 @@ EOF # Netcdf, Parmetis and SCOTCH modules & variables echo " module purge" >> matrix.head - if [ ! -z $basemodcomp ]; then - echo " module load $basemodcomp" >> matrix.head - fi - if [ ! -z $basemodmpi ]; then - echo " module load $basemodmpi" >> matrix.head - fi - echo " module use $spackstackpath" >> matrix.head + echo " module use $spackstackpath" >> matrix.head + if [ ! -z $spackstackpath2 ]; then + echo " module use $spackstackpath2" >> matrix.head + fi echo " module load $modcomp" >> matrix.head echo " module load $modmpi" >> matrix.head echo " module load $modcmake" >> matrix.head From d8b82c96806590d14b7a70872cbee3d83b974d66 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 2 Apr 2024 13:47:39 -0400 Subject: [PATCH 043/136] Fix compiler remarks for ST6 and GMD (#1206) --- model/src/w3gridmd.F90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index fe60c1e357..dad11eddc5 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -6330,14 +6330,14 @@ SUBROUTINE W3GRID() 2923 FORMAT ( ' ',2F8.3,F6.1,2E12.4) 2922 FORMAT ( ' &SNL3 NQDEF =',I3,', MSC =',F6.2,', NSC =', & F6.2,', KDFD =',F6.2,', KDFS =',F6.2,' /') -3923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E10.4, & - ', ',E10.4,' /') -4923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E10.4, & - ', ',E10.4,' ,') -5923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E10.4, & - ', ',E10.4,' ,') -6923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E10.4, & - ', ',E10.4,' /') +3923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E11.4, & + ', ',E11.4,' /') +4923 FORMAT ( ' &ANL3 QPARMS = ',2(F5.3,', '),F5.1,', ',E11.4, & + ', ',E11.4,' ,') +5923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E11.4, & + ', ',E11.4,' ,') +6923 FORMAT ( ' ',2(F5.3,', '),F5.1,', ',E11.4, & + ', ',E11.4,' /') #endif ! #ifdef W3_NL4 @@ -6453,18 +6453,18 @@ SUBROUTINE W3GRID() 925 FORMAT ( ' normalise by threshold spectral density : ',A/& ' normalise by spectral density : ',A/& ' coefficient and exponent for '/ & - ' inherent breaking term a1, L as in (21) : ',E9.3,I3/ & - ' cumulative breaking term a2, M as in (22) : ',E9.3,I3/ & + ' inherent breaking term a1, L as in (21) : ',E10.3,I3/ & + ' cumulative breaking term a2, M as in (22) : ',E10.3,I3/ & ' ') -2924 FORMAT ( ' &SDS6 SDSET = ',L,', SDSA1 = ',E9.3, & - ', SDSA2 = ',E9.3,', SDSP1 = ',I2,', SDSP1 = ', & +2924 FORMAT ( ' &SDS6 SDSET = ',L,', SDSA1 = ',E10.3, & + ', SDSA2 = ',E10.3,', SDSP1 = ',I2,', SDSP1 = ', & I2,' /' ) 937 FORMAT (/' Swell dissipation ',A/ & ' --------------------------------------------------') 940 FORMAT ( ' subroutine W3SWL6 activated : ',A/ & - ' coefficient b1 ',A, ' : ',E9.3/ ) -2937 FORMAT ( ' &SWL6 SWLB1 = ',E9.3,', CSTB1 = ',L,' /') + ' coefficient b1 ',A, ' : ',E10.3/ ) +2937 FORMAT ( ' &SWL6 SWLB1 = ',E10.3,', CSTB1 = ',L,' /') #endif ! #ifdef W3_BT0 @@ -6549,7 +6549,7 @@ SUBROUTINE W3GRID() 946 FORMAT (' Isotropic (linear function of ice concentration)'/& ' slope : ',E10.3/ & ' offset : ',E10.3) -2946 FORMAT ( ' &SIS1 ISC1 =',E9.3,', ISC2 =',E9.3) +2946 FORMAT ( ' &SIS1 ISC1 =',E10.3,', ISC2 =',E10.3) #endif #ifdef W3_IS2 947 FORMAT (/' Ice scattering ',A,/ & From 8b5e91f0887ab2b8c218228fff6cb82297a613b3 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 4 Apr 2024 21:34:11 +0200 Subject: [PATCH 044/136] add output parameters for skewness (#1209) Co-authored-by: Fabrice Ardhuin --- manual/eqs/output.tex | 4 + manual/manual.bib | 10 + model/inp/ww3_ounf.inp | 2 +- model/inp/ww3_shel.inp | 11 +- model/nml/ww3_ounf.nml | 2 +- model/nml/ww3_shel.nml | 3 + model/src/w3adatmd.F90 | 42 +- model/src/w3initmd.F90 | 86 ++++- model/src/w3iogomd.F90 | 556 ++++++++++++++++++++++++++- model/src/w3odatmd.F90 | 5 +- model/src/w3ounfmetamd.F90 | 39 ++ model/src/ww3_ounf.F90 | 15 +- model/src/ww3_outf.F90 | 34 ++ model/tools/bash/ww3_ounf_inp2nml.sh | 2 +- model/tools/bash/ww3_shel_inp2nml.sh | 3 + regtests/ww3_ts1/input/ww3_ounf.inp | 2 +- regtests/ww3_ts1/input/ww3_ounf.nml | 2 +- regtests/ww3_ts1/input/ww3_shel.inp | 2 +- regtests/ww3_ts1/input/ww3_shel.nml | 2 +- 19 files changed, 800 insertions(+), 22 deletions(-) diff --git a/manual/eqs/output.tex b/manual/eqs/output.tex index bfa7e0b5a3..8deb484e10 100644 --- a/manual/eqs/output.tex +++ b/manual/eqs/output.tex @@ -310,6 +310,10 @@ \subsection{~Output parameters} \label{sub:outpars} \begin{equation} Q_{kk} = \frac{1}{E^2} \int_0^{f_{NK}} \int_0^{2\pi} 0.5 \left[ A(k,\theta)+ A(k,\theta+\pi)\right]^2 \frac{\sigma^2}{k C_g} \:\rd \theta \: \rd \sigma \: \label{eq:qkk} \end{equation} +\item \textbf{SKW} Skewness of surface elevation sampled at zero slope. This is the $\lambda_1$ parameter defined in \cite{Barrick&Lipa1985} or $\lambda_{3,0,0}$ in \cite{Srokosz1986}. It is computed from the second order correction to the surface elevation, using ECWAM code by P. Janssen. +\item \textbf{EMB} this is $-\gamma/8 = -(\lambda_{1,2,0}+\lambda_{1,0,2}-2 \lambda{0,1,1} \lambda{1,1,1})/8 (1-\lambda_{0,1,1]^2)$, such that the mean sea level of points with zero slope +is EMB$\times H_s$. +\item \textbf{EMC} this is hte additional tracker bias coefficient equal to $-\lambda_{3,0,0}/24$, which is specific to the choice of retracker, see the $J_z$ function in \cite{DeCarlo&Ardhuin2024}. \end{list} \item{Numerical diagnostics } diff --git a/manual/manual.bib b/manual/manual.bib index 3da650ea21..33e0a9fdd5 100644 --- a/manual/manual.bib +++ b/manual/manual.bib @@ -3760,3 +3760,13 @@ @PHDTHESIS{Gagnaire-Renou2009 year = 2010, } +@ARTICLE{Srokosz1986, + author = "Meric A. Srokosz", + title = "On the joint distribution of surface elevation and slopes for a non linear random sea, with an application to radar altimetry", + journal = JGR, + volume = 91, + pages = "995--1006", + year = 1986, + keywords={altimeter;sea state bias}, +} + diff --git a/model/inp/ww3_ounf.inp b/model/inp/ww3_ounf.inp index 7bde30754b..b0c29ff752 100644 --- a/model/inp/ww3_ounf.inp +++ b/model/inp/ww3_ounf.inp @@ -16,7 +16,7 @@ $ DPT CUR WND AST WLV ICE IBG TAU RHO D50 IC1 IC5 HS LM T02 T0M1 T01 FP $ DIR SPR DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS PDP $ PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR UST CHA CGE FAW TAW TWA WCC $ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED -$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 WNM TOC +$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 WNM TOC MSS QP QKK SKW EMB EMC $ N DPT HS FP T01 diff --git a/model/inp/ww3_shel.inp b/model/inp/ww3_shel.inp index 7980cbe060..576e01c5f9 100644 --- a/model/inp/ww3_shel.inp +++ b/model/inp/ww3_shel.inp @@ -212,10 +212,13 @@ $ 8 Spectrum parameters $ ------------------------------------------------- $ F F 8 1 MSS[X,Y] MSS Mean square slopes $ F F 8 2 MSC[X,Y] MSC Spectral level at high frequency tail -! F F 8 3 MSSD MSD Slope direction -! F F 8 4 MSCD MCD Tail slope direction -! F F 8 5 QP QP Goda peakedness parameter -! F F 8 6 QKK QKK Wavenumber peakedness +$ F F 8 3 MSSD MSD Slope direction +$ F F 8 4 MSCD MCD Tail slope direction +$ F F 8 5 QP QP Goda peakedness parameter +$ F F 8 6 QKK QKK Wavenumber peakedness +$ F F 8 7 SKEW SKW Skewness of elevation for zero slopes +$ F F 8 8 EMBIA1 EMB Mean sea level at zero slopes / Hs +$ F F 8 9 EMBIA2 EMC Tracker bias for LRM least square altimetry $ ------------------------------------------------- $ 9 Numerical diagnostics $ ------------------------------------------------- diff --git a/model/nml/ww3_ounf.nml b/model/nml/ww3_ounf.nml index 9b1ffe1362..a70cf9eae3 100644 --- a/model/nml/ww3_ounf.nml +++ b/model/nml/ww3_ounf.nml @@ -14,7 +14,7 @@ ! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS ! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC TOC ! ABR UBR BED FBB TBB -! MSS MSC WL02 AXT AYT AXY +! MSS MSC MSD MCD QP QKK SKW EMB EMC ! DTD FC CFX CFD CFK ! U1 U2 ! diff --git a/model/nml/ww3_shel.nml b/model/nml/ww3_shel.nml index 97beaf6a0b..b6ae8cfef2 100644 --- a/model/nml/ww3_shel.nml +++ b/model/nml/ww3_shel.nml @@ -206,6 +206,9 @@ ! F F 8 4 MSCD MCD Tail slope direction ! F F 8 5 QP QP Goda peakedness parameter ! F F 8 6 QKK QKK Wavenumber peakedness +! F F 8 7 SKEW SKW Skewness of elevation for zero slopes +! F F 8 8 EMBIA1 EMB Mean sea level at zero slopes / Hs +! F F 8 9 EMBIA2 EMC Tracker bias for LRM least square altimetry ! ------------------------------------------------- ! 9 Numerical diagnostics ! ------------------------------------------------- diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 1ee07eca46..2daee3609b 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -188,6 +188,7 @@ MODULE W3ADATMD ! MSCD R.A. Public Direction of MSCX ! QP R.A. Public Goda peakedness parameter. ! QKK R.A. Public Spectral bandwidth (De Carlo et al. 2023) + ! SKEW R.A. Public skewness lambda_3,0,0 (Srokosz 1986) ! ! DTDYN R.A. Public Mean dynamic time step (raw). ! FCUT R.A. Public Cut-off frequency for tail. @@ -475,9 +476,10 @@ MODULE W3ADATMD ! Output fields group 8) ! REAL, POINTER :: MSSX(:), MSSY(:), MSSD(:), & - MSCX(:), MSCY(:), MSCD(:), QKK(:) + MSCX(:), MSCY(:), MSCD(:), QKK(:), SKEW(:), EMBIA1(:), EMBIA2(:) REAL, POINTER :: XMSSX(:), XMSSY(:), XMSSD(:), & - XMSCX(:), XMSCY(:), XMSCD(:), XQKK(:) + XMSCX(:), XMSCY(:), XMSCD(:), XQKK(:), & + XSKEW(:), XEMBIA1(:), XEMBIA2(:) ! ! Output fields group 9) ! @@ -613,7 +615,7 @@ MODULE W3ADATMD BEDFORMS(:,:), PHIBBL(:), TAUBBL(:,:) ! REAL, POINTER :: MSSX(:), MSSY(:), MSSD(:), & - MSCX(:), MSCY(:), MSCD(:), QKK(:) + MSCX(:), MSCY(:), MSCD(:), QKK(:), SKEW(:), EMBIA1(:), EMBIA2(:) ! REAL, POINTER :: DTDYN(:), FCUT(:), CFLXYMAX(:), & CFLTHMAX(:), CFLKMAX(:) @@ -1265,7 +1267,9 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ALLOCATE ( WADATS(IMOD)%MSSX(NSEALM), WADATS(IMOD)%MSSY(NSEALM), & WADATS(IMOD)%MSCX(NSEALM), WADATS(IMOD)%MSCY(NSEALM), & WADATS(IMOD)%MSSD(NSEALM), WADATS(IMOD)%MSCD(NSEALM), & - WADATS(IMOD)%QKK(NSEALM), STAT=ISTAT ) + WADATS(IMOD)%QKK(NSEALM), WADATS(IMOD)%SKEW(NSEALM), & + WADATS(IMOD)%EMBIA1(NSEALM), WADATS(IMOD)%EMBIA2(NSEALM), & + STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! WADATS(IMOD)%MSSX = UNDEF @@ -1275,6 +1279,9 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%MSCY = UNDEF WADATS(IMOD)%MSCD = UNDEF WADATS(IMOD)%QKK = UNDEF + WADATS(IMOD)%SKEW = UNDEF + WADATS(IMOD)%EMBIA1 = UNDEF + WADATS(IMOD)%EMBIA2 = UNDEF call print_memcheck(memunit, 'memcheck_____:'//' W3DIMA 8') ! ! 9) Numerical diagnostics @@ -2281,6 +2288,24 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) ALLOCATE ( WADATS(IMOD)%XQKK(1) ) END IF ! + IF ( OUTFLAGS( 8, 7) ) THEN + ALLOCATE ( WADATS(IMOD)%XSKEW(NXXX) ) + ELSE + ALLOCATE ( WADATS(IMOD)%XSKEW(1) ) + END IF + ! + IF ( OUTFLAGS( 8, 8) ) THEN + ALLOCATE ( WADATS(IMOD)%XEMBIA1(NXXX) ) + ELSE + ALLOCATE ( WADATS(IMOD)%XEMBIA1(1) ) + END IF + ! + IF ( OUTFLAGS( 8, 9) ) THEN + ALLOCATE ( WADATS(IMOD)%XEMBIA2(NXXX) ) + ELSE + ALLOCATE ( WADATS(IMOD)%XEMBIA2(1) ) + END IF + ! WADATS(IMOD)%XMSSX = UNDEF WADATS(IMOD)%XMSSY = UNDEF WADATS(IMOD)%XMSSD = UNDEF @@ -2289,6 +2314,9 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) WADATS(IMOD)%XMSCD = UNDEF WADATS(IMOD)%XQP(1) = UNDEF WADATS(IMOD)%XQKK = UNDEF + WADATS(IMOD)%XSKEW = UNDEF + WADATS(IMOD)%XEMBIA1 = UNDEF + WADATS(IMOD)%XEMBIA2 = UNDEF ! IF ( OUTFLAGS( 9, 1) ) THEN ALLOCATE ( WADATS(IMOD)%XDTDYN(NXXX), STAT=ISTAT ) @@ -2903,6 +2931,9 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) MSCY => WADATS(IMOD)%MSCY MSCD => WADATS(IMOD)%MSCD QKK => WADATS(IMOD)%QKK + SKEW => WADATS(IMOD)%SKEW + EMBIA1 => WADATS(IMOD)%EMBIA1 + EMBIA2 => WADATS(IMOD)%EMBIA2 ! DTDYN => WADATS(IMOD)%DTDYN FCUT => WADATS(IMOD)%FCUT @@ -3242,6 +3273,9 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) MSCY => WADATS(IMOD)%XMSCY MSCD => WADATS(IMOD)%XMSCD QKK => WADATS(IMOD)%XQKK + SKEW => WADATS(IMOD)%XSKEW + EMBIA1 => WADATS(IMOD)%XEMBIA1 + EMBIA2 => WADATS(IMOD)%XEMBIA2 ! DTDYN => WADATS(IMOD)%XDTDYN FCUT => WADATS(IMOD)%XFCUT diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 93218d473e..044a18760c 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -2150,7 +2150,7 @@ SUBROUTINE W3MPIO ( IMOD ) STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, & HCMAXD, QP, PTHP0, PQP, PPE, PGW, PSW, & PTM1, PT1, PT2, PEP, WBT, CX, CY, & - TAUOCX, TAUOCY, WNMEAN, QKK + TAUOCX, TAUOCY, WNMEAN, QKK, SKEW, EMBIA1, EMBIA2 #endif #ifdef W3_MPI @@ -3406,6 +3406,48 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/06', IROOT, IT, IRQGO(IH), IERR #endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI + IF ( FLGRDALL( 8, 7) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_SEND_INIT (SKEW (1),NSEALM , MPI_REAL, IROOT, & + IT, MPI_COMM_WAVE, IRQGO(IH), IERR) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/07', IROOT, IT, IRQGO(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI + IF ( FLGRDALL( 8, 8) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_SEND_INIT (EMBIA1 (1),NSEALM , MPI_REAL, IROOT, & + IT, MPI_COMM_WAVE, IRQGO(IH), IERR) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/08', IROOT, IT, IRQGO(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI + IF ( FLGRDALL( 8, 9) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_SEND_INIT (EMBIA2 (1),NSEALM , MPI_REAL, IROOT, & + IT, MPI_COMM_WAVE, IRQGO(IH), IERR) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/09', IROOT, IT, IRQGO(IH), IERR +#endif #ifdef W3_MPI END IF #endif @@ -4653,6 +4695,48 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/06', IFROM, IT, IRQGO2(IH), IERR #endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI + IF ( FLGRDALL( 8, 7) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (SKEW (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/07', IFROM, IT, IRQGO2(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI + IF ( FLGRDALL( 8, 8) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (EMBIA1 (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/08', IFROM, IT, IRQGO2(IH), IERR +#endif +#ifdef W3_MPI + END IF +#endif + ! +#ifdef W3_MPI + IF ( FLGRDALL( 8, 9) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (EMBIA2 (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) +#endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 8/09', IFROM, IT, IRQGO2(IH), IERR +#endif #ifdef W3_MPI END IF #endif diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 2ddfa77e0c..de660ded47 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -18,7 +18,7 @@ MODULE W3IOGOMD !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | - !/ | Last update : 22-Mar-2021 | + !/ | Last update : 02-Mar-2024 | !/ +-----------------------------------+ !/ !/ 04-Jan-2001 : Origination. ( version 2.00 ) @@ -74,8 +74,9 @@ MODULE W3IOGOMD !/ 22-Mar-2021 : Add extra coupling fields as output ( version 7.13 ) !/ 21-Jul-2022 : Correct FP0 calc for peak energy in ( version 7.14 ) !/ min/max freq band (B. Pouliot, CMC) + !/ 02-Mar-2024 : Add skweness and EM bias varaible ( version 7.xx ) !/ - !/ Copyright 2009-2014 National Weather Service (NWS), + !/ Copyright 2009-2024 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. @@ -1126,6 +1127,15 @@ SUBROUTINE W3FLDTOIJ(FLD, I, J, IAPROC, NAPOUT, NDSEN) CASE('QKK') I = 8 J = 6 + CASE('SKW') + I = 8 + J = 7 + CASE('EMB') + I = 8 + J = 8 + CASE('EMC') + I = 8 + J = 9 ! ! Group 9 ! @@ -2340,6 +2350,11 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) IF (FLOLOC( 6, 12)) THEN CALL CALC_U3STOKES(A,2) ENDIF + ! + IF (FLOLOC( 8, 7).OR.FLOLOC( 8, 8).OR.FLOLOC( 8, 9)) THEN + CALL SKEWNESS(A) + END IF + ! ! Dominant wave breaking probability ! @@ -2417,6 +2432,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & !/ processing code) !/ 25-Aug-2018 : Add WBT parameter ( version 6.06 ) !/ 22-Mar-2021 : Add extra coupling fields as output ( version 7.13 ) + !/ 07-Mar-2024 : Add Skewness parameters ( version 7.13 ) !/ ! 1. Purpose : ! @@ -2513,7 +2529,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & CFLXYMAX, CFLTHMAX, CFLKMAX, P2SMS, US3D, & TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, TAUICE,& STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& - USSP, TAUOCX, TAUOCY, QKK + USSP, TAUOCX, TAUOCY, QKK, SKEW, EMBIA1, EMBIA2 !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & @@ -2923,6 +2939,9 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & IF ( FLOGRD( 8, 4) ) MSCD (ISEA) = UNDEF IF ( FLOGRD( 8, 5) ) QP (ISEA) = UNDEF IF ( FLOGRD( 8, 6) ) QKK (ISEA) = UNDEF + IF ( FLOGRD( 8, 7) ) SKEW (ISEA) = UNDEF + IF ( FLOGRD( 8, 8) ) EMBIA1(ISEA) = UNDEF + IF ( FLOGRD( 8, 9) ) EMBIA2(ISEA) = UNDEF ! IF ( FLOGRD( 9, 1) ) DTDYN (ISEA) = UNDEF IF ( FLOGRD( 9, 2) ) FCUT (ISEA) = UNDEF @@ -3576,7 +3595,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & #endif ! ! Section 8) - ! + !Skewness ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN WRITE ( NDSOG ) MSSX(1:NSEA) #ifdef W3_ASCII @@ -3614,6 +3633,21 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & WRITE ( NDSOG ) QKK(1:NSEA) #ifdef W3_ASCII WRITE ( NDSOA,* ) 'QKK:', QKK(1:NSEA) +#endif + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN + WRITE ( NDSOG ) SKEW(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'SKW:', SKEW(1:NSEA) +#endif + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN + WRITE ( NDSOG ) EMBIA1(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'EMB:', EMBIA1(1:NSEA) +#endif + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN + WRITE ( NDSOG ) EMBIA2(1:NSEA) +#ifdef W3_ASCII + WRITE ( NDSOA,* ) 'EMC:', EMBIA2(1:NSEA) #endif ! ! Section 9) @@ -3967,6 +4001,12 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QP(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QKK(1:NSEA) + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) SKEW(1:NSEA) + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) EMBIA1(1:NSEA) + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) EMBIA2(1:NSEA) ! ! Section 9) ! @@ -4610,4 +4650,512 @@ SUBROUTINE CALC_WBT (A) !/ END SUBROUTINE CALC_WBT !/ ------------------------------------------------------------------- / + !/ + !> + !> @brief Computation of second order harmonics and + !> relevant tables for the altimeter corrections + !> + !> @param[in] NKHF Extended number of frequencies. + !> @param[out] FAC0 2nd order coef correction. + !> @param[out] FAC1 2nd order coef correction. + !> @param[out] FAC2 2nd order coef correction. + !> @param[out] FAC3 2nd order coef correction. + !> + !> @author P. Janssen @date 29-Mar-2024 + !> + SUBROUTINE SECONDHH(NKHF,FAC0,FAC1,FAC2,FAC3) +!---------------------------------------------------------------- + +!**** *SECONDHH* - COMPUTATION OF SECOND ORDER HARMONICS AND +! RELEVANT TABLES FOR THE ALTIMETER CORRECTIONS. + +! P.A.E.M. JANSSEN + +! PURPOSE. +! --------- + +! COMPUTE SECOND HARMONICS + +!** INTERFACE. +! ---------- + +! *CALL* *SECONDHH* + +! METHOD. +! ------- + +! SEE REFERENCE. + +! EXTERNALS. +! ---------- + +! VMIN_D +! VPLUS_D + +! REFERENCES. +! ----------- + +! V E ZAKHAROV(1967) + +!------------------------------------------------------------------- + +!------------------------------------------------------------------- +USE CONSTANTS, ONLY: GRAV, TPI +USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, TH, DTH, ECOS, ESIN + IMPLICIT NONE + ! REAL(KIND=4) :: VMIN_D,VPLUS_D + + + + INTEGER, INTENT(IN) :: NKHF + REAL(KIND=4), DIMENSION(NTH,NTH,NKHF,NKHF), INTENT(OUT) :: FAC0, FAC1, FAC2, FAC3 + REAL(KIND=4), PARAMETER :: FRATIO = 1.1 + + + INTEGER :: M, K1, M1, K2, M2 + + REAL(KIND=4), PARAMETER :: DEL1=1.0E-8 + REAL(KIND=4), PARAMETER :: ZCONST = 0.0281349 + + !REAL(KIND=4) :: VMIN_D, VPLUS_D + REAL(KIND=4) :: CO1 + REAL(KIND=4) :: XK1, XK1SQ, XK2, XK2SQ, XK3 + REAL(KIND=4) :: COSDIFF + REAL(KIND=4) :: X12, X13, X32, OM1, OM2, OM3, F1, F2, F3 + REAL(KIND=4) :: VM, VP + REAL(KIND=4) :: DELOM1, DELOM2 + REAL(KIND=4) :: DELOM321, DELOM312 + REAL(KIND=4) :: C22, S22 + + REAL(KIND=4), DIMENSION(NTH,NTH,NKHF,NKHF) :: B + REAL(KIND=4), DIMENSION(:), ALLOCATABLE:: FAK, SIGHF, DFIMHF + + + + +!----------------------------------------------------------------------- + + + + +!* 1. INITIALISE RELEVANT QUANTITIES. + + ALLOCATE(FAK(NKHF)) + ALLOCATE(SIGHF(NKHF)) + ALLOCATE(DFIMHF(NKHF)) + + SIGHF(1) = SIG(1) + DO M=2,NKHF + SIGHF(M) = XFR*SIGHF(M-1) + ENDDO + + DO M=1,NKHF + FAK(M) = (SIGHF(M))**2/GRAV + ENDDO + + CO1 = 0.5*(XFR-1.)*DTH + DFIMHF(1) = CO1*SIGHF(1) + DO M=2,NKHF-1 + DFIMHF(M)=CO1*(SIGHF(M)+SIGHF(M-1)) + ENDDO + DFIMHF(NKHF)=CO1*SIGHF(NKHF-1) + + DO M2=1,NKHF + XK2 = FAK(M2) + XK2SQ = FAK(M2)**2 + DO M1=1,NKHF + XK1 = FAK(M1) + XK1SQ = FAK(M1)**2 + DO K1=1,NTH + DO K2=1,NTH + COSDIFF = COS(TH(K1)-TH(K2)) + X12 = XK1*XK2*COSDIFF + XK3 = XK1SQ + XK2SQ +2.0*X12 +DEL1 + XK3 = SQRT(XK3) + X13 = XK1SQ+X12 + X32 = X12+XK2SQ + OM1 = SQRT(GRAV*XK1) + OM2 = SQRT(GRAV*XK2) + OM3 = SQRT(GRAV*XK3) + F1 = SQRT(XK1/(2.0*OM1)) + F2 = SQRT(XK2/(2.0*OM2)) + F3 = SQRT(XK3/(2.0*OM3)) + VM = TPI*VMIN_D(XK3,XK1,XK2,X13,X32,X12,OM3,OM1,OM2) + VP = TPI*VPLUS_D(-XK3,XK1,XK2,-X13,-X32,X12,OM3,OM1,OM2) + DELOM1 = OM3-OM1-OM2+DEL1 + DELOM2 = OM3+OM1+OM2+DEL1 + FAC0(K1,K2,M1,M2) = -F3/(F1*F2)*(VM/(DELOM1)+ & + & VP/(DELOM2)) + ENDDO + ENDDO + ENDDO + ENDDO + + DO M2=1,NKHF + XK2 = FAK(M2) + XK2SQ = FAK(M2)**2 + DO M1=1,NKHF + XK1 = FAK(M1) + XK1SQ = FAK(M1)**2 + DO K1=1,NTH + DO K2=1,NTH + COSDIFF = COS(TH(K1)-TH(K2)) + X12 = XK1*XK2*COSDIFF + XK3 = XK1SQ + XK2SQ - 2.*X12 + DEL1 + XK3 = SQRT(XK3) + X13 = XK1SQ-X12 + X32 = X12-XK2SQ + OM1 = SQRT(GRAV*XK1) + OM2 = SQRT(GRAV*XK2) + OM3 = SQRT(GRAV*XK3)+DEL1 + F1 = SQRT(XK1/(2.0*OM1)) + F2 = SQRT(XK2/(2.0*OM2)) + F3 = SQRT(ABS(XK3)/(2.0*OM3)) + VM = TPI*VMIN_D(XK1,XK3,XK2,X13,X12,X32,OM1,OM3,OM2) + VP = TPI*VMIN_D(XK2,-XK3,XK1,-X32,X12,-X13,OM2,OM3,OM1) + DELOM321 = OM3+OM2-OM1+DEL1 + DELOM312 = OM3+OM1-OM2+DEL1 + B(K1,K2,M1,M2) = -F3/(F1*F2)*(VM/(DELOM321)+ & + & VP/(DELOM312)) + ENDDO + ENDDO + ENDDO + ENDDO + + DO M2=1,NKHF + XK2SQ = FAK(M2)**2 + DO M1=1,NKHF + XK1SQ = FAK(M1)**2 + DO K2=1,NTH + DO K1=1,NTH + C22 = FAC0(K1,K2,M1,M2)+B(K1,K2,M1,M2) + S22 = B(K1,K2,M1,M2)-FAC0(K1,K2,M1,M2) + FAC1(K1,K2,M1,M2) = & + & (XK1SQ*ECOS(K1)**2 + XK2SQ*ECOS(K2)**2)*C22 & + & -FAK(M1)*FAK(M2)*ECOS(K1)*ECOS(K2)*S22 + FAC2(K1,K2,M1,M2) = & + & (XK1SQ*ESIN(K1)**2 + XK2SQ*ESIN(K2)**2)*C22 & + & -FAK(M1)*FAK(M2)*ESIN(K1)*ESIN(K2)*S22 + FAC3(K1,K2,M1,M2) = & + & (XK1SQ*ESIN(K1)*ECOS(K1) + & + & XK2SQ*ESIN(K2)*ECOS(K2))*C22 & + & -FAK(M1)*FAK(M2)*ECOS(K1)*ESIN(K2)*S22 + FAC0(K1,K2,M1,M2) = C22 + ENDDO + ENDDO + ENDDO + ENDDO + + + CONTAINS + +!----------------------------------------------------------------------- + + REAL(KIND=4) FUNCTION VMIN_D(XI,XJ,XK,XIJ,XIK,XJK,XOI,XOJ,XOK) + +! PETER JANSSEN + +! PURPOSE. +! -------- + +! GIVES NONLINEAR TRANSFER COEFFICIENT FOR THREE +! WAVE INTERACTIONS OF DEEP-WATER WAVES IN THE +! IDEAL CASE OF NO CURRENT. (CF.ZAKHAROV) + +! INTERFACE. +! ---------- +! *VMIN_D(XI,XJ,XK)* +! *XI* - WAVE NUMBER +! *XJ* - WAVE NUMBER +! *XK* - WAVE NUMBER +! METHOD. +! ------- +! NONE + +! EXTERNALS. +! ---------- +! NONE. + + +!*** 1. DETERMINE NONLINEAR TRANSFER. +! -------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: XI, XJ, XK, XIJ, XIK, XJK, XOI, XOJ, XOK + REAL :: RI, RJ, RK, OI, OJ, OK, SQIJK, SQIKJ, SQJKI + + RI=ABS(XI)+DEL1 + RJ=ABS(XJ)+DEL1 + RK=ABS(XK)+DEL1 + OI=XOI+DEL1 + OJ=XOJ+DEL1 + OK=XOK+DEL1 + SQIJK=SQRT(OI*OJ*RK/(OK*RI*RJ)) + SQIKJ=SQRT(OI*OK*RJ/(OJ*RI*RK)) + SQJKI=SQRT(OJ*OK*RI/(OI*RJ*RK)) + VMIN_D=ZCONST*( (XIJ-RI*RJ)*SQIJK + (XIK-RI*RK)*SQIKJ & + & + (XJK+RJ*RK)*SQJKI ) + + END FUNCTION VMIN_D + +!----------------------------------------------------------------------- + + REAL(KIND=4) FUNCTION VPLUS_D(XI,XJ,XK,XIJ,XIK,XJK,XOI,XOJ,XOK) + +!*** *VPLUS_D* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR THREE +! WAVE INTERACTIONS OF DEEP-WATER WAVES. + +! PETER JANSSEN + +! PURPOSE. +! -------- + +! GIVES NONLINEAR TRANSFER COEFFICIENT FOR THREE +! WAVE INTERACTIONS OF GRAVITY-CAPILLARY WAVES IN THE +! IDEAL CASE OF NO CURRENT. (CF.ZAKHAROV) + +! INTERFACE. +! ---------- +! *VPLUS_D(XI,XJ,XK)* +! *XI* - WAVE NUMBER +! *XJ* - WAVE NUMBER +! *XK* - WAVE NUMBER +! METHOD. +! ------- +! NONE + +! EXTERNALS. +! ---------- +! NONE. + + + +!*** 1. DETERMINE NONLINEAR TRANSFER. +! -------------------------------- + + IMPLICIT NONE + REAL, INTENT(IN) :: XI, XJ, XK, XIJ, XIK, XJK, XOI, XOJ, XOK + REAL :: RI, RJ, RK, OI, OJ, OK, SQIJK, SQIKJ, SQJKI + + RI=ABS(XI)+DEL1 + RJ=ABS(XJ)+DEL1 + RK=ABS(XK)+DEL1 + OI=XOI+DEL1 + OJ=XOJ+DEL1 + OK=XOK+DEL1 + SQIJK=SQRT(OI*OJ*RK/(OK*RI*RJ)) + SQIKJ=SQRT(OI*OK*RJ/(OJ*RI*RK)) + SQJKI=SQRT(OJ*OK*RI/(OI*RJ*RK)) + VPLUS_D=ZCONST*( (XIJ+RI*RJ)*SQIJK + (XIK+RI*RK)*SQIKJ & + & + (XJK+RJ*RK)*SQJKI ) + + END FUNCTION VPLUS_D +! ----------------------------------------------------------------- + + END SUBROUTINE SECONDHH + !/ ------------------------------------------------------------------- / + !/ + !> + !> @brief Determines skewness paramters in order to obtain + !> correction on altimeter wave height + !> + !> @details Evaluate deviations from gaussianity following the work + !> of Srokosz and Longuet-Higgins. For second order + !> corrections to surface elevation, the approach of + !> Zaharov has been used. + !> + !> @param[in] NKHF Extended number of frequencies. + !> @param[out] FAC0 2nd order coef correction. + !> @param[out] FAC1 2nd order coef correction. + !> @param[out] FAC2 2nd order coef correction. + !> @param[out] FAC3 2nd order coef correction. + !> + !> @author P. Janssen @date 29-Mar-2024 + !> + SUBROUTINE SKEWNESS(A) + +!-------------------------------------------------------------------- + +!*****SKEWNESS** COMPUTES PARAMETERS OF THE NEARLY-GAUSSIAN +! DISTRIBUTION OF OCEAN WAVES AT A FIXED GRID POINT. + +! P.JANSSEN JULY 1997 + +! PURPOSE +! ------- +! DETERMINES SKEWNESS PARAMETERS IN ORDER TO OBTAIN +! CORRECTION ON ALTIMETER WAVE HEIGHT. + +! INTERFACE +! --------- +! *CALL* *SKEWNESS(IU06,F1,NCOLL,XKAPPA1,DELH_ALT)* + + + +! METHOD +! ------ +! EVALUATE DEVIATIONS FROM GAUSSIANITY FOLLOWING THE WORK +! OF SROKOSZ AND LONGUET-HIGGINS. FOR SECOND ORDER +! CORRECTIONS TO SURFACE ELEVATION THE APPROACH OF +! ZAKHAROV HAS BEEN USED. + +! EXTERNALS +! --------- +! NONE + +! REFERENCES +! ---------- +! M.A. SROKOSZ, J.G.R.,91,995-1006(1986) +! V.E. ZAKHAROV, HAMILTONIAN APPROACH(1967) +!-------------------------------------------------------------------- + + + +!-------------------------------------------------------------------- +! *TH* REAL DIRECTIONS IN RADIANS. +USE CONSTANTS, ONLY: GRAV, TPI, TPIINV +USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, DTH, ECOS, ESIN, NSEAL +USE W3PARALL, ONLY: INIT_GET_ISEA +USE W3ADATMD, ONLY: CG, SKEW, EMBIA1, EMBIA2 + + + IMPLICIT NONE + + REAL, INTENT(IN) :: A(NTH,NK,0:NSEAL) + + INTEGER :: NKHF + REAL(KIND=4), DIMENSION(:,:,:,:) , ALLOCATABLE:: FAC0,FAC1,FAC2,FAC3 + + INTEGER :: M, K, M1, K1, M2, K2, I, J + INTEGER :: MSTART, JSEA + + REAL(KIND=4) :: CONX, DELTA + REAL(KIND=4) :: FH, DELF, XK1 + REAL(KIND=4) :: XPI, XPJ, XPK, XN, XFAC, CO1 + REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: F2 + REAL(KIND=4), DIMENSION(0:3,0:2,0:2) :: XMU, XLAMBDA + REAL(KIND=4), DIMENSION(:) , ALLOCATABLE:: SIGHF, DFIMHF, FAK + +! ---------------------------------------------------------------------- + + NKHF=NK+13 ! same offset as in ECWAM + + ALLOCATE(FAC0(NTH,NTH,NKHF,NKHF)) + ALLOCATE(FAC1(NTH,NTH,NKHF,NKHF)) + ALLOCATE(FAC2(NTH,NTH,NKHF,NKHF)) + ALLOCATE(FAC3(NTH,NTH,NKHF,NKHF)) + + CALL SECONDHH(NKHF,FAC0,FAC1,FAC2,FAC3) + + ALLOCATE(F2(NTH,NKHF)) + ALLOCATE(SIGHF(NKHF), DFIMHF(NKHF), FAK(NKHF)) + +! 1. COMPUTATION OF FREQUENCY-DIRECTION INCREMENT +! ----------------------------------------------- + + MSTART = 1 + + +#ifdef W3_OMPG + !$OMP PARALLEL DO PRIVATE(JSEA) +#endif + DO JSEA=1, NSEAL + XMU(:,:,:) = 0.0 + DO K=1,NTH + DO M=1,NK + CONX = TPIINV / SIG(M) * CG(M,JSEA) + F2(K,M)=A(K,M,JSEA)/ CONX + END DO + END DO + + SIGHF(1) = SIG(1) + DO M=2,NKHF + SIGHF(M) = XFR*SIGHF(M-1) + ENDDO + + CO1 = 0.5*(XFR-1.)*DTH*TPIINV + DFIMHF(1) = CO1*SIGHF(1) ! this is DF*DTH + DO M=2,NKHF-1 + DFIMHF(M)=CO1*(SIGHF(M)+SIGHF(M-1)) + ENDDO + DFIMHF(NKHF)=CO1*SIGHF(NKHF-1) + + DO M=1,NKHF + FAK(M) = (SIGHF(M))**2/GRAV + ENDDO + +! Deals with the tail ... + DO M=NK+1,NKHF + FH=(SIGHF(NK)/SIGHF(M))**5 + DO K=1,NTH + F2(K,M)=F2(K,NK)*FH + ENDDO + ENDDO + +! 2. COMPUTATION OF THE SKEWNESS COEFFICIENTS +! -------------------------------------------- + + DO M1=MSTART,NKHF + DO M2=MSTART,NKHF + DO K1=1,NTH + DO K2=1,NTH + DELF = DFIMHF(M1)*DFIMHF(M2)*F2( K1,M1)*F2(K2,M2) + XMU(3,0,0) = XMU(3,0,0)+3.0*FAC0(K1,K2,M1,M2)*DELF + XMU(1,2,0) = XMU(1,2,0)+FAC1(K1,K2,M1,M2)*DELF + XMU(1,0,2) = XMU(1,0,2)+FAC2(K1,K2,M1,M2)*DELF + XMU(1,1,1) = XMU(1,1,1)+FAC3(K1,K2,M1,M2)*DELF + ENDDO + ENDDO + ENDDO + ENDDO + + DO K1=1,NTH + DO M1=MSTART,NKHF + XK1 = FAK(M1)**2 + DELF = DFIMHF(M1)*F2(K1,M1) + XMU(2,0,0) = XMU(2,0,0) + DELF + XMU(0,2,0) = XMU(0,2,0) + XK1*ECOS(K1)**2*DELF + XMU(0,0,2) = XMU(0,0,2) + XK1*ESIN(K1)**2*DELF + XMU(0,1,1) = XMU(0,1,1) + XK1*ECOS(K1)*ESIN(K1)*DELF + ENDDO + ENDDO + + +! 3. COMPUTATION OF THE NORMALISED SKEWNESS COEFFICIENTS +! ------------------------------------------------------ + + DO I=0,3 + XPI = 0.5*FLOAT(I) + DO J=0,2 + XPJ = 0.5*FLOAT(J) + DO K=0,2 + XPK = 0.5*FLOAT(K) + XN = XMU(2,0,0)**XPI*XMU(0,2,0)**XPJ*XMU(0,0,2)**XPK ! denom in Srokosz eq. 11 + IF (XN .NE. 0) THEN + XLAMBDA(I,J,K) = XMU(I,J,K)/XN + ELSE + XLAMBDA(I,J,K) = 0 + END IF + END DO + END DO + END DO + IF ( XMU(2,0,0) .GT. 1.E-7 ) THEN + SKEW(JSEA)=XLAMBDA(3,0,0) + DELTA = ( XLAMBDA(1,2,0) + XLAMBDA(1,0,2) & + - 2.0*XLAMBDA(0,1,1)*XLAMBDA(1,1,1) )/ & + (1.0 - XLAMBDA(0,1,1)**2) ! this is called gamma eq. 20 + EMBIA1(JSEA)=-0.125*DELTA ! EM Bias coefficient + EMBIA2(JSEA)=-0.125*XLAMBDA(3,0,0)/3.0 ! tracker bias (least squares only) + END IF + END DO ! end of loop on JSEA + ! +#ifdef W3_OMPG + !$OMP END PARALLEL DO +#endif + + DEALLOCATE(FAC0,FAC1,FAC2,FAC3) + DEALLOCATE(F2,SIGHF,DFIMHF,FAK) + + + END SUBROUTINE SKEWNESS + END MODULE W3IOGOMD diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index d268793fbd..3a667ebbfa 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -887,7 +887,7 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) ! ! 8) Spectrum parameters ! - NOGE(8) = 6 + NOGE(8) = 9 ! IDOUT( 8, 1) = 'Mean square slopes ' IDOUT( 8, 2) = 'Phillips tail const' @@ -895,6 +895,9 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) IDOUT( 8, 4) = 'Tail slope direction' IDOUT( 8, 5) = 'Goda peakedness parm' IDOUT( 8, 6) = 'kxky-peakdness ' + IDOUT( 8, 7) = 'Skewness ' + IDOUT( 8, 8) = 'EM bias(l120+l102)/8' + IDOUT( 8, 9) = 'Tracker bias:-l300/8' ! IDOUT( 8, 3) = 'Lx-Ly mean wvlength' ! IDOUT( 8, 4) = 'Surf grad correl XT' ! IDOUT( 8, 5) = 'Surf grad correl YT' diff --git a/model/src/w3ounfmetamd.F90 b/model/src/w3ounfmetamd.F90 index a4a58d079f..87e606e569 100644 --- a/model/src/w3ounfmetamd.F90 +++ b/model/src/w3ounfmetamd.F90 @@ -3969,6 +3969,45 @@ SUBROUTINE DEFAULT_META() META(1)%VARNC='2D wavenumber peakedness' META(1)%VMIN = 0 META(1)%VMAX = 1600 + ! IFI=8, IFJ=7, SKW + META => GROUP(8)%FIELD(7)%META + META(1)%FSC = 0.00001 + META(1)%UNITS = '1' + META(1)%ENAME = '.skw' + META(1)%VARNM='skw' + META(1)%VARNL='skewness' + !META(1)%VARNS='sea_surface_wave_peakedness' + META(1)%VARNS='' + META(1)%VARNG='skewness of P(z,sx,sy=0)' + META(1)%VARNC='skewness of P(z,sx,sy=0)' + META(1)%VMIN = 0 + META(1)%VMAX = 1 + ! IFI=8, IFJ=8, EMB + META => GROUP(8)%FIELD(8)%META + META(1)%FSC = 0.00001 + META(1)%UNITS = '1' + META(1)%ENAME = '.emb' + META(1)%VARNM='emb' + META(1)%VARNL='EM-bias' + !META(1)%VARNS='sea_surface_wave_peakedness' + META(1)%VARNS='' + META(1)%VARNG='EM bias coefficient' + META(1)%VARNC='EM bias coefficient' + META(1)%VMIN = -1 + META(1)%VMAX = 1 + ! IFI=8, IFJ=7, SKW + META => GROUP(8)%FIELD(9)%META + META(1)%FSC = 0.00001 + META(1)%UNITS = '1' + META(1)%ENAME = '.emc' + META(1)%VARNM='emc' + META(1)%VARNL='trackerbias' + !META(1)%VARNS='sea_surface_wave_peakedness' + META(1)%VARNS='' + META(1)%VARNG='tracker bias coefficient' + META(1)%VARNC='tracker bias coefficient' + META(1)%VMIN = -1 + META(1)%VMAX = 1 ! ! !---------- GROUP 9 ---------------- ! diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index 02fd0d6f8b..a2ff83e269 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -66,6 +66,7 @@ PROGRAM W3OUNF !/ 22-Mar-2021 : New coupling fields output ( version 7.12 ) !/ 02-Sep-2021 : Added coordinates attribute ( version 7.12 ) !/ 14-Feb-2023 : Added QKK output ( version 7.12 ) + !/ 03-Mar-2024 : Added SKEW & EMBIAS output ( version 7.xx ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -193,7 +194,7 @@ PROGRAM W3OUNF CFLTHMAX, CFLXYMAX, CFLKMAX, TAUICE, PHICE, & STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& P2SMS, EF, US3D, TH1M, STH1M, TH2M, STH2M, & - WN, USSP, WBT, WNMEAN, QKK + WN, USSP, WBT, WNMEAN, QKK, SKEW, EMBIA1, EMBIA2 USE W3ODATMD, ONLY: NDSO, NDSE, SCREEN, NOGRP, NGRPP, IDOUT, & UNDEF, FLOGRD, FNMPRE, NOSWLL, NOGE ! @@ -1960,6 +1961,18 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN CALL S2GRID(QKK, X1) ! + ! surface elevation skewness lambda_3,0,0 + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN + CALL S2GRID(SKEW, X1) + ! + ! em bias param 1 + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN + CALL S2GRID(EMBIA1, X1) + ! + ! em bias param 2 + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN + CALL S2GRID(EMBIA2, X1) + ! ! Dynamic time step ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN DO ISEA=1, NSEA diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index e955f00ad1..590518037a 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -160,6 +160,7 @@ PROGRAM W3OUTF PHS, PTP, PLP, PDIR, PSI, PWS, PWST, PNR, & PTM1, PT1, PT2, PEP, TAUOCX, TAUOCY, & PTHP0, PQP, PSW, PPE, PGW, QP, QKK, & + SKEW, EMBIA1, EMBIA2, & TAUOX, TAUOY, TAUWIX,BHD, & TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & @@ -2216,6 +2217,39 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) CALL W3S2XY ( NSEA, NSEA, NX+1, NY, QKK, MAPSF, X1 ) ENDIF ! + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN + FLONE = .TRUE. + FSC = 0.01 + UNITS = '1' + ENAME = '.skw' + IF ( ITYPE .EQ. 4 ) THEN + XS1 = SKEW + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, SKEW, MAPSF, X1 ) + ENDIF + ! + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN + FLONE = .TRUE. + FSC = 0.0001 + UNITS = '1' + ENAME = '.emb' + IF ( ITYPE .EQ. 4 ) THEN + XS1 = EMBIA1 + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, EMBIA1, MAPSF, X1 ) + ENDIF + ! + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN + FLONE = .TRUE. + FSC = 0.0001 + UNITS = '1' + ENAME = '.emc' + IF ( ITYPE .EQ. 4 ) THEN + XS1 = EMBIA2 + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, EMBIA2, MAPSF, X1 ) + ENDIF + ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN FLONE = .TRUE. FSC = 0.1 diff --git a/model/tools/bash/ww3_ounf_inp2nml.sh b/model/tools/bash/ww3_ounf_inp2nml.sh index e9a34d7b8f..1edd055621 100755 --- a/model/tools/bash/ww3_ounf_inp2nml.sh +++ b/model/tools/bash/ww3_ounf_inp2nml.sh @@ -184,7 +184,7 @@ cat >> $nmlfile << EOF ! UST CHA CGE FAW TAW TWA WCC WCF WCH WCM FWS ! SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC USP TOC ! ABR UBR BED FBB TBB -! MSS MSC WL02 AXT AYT AXY +! MSS MSC MSD MCD QP QKK SKW EMB EMC ! DTD FC CFX CFD CFK ! U1 U2 ! diff --git a/model/tools/bash/ww3_shel_inp2nml.sh b/model/tools/bash/ww3_shel_inp2nml.sh index 619002aa87..8ea336e13a 100755 --- a/model/tools/bash/ww3_shel_inp2nml.sh +++ b/model/tools/bash/ww3_shel_inp2nml.sh @@ -970,6 +970,9 @@ cat >> $nmlfile << EOF ! F F 8 4 MSCD MCD Tail slope direction ! F F 8 5 QP QP Goda peakedness parameter ! F F 8 6 QKK QKK Wavenumber peakedness +! F F 8 7 SKEW SKW Skewness of elevation for zero slopes +! F F 8 8 EMBIA1 EMB Mean sea level at zero slopes / Hs +! F F 8 9 EMBIA2 EMC Tracker bias for LRM least square altimetry ! ------------------------------------------------- ! 9 Numerical diagnostics ! ------------------------------------------------- diff --git a/regtests/ww3_ts1/input/ww3_ounf.inp b/regtests/ww3_ts1/input/ww3_ounf.inp index 52a2dd2c6c..0b89ef01ef 100644 --- a/regtests/ww3_ts1/input/ww3_ounf.inp +++ b/regtests/ww3_ts1/input/ww3_ounf.inp @@ -11,7 +11,7 @@ $ file for a full documentation of field output options. Namelist type $ selection is used here (for alternative F/T flags, see ww3_shel.inp). $ N - DPT WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT + DPT WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT SKW EMB EMC $ $--------------------------------------------------------------------- $ $ NetCDF version [3,4] and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] diff --git a/regtests/ww3_ts1/input/ww3_ounf.nml b/regtests/ww3_ts1/input/ww3_ounf.nml index fb0f02d3e1..f9992f0ce5 100644 --- a/regtests/ww3_ts1/input/ww3_ounf.nml +++ b/regtests/ww3_ts1/input/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '19680101 120000' FIELD%TIMESTRIDE = '10' FIELD%TIMECOUNT = '8000' - FIELD%LIST = 'DPT WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT' + FIELD%LIST = 'DPT WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT SKW EMB EMC' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 / diff --git a/regtests/ww3_ts1/input/ww3_shel.inp b/regtests/ww3_ts1/input/ww3_shel.inp index fca96fb7e6..5171bd9ab9 100644 --- a/regtests/ww3_ts1/input/ww3_shel.inp +++ b/regtests/ww3_ts1/input/ww3_shel.inp @@ -19,7 +19,7 @@ $ $ N $ -DPT WND MSS MSD ICE HS MSS FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT +DPT WND MSS MSD ICE HS MSS FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT SKW EMB EMC $ 19680606 000000 60 19680618 000000 0.0 0.0 'The_point' diff --git a/regtests/ww3_ts1/input/ww3_shel.nml b/regtests/ww3_ts1/input/ww3_shel.nml index b4837d6e12..1ecf48c512 100644 --- a/regtests/ww3_ts1/input/ww3_shel.nml +++ b/regtests/ww3_ts1/input/ww3_shel.nml @@ -21,7 +21,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'DPT WND MSS MSD ICE HS MSS FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT' + TYPE%FIELD%LIST = 'DPT WND MSS MSD ICE HS MSS FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT SKW EMB EMC' TYPE%POINT%FILE = '../input/points.list' / From c13d0b1e178c7de0635f2577dd125b51fc31e372 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Thu, 9 May 2024 17:22:48 -0400 Subject: [PATCH 045/136] Add ice time variables to restart file (#1224) Co-authored-by: Nicholas Szapiro <149816583+NickSzapiro-NOAA@users.noreply.github.com> --- model/src/w3iorsmd.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 05f7e91633..5253a66ab8 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -69,7 +69,7 @@ MODULE W3IORSMD !/ !/ Private parameter statements (ID strings) !/ - CHARACTER(LEN=10), PARAMETER, PRIVATE :: VERINI = '2021-05-28' + CHARACTER(LEN=10), PARAMETER, PRIVATE :: VERINI = '2024-04-26' CHARACTER(LEN=26), PARAMETER, PRIVATE :: & IDSTR = 'WAVEWATCH III RESTART FILE' !/ @@ -845,7 +845,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITEBUFF(:) = 0. WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & - TLEV, TICE, TRHO + TLEV, TICE, TRHO, TIC1, TIC5 DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) @@ -1026,7 +1026,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF (TYPE.EQ.'FULL') THEN RPOS = 1_8 + LRECL*(NREC-1_8) READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & - TLEV, TICE, TRHO + TLEV, TICE, TRHO, TIC1, TIC5 DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) From 14e6bedfcefeff8f0896acea5dade4100a3fbacd Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Fri, 10 May 2024 18:07:55 +0100 Subject: [PATCH 046/136] Functional form of Charnock calculation in ST4. (#1225) Authored by: @ukmo-nievesvaliente --- model/inp/ww3_grid.inp | 6 ++ model/nml/namelists.nml | 6 ++ model/src/w3gdatmd.F90 | 7 +- model/src/w3gridmd.F90 | 24 +++++- model/src/w3iogrmd.F90 | 8 +- model/src/w3src4md.F90 | 31 ++++++-- regtests/bin/matrix.base | 1 + .../ww3_ts1/input_capcha/namelists_CAPCHA.nml | 12 +++ regtests/ww3_ts1/input_capcha/switch_ST4 | 1 + regtests/ww3_ts1/input_capcha/ww3_grid.nml | 70 +++++++++++++++++ regtests/ww3_ts1/input_capcha/ww3_ounf.nml | 29 +++++++ .../ww3_ts1/input_capcha/ww3_ounp_spec.nml | 47 +++++++++++ regtests/ww3_ts1/input_capcha/ww3_shel.nml | 78 +++++++++++++++++++ regtests/ww3_ts1/input_capcha/ww3_strt.inp | 7 ++ 14 files changed, 312 insertions(+), 15 deletions(-) create mode 100644 regtests/ww3_ts1/input_capcha/namelists_CAPCHA.nml create mode 100644 regtests/ww3_ts1/input_capcha/switch_ST4 create mode 100644 regtests/ww3_ts1/input_capcha/ww3_grid.nml create mode 100644 regtests/ww3_ts1/input_capcha/ww3_ounf.nml create mode 100644 regtests/ww3_ts1/input_capcha/ww3_ounp_spec.nml create mode 100644 regtests/ww3_ts1/input_capcha/ww3_shel.nml create mode 100644 regtests/ww3_ts1/input_capcha/ww3_strt.inp diff --git a/model/inp/ww3_grid.inp b/model/inp/ww3_grid.inp index 655a10493d..b3458402b5 100644 --- a/model/inp/ww3_grid.inp +++ b/model/inp/ww3_grid.inp @@ -73,6 +73,12 @@ $ effective wind speed (!/STAB2). $ WAM4 and variants : Namelist SIN3 $ ZWND : Height of wind (m). $ ALPHA0 : minimum value of Charnock coefficient +$ CAPCHA : enable functional form for Cd (1=enabled), +$ only valid when SINTABLE=0. +$ UCAP : Wind speed threshold for cap (CAPCHA=1) +$ SIGMAUCAP : Width of functional form (CAPCHA=1) +$ CHA0 : Initial Charnock coefficient (CAPCHA=1) +$ CHAMIN : Minimum Charnock value (CAPCHA=1) $ Z0MAX : maximum value of air-side roughness z0 $ BETAMAX : maximum value of wind-wave coupling $ SINTHP : power of cosine in wind input diff --git a/model/nml/namelists.nml b/model/nml/namelists.nml index 9fb59fe1cf..ff55b14a44 100644 --- a/model/nml/namelists.nml +++ b/model/nml/namelists.nml @@ -62,6 +62,12 @@ $ $ Janssen / Ardhuin : Namelist SIN4 $ ZWND : Height of wind (m). $ ALPHA0 : minimum value of Charnock coefficient +$ CAPCHA : enable functional form for Cd (1=enabled), +$ only valid when SINTABLE=0. +$ UCAP : Wind speed threshold for cap (CAPCHA=1) +$ SIGMAUCAP : Width of functional form (CAPCHA=1) +$ CHA0 : Initial Charnock coefficient (CAPCHA=1) +$ CHAMIN : Minimum Charnock value (CAPCHA=1) $ Z0MAX : maximum value of air-side roughness z0 $ BETAMAX : maximum value of wind-wave coupling $ SINTHP : power of cosine in wind input diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index bde5bf9998..e73957128b 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -907,7 +907,8 @@ MODULE W3GDATMD SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & FFXPM, FFXFM, FFXFA, & SSDSBRF1, SSDSBRF2, SSDSBINT,SSDSBCK,& - SSDSHCK, SSDSABK, SSDSPBK, SSINBR + SSDSHCK, SSDSABK, SSDSPBK, SSINBR, & + CAPCHNK(1:10) REAL :: ZZWND REAL :: SSDSCOS, SSDSDTH, SSDSBT, SSDSBM(0:4) #endif @@ -1327,7 +1328,8 @@ MODULE W3GDATMD SSDSPBK, SSINBR,SSINTHP,TTAUWSHELTER,& SINTAILPAR(:), SSWELLF(:), SSDSC(:), SSDSBR, & SSDSP, WWNMEANP, SSTXFTF, SSTXFTWN, & - SSDSBT, SSDSCOS, SSDSDTH, SSDSBM(:) + SSDSBT, SSDSCOS, SSDSDTH, SSDSBM(:), & + CAPCHNK(:) #endif #ifdef W3_ST6 REAL, POINTER :: SIN6A0, SDS6A1, SDS6A2, SWL6B1, & @@ -2668,6 +2670,7 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) ZZALP => MPARS(IMOD)%SRCPS%ZZALP TTAUWSHELTER => MPARS(IMOD)%SRCPS%TTAUWSHELTER SINTAILPAR => MPARS(IMOD)%SRCPS%SINTAILPAR + CAPCHNK => MPARS(IMOD)%SRCPS%CAPCHNK SSWELLFPAR => MPARS(IMOD)%SRCPS%SSWELLFPAR SSWELLF => MPARS(IMOD)%SRCPS%SSWELLF SSDSC => MPARS(IMOD)%SRCPS%SSDSC diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index dad11eddc5..ecf2726a0e 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -115,6 +115,7 @@ MODULE W3GRIDMD !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) !/ 28-Feb-2023 : GQM as an alternative for NL1 ( version 7.15 ) !/ 11-Jan-2024 : New namelist parameters for IC4 ( version 7.15 ) + !/ 03-May-2024 : New CAPCHNK parameters for SIN4 ( version 7.15 ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -860,7 +861,8 @@ MODULE W3GRIDMD SDSBM0, SDSBM1, SDSBM2, SDSBM3, & SDSBM4, SDSFACMTF, SDSCUMP, SDSNUW, & SDSL, SDSMWD, SDSMWPOW, SPMSS, SDSNMTF, SINTAIL1, SINTAIL2, & - CUMSIGP, VISCSTRESS + CUMSIGP, VISCSTRESS, & + CAPCHA, CHAMIN, CHA0, UCAP, SIGMAUCAP #endif ! #ifdef W3_ST6 @@ -1003,7 +1005,8 @@ MODULE W3GRIDMD NAMELIST /SIN4/ ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & TAUWSHELTER, SWELLFPAR, SWELLF, & SWELLF2, SWELLF3, SWELLF4, SWELLF5, SWELLF6, & - SWELLF7, Z0RAT, SINBR, SINTABLE, SINTAIL1, SINTAIL2, TAUWBUG, VISCSTRESS + SWELLF7, Z0RAT, SINBR, SINTABLE, SINTAIL1, SINTAIL2, TAUWBUG, VISCSTRESS, & + CAPCHA, CHAMIN, CHA0, UCAP, SIGMAUCAP #endif #ifdef W3_NL1 NAMELIST /SNL1/ LAMBDA, NLPROP, KDCONV, KDMIN, & @@ -1730,6 +1733,11 @@ SUBROUTINE W3GRID() TAUWBUG = 1 ! TAUWBUG is 1 is the bug is kept: ! initializes TAUWX/Y to zero in W3SRCE VISCSTRESS =0 + CAPCHA = 0. ! =1 indicates capping of drag is active + CHAMIN = 0.0001 ! + CHA0 = ALPHA0 ! initial value for charnock + UCAP = 30. ! U10 threshold from which drag capping is applied + SIGMAUCAP = 10. ! Width for reduction of drag beyond UCAP #endif ! #ifdef W3_ST6 @@ -1818,6 +1826,11 @@ SUBROUTINE W3GRID() SINTAILPAR(3) = SINTAIL2 SINTAILPAR(4) = FLOAT(TAUWBUG) SINTAILPAR(5) = VISCSTRESS + CAPCHNK(1) = CAPCHA + CAPCHNK(2) = CHAMIN + CAPCHNK(3) = CHA0 + CAPCHNK(4) = UCAP + CAPCHNK(5) = SIGMAUCAP #endif ! #ifdef W3_ST6 @@ -3219,7 +3232,8 @@ SUBROUTINE W3GRID() #ifdef W3_ST4 WRITE (NDSO,2920) ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP, ZALP, & TAUWSHELTER, SWELLFPAR, SWELLF, SWELLF2, SWELLF3, SWELLF4, & - SWELLF5, SWELLF6, SWELLF7, Z0RAT, SINBR, SINTABLE, TAUWBUG, VISCSTRESS, SINTAIL1, SINTAIL2 + SWELLF5, SWELLF6, SWELLF7, Z0RAT, SINBR, SINTABLE, TAUWBUG, VISCSTRESS, SINTAIL1, SINTAIL2, & + CAPCHA, CHAMIN, CHA0, UCAP, SIGMAUCAP #endif #ifdef W3_ST6 WRITE (NDSO,2920) SINA0, SINWS, SINFC @@ -6270,7 +6284,9 @@ SUBROUTINE W3GRID() ' SWELLF5 =',F8.5,', SWELLF6 =',F8.5, & ', SWELLF7 =',F12.2,', Z0RAT =',F8.5,', SINBR =',F8.5,','/ & ' SINTABLE =',I2,', TAUWBUG =',I2, & - ', VISCSTRESS =',F8.5,', SINTAIL1 =',F8.5,', SINTAIL2 =',F8.5,' /') + ', VISCSTRESS =',F8.5,', SINTAIL1 =',F8.5,', SINTAIL2 =',F8.5,',' / & + ', CAPCHA =',F8.5,', CHAMIN =',F8.5,', CHA0 =',F8.5,', UCAP =',F5.1,', SIGMAUCAP =', & + F5.1,' /') #endif ! #ifdef W3_ST6 diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index ce4403ba38..9f9e8c8db1 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -1508,7 +1508,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW, SINTAILPAR + DIKCUMUL, CUMULW, SINTAILPAR, CAPCHNK #ifdef W3_ASCII WRITE (NDSA,*) & 'ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & @@ -1521,7 +1521,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW, SINTAILPAR:', & + DIKCUMUL, CUMULW, SINTAILPAR, CAPCHNK:', & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & ZZ0RAT, SSDSC, & @@ -1532,7 +1532,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW, SINTAILPAR + DIKCUMUL, CUMULW, SINTAILPAR, CAPCHNK #endif IF (SINTAILPAR(1).GT.0.5) THEN WRITE (NDSM) DELUST, DELTAIL, DELTAUW, DELU, DELALP, & @@ -1558,7 +1558,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSDSPBK, SSDSBINT, FFXPM, FFXFM, FFXFA, & SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & - DIKCUMUL, CUMULW, SINTAILPAR + DIKCUMUL, CUMULW, SINTAILPAR, CAPCHNK IF (SINTAILPAR(1).GT.0.5) THEN CALL INSIN4(.FALSE.) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index 32eadaf824..dcf1e58083 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -1849,6 +1849,8 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) !/ 14-Aug-2006 : Modified following Bidlot ( version 2.22-SHOM ) !/ 18-Aug-2006 : Ported to version 3.09 !/ 03-Apr-2010 : Adding output of Charnock parameter ( version 3.14-IFREMER ) + !/ 03-May-2024 : Optional functional form of ( version 7.15 ) + !/ Charnock coefficient and surface drag (UK Met Office). ! ! 1. Purpose : ! @@ -1895,7 +1897,7 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) ! 10. Source code : !-----------------------------------------------------------------------------! USE CONSTANTS, ONLY: GRAV, KAPPA, NU_AIR - USE W3GDATMD, ONLY: ZZWND, AALPHA, ZZ0MAX, SINTAILPAR + USE W3GDATMD, ONLY: ZZWND, AALPHA, ZZ0MAX, SINTAILPAR, CAPCHNK #ifdef W3_T USE W3ODATMD, ONLY: NDST #endif @@ -1908,6 +1910,7 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) INTEGER :: IND,J REAL :: TAUW_LOCAL REAL :: TAUOLD,CDRAG,WCD,USTOLD,X,UST,ZZ0,ZNU,ZZ00,F,DELF + REAL :: CHATH, XMIN ! used for reduction of high winds INTEGER, PARAMETER :: NITER=10 REAL , PARAMETER :: XM=0.50, EPS1=0.00001 INTEGER :: ITER @@ -1918,6 +1921,7 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) ! *EPS1* REAL SMALL NUMBER TO MAKE SURE THAT A SOLUTION ! IS OBTAINED IN ITERATION WITH TAU>TAUW. + CHATH = AALPHA ! IF (SINTAILPAR(1).GT.0.5) THEN TAUW_LOCAL=MAX(MIN(TAUW,TAUWMAX),0.) @@ -1932,6 +1936,17 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) USTAR=(TAUT(IND,J)*DELI2+TAUT(IND+1,J )*DELI1)*DELJ2 & + (TAUT(IND,J+1)*DELI2+TAUT(IND+1,J+1)*DELI1)*DELJ1 ELSE + IF (CAPCHNK(1).EQ.1.) THEN + ! Computation of sea surface roughness and charnock coefficient based + ! on Donelan (2018). Determines minimum charnock; reduction for winds + ! above a particular threshold + CHATH = CAPCHNK(2) + 0.5 * (CAPCHNK(3) - CAPCHNK(2)) * (1 & + - TANH((WINDSPEED-CAPCHNK(4))/CAPCHNK(5))) + XMIN = 0.15 * (CAPCHNK(3)-CHATH) + ELSE + XMIN = 0. + END IF + ! This max is for comparison ... to be removed later ! TAUW_LOCAL=MAX(MIN(TAUW,TAUWMAX),0.) TAUW_LOCAL=TAUW @@ -1941,9 +1956,9 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) TAUOLD = MAX(USTOLD**2, TAUW_LOCAL+EPS1) ! Newton method to solve for ustar in U=ustar*log(Z/Z0) DO ITER=1,NITER - X = TAUW_LOCAL/TAUOLD + X = MAX(TAUW_LOCAL/TAUOLD, XMIN) UST = SQRT(TAUOLD) - ZZ00=AALPHA*TAUOLD/GRAV + ZZ00 = CHATH*TAUOLD/GRAV IF (ZZ0MAX.NE.0) ZZ00=MIN(ZZ00,ZZ0MAX) ! Corrects roughness ZZ00 for quasi-linear effect ZZ0 = ZZ00/(1.-X)**XM @@ -1969,10 +1984,16 @@ SUBROUTINE CALC_USTAR(WINDSPEED,TAUW,USTAR,Z0,CHARN) SQRTCDM1 = MIN(WINDSPEED/USTAR,100.0) Z0 = ZZWND*EXP(-KAPPA*SQRTCDM1) ELSE - Z0 = AALPHA*0.001*0.001/GRAV + Z0 = CHATH*0.001*0.001/GRAV END IF - CHARN = AALPHA + CHARN = CHATH END IF + IF(CAPCHNK(1) .EQ. 1) THEN + ! Problem with large values of CHARN for low winds + CHARN = MIN( 0.09 , CHARN ) + IF(CHARN.LT.CHATH) CHARN = CHATH + ENDIF + ! WRITE(6,*) 'CALC_USTAR:',WINDSPEED,TAUW,AALPHA,CHARN,Z0,USTAR ! RETURN diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 97ae213f45..819ea01018 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -918,6 +918,7 @@ echo "$rtst -g ST4_T702 -w work_T702 -i input_10ms -N $ww3 ww3_ts1" >> matrix.body echo "$rtst -g ST4_T707 -w work_T707GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body echo "$rtst -g ST4_T713 -w work_T713GQM -i input_10ms -N $ww3 ww3_ts1" >> matrix.body + echo "$rtst -s ST4 -w work_ST4_CAP -i input_capcha -N $ww3 ww3_ts1" >> matrix.body fi # fetch limited growth, no switch sharing here diff --git a/regtests/ww3_ts1/input_capcha/namelists_CAPCHA.nml b/regtests/ww3_ts1/input_capcha/namelists_CAPCHA.nml new file mode 100644 index 0000000000..5a5c726579 --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/namelists_CAPCHA.nml @@ -0,0 +1,12 @@ +&SIN4 + SINTABLE=0, + BETAMAX=1.35, + CAPCHA=1, + CHA0=0.0095, + SIGMAUCAP=5.0, + SINTAIL1=0.8, + TAUWBUG = 1, + UCAP=28.0 +/ + +END OF NAMELISTS diff --git a/regtests/ww3_ts1/input_capcha/switch_ST4 b/regtests/ww3_ts1/input_capcha/switch_ST4 new file mode 100644 index 0000000000..c3b8938ee6 --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/switch_ST4 @@ -0,0 +1 @@ +NOGRB SHRD PR0 FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_ts1/input_capcha/ww3_grid.nml b/regtests/ww3_ts1/input_capcha/ww3_grid.nml new file mode 100644 index 0000000000..9b47a9123c --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/ww3_grid.nml @@ -0,0 +1,70 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.10 + SPECTRUM%FREQ1 = 0.0485 + SPECTRUM%NK = 36 + SPECTRUM%NTH = 24 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 900. + TIMESTEPS%DTKTH = 900. + TIMESTEPS%DTMIN = 15. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'HOMOGENEOUS SOURCE TERM TEST' + GRID%NML = '../input_capcha/namelists_CAPCHA.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 3 + RECT%NY = 3 + RECT%SX = 1. + RECT%SY = 1. + RECT%SF = 1.E-2 + RECT%X0 = -1. + RECT%Y0 = -1. + RECT%SF0 = 1.E-2 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../input/HOMOGENEOUS.depth' + DEPTH%IDLA = 3 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_capcha/ww3_ounf.nml b/regtests/ww3_ts1/input_capcha/ww3_ounf.nml new file mode 100644 index 0000000000..fb0f02d3e1 --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '19680101 120000' + FIELD%TIMESTRIDE = '10' + FIELD%TIMECOUNT = '8000' + FIELD%LIST = 'DPT WND ICE HS MSS MSD FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT' + FIELD%PARTITION = '0 1 2' + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IX0 = 2 + FILE%IXN = 2 + FILE%IY0 = 2 + FILE%IYN = 2 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_capcha/ww3_ounp_spec.nml b/regtests/ww3_ts1/input_capcha/ww3_ounp_spec.nml new file mode 100644 index 0000000000..3e968f8256 --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/ww3_ounp_spec.nml @@ -0,0 +1,47 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '19680101 000000' + POINT%TIMESTRIDE = '3600.' + POINT%TIMECOUNT = '1000' + POINT%TIMESPLIT = 4 + POINT%BUFFER = 100 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_capcha/ww3_shel.nml b/regtests/ww3_ts1/input_capcha/ww3_shel.nml new file mode 100644 index 0000000000..884a8ede5b --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/ww3_shel.nml @@ -0,0 +1,78 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%STOP = '19680607 120000' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_NML + INPUT%FORCING%WINDS = 'H' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'DPT WND MSS MSD ICE HS MSS FAW WCC WCF WCH WCM FOC TAW CHA FWS WBT' + TYPE%POINT%FILE = '../input/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '19680606 000000' '3600' '19680618 000000' + DATE%POINT = '19680606 000000' '60' '19680618 000000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML + !HOMOG_COUNT%N_CUR = 1 + HOMOG_COUNT%N_WND = 5 +/ + +&HOMOG_INPUT_NML + HOMOG_INPUT(1)%NAME = 'WND' + HOMOG_INPUT(2)%DATE = '19680606 000000' + HOMOG_INPUT(1)%VALUE1 = 5. + HOMOG_INPUT(1)%VALUE2 = 270. + HOMOG_INPUT(1)%VALUE3 = 0. + + HOMOG_INPUT(2)%NAME = 'WND' + HOMOG_INPUT(2)%DATE = '19680606 060000' + HOMOG_INPUT(2)%VALUE1 = 10. + HOMOG_INPUT(2)%VALUE2 = 270. + HOMOG_INPUT(2)%VALUE3 = 0. + + HOMOG_INPUT(3)%NAME = 'WND' + HOMOG_INPUT(3)%DATE = '19680606 180000' + HOMOG_INPUT(3)%VALUE1 = 30. + HOMOG_INPUT(3)%VALUE2 = 270. + HOMOG_INPUT(3)%VALUE3 = 0. + + HOMOG_INPUT(4)%NAME = 'WND' + HOMOG_INPUT(4)%DATE = '19680607 000000' + HOMOG_INPUT(4)%VALUE1 = 2. + HOMOG_INPUT(4)%VALUE2 = 270. + HOMOG_INPUT(4)%VALUE3 = 0. + + HOMOG_INPUT(5)%NAME = 'WND' + HOMOG_INPUT(5)%DATE = '19680607 120000' + HOMOG_INPUT(5)%VALUE1 = 0. + HOMOG_INPUT(5)%VALUE2 = 270. + HOMOG_INPUT(5)%VALUE3 = 0. +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ts1/input_capcha/ww3_strt.inp b/regtests/ww3_ts1/input_capcha/ww3_strt.inp new file mode 100644 index 0000000000..d18f7cebd9 --- /dev/null +++ b/regtests/ww3_ts1/input_capcha/ww3_strt.inp @@ -0,0 +1,7 @@ +$ WAVEWATCH III Initial conditions input file +$ ------------------------------------------- +$ 2 +$ 0.0 0.30 270. 3.3 0. 0. 0. 1. 0. 1. +$ 3 + 5 +$ From 629d27a3137929bbf91b19d212437606135f0d20 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 14 Jun 2024 13:45:39 -0400 Subject: [PATCH 047/136] Add option to use NetCDF output instead of binary for point output (#1230) --------- Co-authored-by: Edward Hartnett Co-authored-by: Matthew Masarik --- .github/workflows/regtest_gnu.yml | 133 +++ CMakeLists.txt | 8 +- model/bin/ww3_from_ftp.sh | 9 +- model/src/CMakeLists.txt | 5 +- model/src/cmake/switches.json | 10 + model/src/gx_outp.F90 | 12 + model/src/w3iopomd.F90 | 826 +++++++++++++++++- model/src/w3wavemd.F90 | 8 +- model/src/wmiopomd.F90 | 9 +- model/src/ww3_ounp.F90 | 22 +- model/src/ww3_outp.F90 | 17 +- regtests/bin/matrix.base | 1 + regtests/unittests/CMakeLists.txt | 11 +- regtests/unittests/test_io.F90 | 117 +++ regtests/unittests/test_io2.F90 | 123 +++ regtests/unittests/test_io3.F90 | 110 +++ regtests/unittests/test_io_points_bin.F90 | 71 -- regtests/unittests/test_io_restart_bin.F90 | 59 ++ regtests/unittests/ww3_unittest_util.F90 | 75 ++ .../ww3_tp2.2/input/switch_PR1_MPI_BIN2NC | 1 + regtests/ww3_ufs1.1/input_unstr/switch_PDLIB | 2 +- 21 files changed, 1528 insertions(+), 101 deletions(-) create mode 100644 .github/workflows/regtest_gnu.yml create mode 100644 regtests/unittests/test_io.F90 create mode 100644 regtests/unittests/test_io2.F90 create mode 100644 regtests/unittests/test_io3.F90 create mode 100644 regtests/unittests/test_io_restart_bin.F90 create mode 100644 regtests/unittests/ww3_unittest_util.F90 create mode 100644 regtests/ww3_tp2.2/input/switch_PR1_MPI_BIN2NC diff --git a/.github/workflows/regtest_gnu.yml b/.github/workflows/regtest_gnu.yml new file mode 100644 index 0000000000..81d1317a3c --- /dev/null +++ b/.github/workflows/regtest_gnu.yml @@ -0,0 +1,133 @@ +name: regtest_gnu +on: [push, pull_request, workflow_dispatch] + +# Cancel in-progress workflows when pushing to a branch +concurrency: + group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + +env: + cache_key: gnu11-1 + CC: gcc-10 + FC: gfortran-10 + CXX: g++-10 + + +# Split into a steup step, and a WW3 build step which +# builds multiple switches in a matrix. The setup is run once and +# the environment is cached so each build of WW3 can share the dependencies. + +jobs: + setup: + runs-on: ubuntu-latest + + steps: + - name: checkout-ww3 + if: steps.cache-env.outputs.cache-hit != 'true' + uses: actions/checkout@v3 + with: + path: ww3 + # Cache spack, OASIS, and compiler + # No way to flush Action cache, so key may have # appended + - name: cache-env + id: cache-env + uses: actions/cache@v3 + with: + path: | + spack + ~/.spack + work_oasis3-mct + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + + # Build WW3 spack environment + - name: install-dependencies-with-spack + if: steps.cache-env.outputs.cache-hit != 'true' + run: | + # Install NetCDF, ESMF, g2, etc using Spack + sudo apt install cmake + git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git + source spack/share/spack/setup-env.sh + spack env create ww3-gnu ww3/model/ci/spack_gnu.yaml + spack env activate ww3-gnu + spack compiler find + spack external find cmake + spack add mpich@3.4.2 + spack concretize + spack install --dirty -v + + - name: build-oasis + if: steps.cache-env.outputs.cache-hit != 'true' + run: | + source spack/share/spack/setup-env.sh + spack env activate ww3-gnu + export WWATCH3_DIR=${GITHUB_WORKSPACE}/ww3/model + export OASIS_INPUT_PATH=${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/oasis3-mct + export OASIS_WORK_PATH=${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/work_oasis3-mct + cd ww3/regtests/ww3_tp2.14/input/oasis3-mct/util/make_dir + cmake . + make VERBOSE=1 + cp -r ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.14/input/work_oasis3-mct ${GITHUB_WORKSPACE} + + regtest_gnu: + needs: setup + runs-on: ubuntu-latest + + steps: + - name: install-dependencies + run: | + sudo apt-get update + sudo apt-get install doxygen gcovr valgrind + + - name: checkout-ww3 + uses: actions/checkout@v3 + with: + path: ww3 + + - name: cache-env + id: cache-env + uses: actions/cache@v3 + with: + path: | + spack + ~/.spack + work_oasis3-mct + key: spack2-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + + - name: build-ww3 + run: | + source spack/share/spack/setup-env.sh + spack env activate ww3-gnu + set -x + cd ww3 + export CC=mpicc + export FC=mpif90 + export OASISDIR=${GITHUB_WORKSPACE}/work_oasis3-mct +# mkdir build && cd build + export LD_LIBRARY_PATH="/home/runner/work/WW3/WW3/spack/var/spack/environments/ww3-gnu/.spack-env/view/:$LD_LIBRARY_PATH" +# cmake -DSWITCH=${GITHUB_WORKSPACE}/ww3/regtests/unittests/data/switch.io -DCMAKE_BUILD_TYPE=Debug .. +# make -j2 VERBOSE=1 + cd ${GITHUB_WORKSPACE}/ww3 + ls -l + ${GITHUB_WORKSPACE}/ww3/model/bin/ww3_from_ftp.sh -k + cd regtests + ./bin/run_cmake_test -o all -S -T -s PR1_MPI -w work_PR1_MPI -f -p mpirun -n 24 ../model ww3_tp2.5 + cd ww3_tp2.5 + ls -l + cd work_PR1_MPI + pwd + ls -l + ncdump -h out_pnt.ww3.nc > ncdump_out.txt + cat ncdump_out.txt + pwd + cat ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt + cmp ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt ncdump_out.txt + + - name: cache-data + id: cache-data + uses: actions/cache@v3 + with: + path: ww3/ww3_from_ftp.v7.14.1.tar.gz + key: ww3_from_ftp.v7.14.1 + + + diff --git a/CMakeLists.txt b/CMakeLists.txt index 5436f9cb1d..b485488b3c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -60,7 +60,7 @@ endif() add_subdirectory(model) # Turn on unit testing. -include(CTest) -if(BUILD_TESTING) - add_subdirectory(regtests/unittests) -endif() +#include(CTest) +#if(BUILD_TESTING) +# add_subdirectory(regtests/unittests) +#endif() diff --git a/model/bin/ww3_from_ftp.sh b/model/bin/ww3_from_ftp.sh index 67efc92849..4ab231e542 100755 --- a/model/bin/ww3_from_ftp.sh +++ b/model/bin/ww3_from_ftp.sh @@ -61,11 +61,14 @@ fi #Move to top level directory of ww3: cd $ww3dir -#Download from ftp and uptar: -echo -e "Downloading and untaring file from ftp:" -wget --no-check-certificate https://ftp.emc.ncep.noaa.gov/static_files/public/WW3/ww3_from_ftp.${ww3ver}.tar.gz +#Download from ftp (if not already present) and uptar: +echo -e "Downloading (or finding) and untaring file from ftp:" +if ! test -f ww3_from_ftp.${ww3ver}.tar.gz; then + wget --no-check-certificate https://ftp.emc.ncep.noaa.gov/static_files/public/WW3/ww3_from_ftp.${ww3ver}.tar.gz +fi tar -xvzf ww3_from_ftp.${ww3ver}.tar.gz + #Move regtest info from data_regtests to regtests: echo -e "Moving data from data_regtests to regtests" cp -r data_regtests/ww3_tp2.18/input/*.nc regtests/ww3_tp2.18/input/ diff --git a/model/src/CMakeLists.txt b/model/src/CMakeLists.txt index 7dd7d82a2c..4710576a51 100644 --- a/model/src/CMakeLists.txt +++ b/model/src/CMakeLists.txt @@ -174,10 +174,9 @@ if("SCRIP" IN_LIST switches) target_sources(ww3_lib PRIVATE ${scrip_src}) endif() - -if("SCRIPNC" IN_LIST switches OR "OASIS" IN_LIST switches OR "TRKNC" IN_LIST switches) +if("SCRIPNC" IN_LIST switches OR "OASIS" IN_LIST switches OR "TRKNC" IN_LIST switches OR "BIN2NC" IN_LIST switches) if(NOT NetCDF_Fortran_FOUND) - message(FATAL_ERROR "Cannot build SCRIPNC, OASIS, or TRKNC without NetCDF") + message(FATAL_ERROR "Cannot build SCRIPNC, OASIS, TRKNC, or BIN2NC without NetCDF") endif() endif() diff --git a/model/src/cmake/switches.json b/model/src/cmake/switches.json index 30eca480c3..a7b9bc94f9 100644 --- a/model/src/cmake/switches.json +++ b/model/src/cmake/switches.json @@ -814,6 +814,16 @@ } ] }, + { + "name": "bin2nc", + "num_switches": "upto1", + "description": "use netcdf instead of binary model output", + "valid-options": [ + { + "name": "BIN2NC" + } + ] + }, { "name": "ascii", "num_switches": "upto1", diff --git a/model/src/gx_outp.F90 b/model/src/gx_outp.F90 index d34fdbaa72..8dce5f4d03 100644 --- a/model/src/gx_outp.F90 +++ b/model/src/gx_outp.F90 @@ -165,7 +165,11 @@ PROGRAM GXOUTP #endif USE W3ODATMD, ONLY: W3SETO, W3NOUT USE W3IOGRMD, ONLY: W3IOGR +#ifdef W3_BIN2NC + USE W3IOPOMD, ONLY: W3IOPON +#else USE W3IOPOMD, ONLY: W3IOPO +#endif USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -277,7 +281,11 @@ PROGRAM GXOUTP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif ALLOCATE ( FLREQ(NOPTS) ) ! WRITE (NDSO,930) @@ -369,7 +377,11 @@ PROGRAM GXOUTP DO DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,998) EXIT diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 0c15ea8c6a..bbdfda34c0 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -5,6 +5,7 @@ !> #include "w3macros.h" +#define nf90_err(ncerr) nf90_err_check(ncerr, __LINE__) !/ ------------------------------------------------------------------- / !> !> @brief Process point output. @@ -65,7 +66,7 @@ MODULE W3IOPOMD ! Name Type Scope Description ! ---------------------------------------------------------------- ! VEROPT C*10 Private Point output file version number. - ! IDSTR C*32 Private Point output file ID string. + ! IDSTR C*31 Private Point output file ID string. ! ---------------------------------------------------------------- ! ! 3. Subroutines and functions : @@ -118,6 +119,96 @@ MODULE W3IOPOMD CHARACTER(LEN=10), PARAMETER, PRIVATE :: VEROPT = '2021-04-06' CHARACTER(LEN=31), PARAMETER, PRIVATE :: & IDSTR = 'WAVEWATCH III POINT OUTPUT FILE' + + !> Dimension name for the netCDF point output file, for NOPTS, the + !> Number of Output Points. + character(*), parameter, private :: DNAME_NOPTS = 'NOPTS' + + !> Dimension name for the netCDF point output file, for NSPEC. + character(*), parameter, private :: DNAME_NSPEC = 'NSPEC' + + !> Dimension name for the netCDF point output file, for VSIZE. This + !> is for the vector size for points, which is 2. + character(*), parameter, private :: DNAME_VSIZE = 'VSIZE' + + !> Dimension name for the netCDF point output file, for + !> NAMELEN. This is the length of the PTNME strings, which contains + !> the names of the points. + character(*), parameter, private :: DNAME_NAMELEN = 'NAMELEN' + + !> Dimension name for the netCDF point output file, for GRDIDLEN, + !> this is the length of the GRDID character array. + character(*), parameter, private :: DNAME_GRDIDLEN = 'GRDIDLEN' + + !> Dimension name for the netCDF point output file, for TIME + character(*), parameter, private :: DNAME_TIME = 'TIME' + + !> Dimension name for the netCDF point output file, for WW3TIME + character(*), parameter, private :: DNAME_WW3TIME = 'WW3TIME' + + !> Variable name for the netCDF point output file, for NK. + character(*), parameter, private :: VNAME_NK = 'NK' + + !> Variable name for the netCDF point output file, for MTH. + character(*), parameter, private :: VNAME_NTH = 'NTH' + + !> Variable name for the netCDF point output file, for PTLOC. + character(*), parameter, private :: VNAME_PTLOC = 'PTLOC' + + !> Variable name for the netCDF point output file, for PTNME. + character(*), parameter, private :: VNAME_PTNME = 'PTNME' + + !> Variable name for the netCDF point output file, for TIME. + character(*), parameter, private :: VNAME_TIME = 'TIME' + + !> Variable name for the netCDF point output file, for WW3TIME. + character(*), parameter, private :: VNAME_WW3TIME = 'WW3TIME' + + !> Variable name for the netCDF point output file, for DPO. + character(*), parameter, private :: VNAME_DPO = 'DPO' + + !> Variable name for the netCDF point output file, for WAO. + character(*), parameter, private :: VNAME_WAO = 'WAO' + + !> Variable name for the netCDF point output file, for WDO. + character(*), parameter, private :: VNAME_WDO = 'WDO' + + !> Variable name for the netCDF point output file, for TAUAO. + character(*), parameter, private :: VNAME_TAUAO = 'TAUAO' + + !> Variable name for the netCDF point output file, for TAUDO. + character(*), parameter, private :: VNAME_TAUDO = 'TAUDO' + + !> Variable name for the netCDF point output file, for DAIRO. + character(*), parameter, private :: VNAME_DAIRO = 'DAIRO' + + !> Variable name for the netCDF point output file, for ZET_SETO. + character(*), parameter, private :: VNAME_ZET_SETO = 'ZET_SETO' + + !> Variable name for the netCDF point output file, for ASO. + character(*), parameter, private :: VNAME_ASO = 'ASO' + + !> Variable name for the netCDF point output file, for CAO. + character(*), parameter, private :: VNAME_CAO = 'CAO' + + !> Variable name for the netCDF point output file, for CDO. + character(*), parameter, private :: VNAME_CDO = 'CDO' + + !> Variable name for the netCDF point output file, for ICEO. + character(*), parameter, private :: VNAME_ICEO = 'ICEO' + + !> Variable name for the netCDF point output file, for ICEHO. + character(*), parameter, private :: VNAME_ICEHO = 'ICEHO' + + !> Variable name for the netCDF point output file, for ICEFO. + character(*), parameter, private :: VNAME_ICEFO = 'ICEFO' + + !> Variable name for the netCDF point output file, for GRDID. + character(*), parameter, private :: VNAME_GRDID = 'GRDID' + + !> Variable name for the netCDF point output file, for SPCO. + character(*), parameter, private :: VNAME_SPCO = 'SPCO' + !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -1024,6 +1115,717 @@ SUBROUTINE W3IOPE ( A ) !/ END SUBROUTINE W3IOPE +#ifdef W3_BIN2NC + !> Handle netCDF return code. + !> + !> @param errcode NetCDF error code. 0 for no error. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + !> + integer function nf90_err_check(errcode, ILINE) + USE NetCDF + USE W3ODATMD, ONLY: NDSE + implicit none + integer, intent(in) :: errcode, ILINE + + nf90_err_check = errcode + if(errcode /= nf90_noerr) then + WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN W3IOPO :' + WRITE(NDSE,*) ' LINE NUMBER ', ILINE + WRITE(NDSE,*) ' NETCDF ERROR MESSAGE: ' + WRITE(NDSE,*) 'Error: ', trim(nf90_strerror(errcode)) + return + endif + end function nf90_err_check + + !> Read point output in netCDF format. + !> + !> @param[out] IOTST Test indictor for reading. + !> @param[in] IMOD_IN Model number for W3GDAT etc. + !> @param[in] filename Name of file to read. + !> @param[inout] ncerr Error code, 0 for success, netCDF error code + !> otherwise. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + !> + SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) + USE NetCDF + USE W3ODATMD, ONLY: W3DMO2 + USE W3WDATMD, ONLY: TIME + USE W3GDATMD, ONLY: NTH, NK, NSPEC, FILEXT + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & + IL, IW, II, PTLOC, PTIFAC, DPO, WAO, WDO, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + GRDID, ICEO, ICEHO, ICEFO, W3DMO2 + USE W3SERVMD, ONLY: EXTCDE +#ifdef W3_FLX5 + USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO +#endif +#ifdef W3_SETUP + USE W3ODATMD, ONLY: ZET_SETO +#endif + IMPLICIT NONE + + INTEGER, INTENT(OUT) :: IOTST + INTEGER, INTENT(IN), OPTIONAL :: IMOD_IN + character(*), intent(in) :: filename + integer, intent(inout) :: ncerr + INTEGER :: IGRD,MK,MTH + integer :: fh + integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time, d_ww3time + integer :: d_nopts_len, d_nspec_len, d_vsize_len, d_namelen_len, d_grdidlen_len, d_time_len, d_ww3time_len + integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time + integer :: v_dpo, v_wao, v_wdo +#ifdef W3_FLX5 + integer :: v_tauao,v_taudo, v_dairo +#endif +#ifdef W3_SETUP + integer :: v_zet_seto +#endif + integer :: v_aso, v_cao, v_cdo, v_iceo + integer :: v_iceho, v_icefo, v_grdid, v_spco + integer :: v_title_len, v_version_len + CHARACTER(LEN=31) :: IDTST + CHARACTER(LEN=10) :: VERTST + + IOTST = 0 + + IF (PRESENT(IMOD_IN)) THEN + IGRD = IMOD_IN + ELSE + IGRD = 1 + END IF + + ! Open the netCDF file. + ncerr = nf90_open(filename, NF90_NOWRITE, fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Read and check the version: + ncerr = nf90_inquire_attribute(fh, NF90_GLOBAL, 'title', len = v_title_len) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_att(fh, NF90_GLOBAL, 'title', IDTST) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_attribute(fh, NF90_GLOBAL, 'version', len = v_version_len) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_att(fh, NF90_GLOBAL, 'version', VERTST) + if (nf90_err(ncerr) .ne. 0) return + + IF ( IDTST .NE. IDSTR ) THEN + WRITE (NDSE,902) IDTST, IDSTR + CALL EXTCDE ( 10 ) + END IF + IF ( VERTST .NE. VEROPT ) THEN + WRITE (NDSE,903) VERTST, VEROPT + CALL EXTCDE ( 11 ) + END IF + + ! Read the dimension information for NOPTS. + ncerr = nf90_inq_dimid(fh, DNAME_NOPTS, d_nopts) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_nopts, len = d_nopts_len) + if (nf90_err(ncerr) .ne. 0) return + NOPTS=d_nopts_len + + ! Read the dimension information for NSPEC. + ncerr = nf90_inq_dimid(fh, DNAME_NSPEC, d_nspec) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_nspec, len = d_nspec_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for VSIZE. + ncerr = nf90_inq_dimid(fh, DNAME_VSIZE, d_vsize) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_vsize, len = d_vsize_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for NAMELEN. + ncerr = nf90_inq_dimid(fh, DNAME_NAMELEN, d_namelen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_namelen, len = d_namelen_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for GRDIDLEN. + ncerr = nf90_inq_dimid(fh, DNAME_GRDIDLEN, d_grdidlen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_grdidlen, len = d_grdidlen_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimention information from time + ncerr = nf90_inq_dimid(fh, DNAME_TIME, d_time) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_time, len = d_time_len) + if (nf90_err(ncerr) .ne. 0) return + + IF ( IPASS .LE. d_time_len ) THEN + + IF ( IPASS.EQ.1 ) THEN + + ! Read scalar variables. + ncerr = nf90_inq_varid(fh, VNAME_NK, v_nk) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_nk, MK) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_NTH, v_nth) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_nth, MTH) + if (nf90_err(ncerr) .ne. 0) return + + !read in written variables NK, NTH as MK and MTH + !and ensure they match + IF (NK.NE.MK .OR. NTH.NE.MTH) THEN + WRITE (NDSE,904) MK, MTH, NK, NTH + CALL EXTCDE ( 12 ) + END IF + + ! Allocate variables: + IF ( .NOT. O2INIT ) & + CALL W3DMO2 ( IGRD, NDSE, NDST, NOPTS ) + + ! Read vars with nopts as a dimension. + ncerr = nf90_inq_varid(fh, VNAME_PTLOC, v_ptloc) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptloc, PTLOC, start = (/ 1, 1/), & + count = (/ d_vsize_len, d_nopts_len /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_PTNME, v_ptnme) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptnme, PTNME) + if (nf90_err(ncerr) .ne. 0) return + END IF + + !Variables read based on time (IPASS): + + ncerr = nf90_inq_varid(fh, VNAME_WW3TIME, v_ww3time) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ww3time, TIME, start = (/ 1, IPASS/), & + count = (/ d_vsize_len, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ! set IW, II and IL to 0, + ! These values are set to 0 in binary file and have been removed + ! from netcdf file. Possible can be completely removed. + IW = 0 + II = 0 + IL = 0 + + ncerr = nf90_inq_varid(fh, VNAME_DPO, v_dpo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_dpo, DPO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WAO, v_wao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_wao, WAO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WDO, v_wdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_wdo, WDO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#ifdef W3_FLX5 + ncerr = nf90_inq_varid(fh, VNAME_TAUAO, v_tauao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_tauao, TAUAO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_TAUDO, v_taudo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_taudo, TAUDO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_DAIRO, v_dairo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_dairo, DAIRO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_inq_varid(fh, ZET_SETO, v_zet_seto) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_zet_seto, ZET_SETO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_inq_varid(fh, VNAME_ASO, v_aso) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_aso, ASO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CAO, v_cao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_cao, CAO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CDO, v_cdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_cdo, CDO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEO, v_iceo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_iceo, ICEO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEHO, v_iceho) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_iceho, ICEHO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEFO, v_icefo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_icefo, ICEFO, start = (/ 1, IPASS/), & + count = (/ NOPTS, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_GRDID, v_grdid) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_grdid, GRDID, start = (/ 1, 1, IPASS/), & + count = (/ 13, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_SPCO, v_spco) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_spco, SPCO, start = (/ 1, 1, IPASS/), & + count = (/nspec, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ELSE + ! Set flag to indicate IPASS > d_time_len + ! and are at the end of the + IOTST = -1 + END IF + + ! Close the file. + ncerr = nf90_close(fh) + if (nf90_err(ncerr) .ne. 0) return + +902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPON :'/ & + ' ILEGAL IDSTR, READ : ',A/ & + ' CHECK : ',A/) +903 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPON :'/ & + ' ILEGAL VEROPT, READ : ',A/ & + ' CHECK : ',A/) +904 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ & + ' ERROR IN SPECTRA, MK, MTH : ',2I8/ & + ' ARRAY DIMENSIONS : ',2I8/) + + + END SUBROUTINE W3IOPON_READ + + !/ ------------------------------------------------------------------- / + !> + !> @brief Write point output in netCDF format. + !> + !> @param[in] filename Name of file to write. + !> @param[in] timestep_only Will be 0 if whole model run should be + !> written, 1 if only one timestep should be written. + !> @param[inout] ncerr Error code, 0 for success, netCDF error code + !> otherwise. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + !> + SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) + USE NETCDF + USE W3GDATMD, ONLY: NTH, NK, NSPEC + USE W3WDATMD, ONLY: TIME + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & + PTLOC, PTIFAC, DPO, WAO, WDO, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + GRDID, ICEO, ICEHO, ICEFO + USE W3TIMEMD, ONLY: CALTYPE, T2D, U2D, TSUB +#ifdef W3_FLX5 + USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO +#endif +#ifdef W3_SETUP + USE W3ODATMD, ONLY: ZET_SETO +#endif + + IMPLICIT NONE + integer, intent(in) :: timestep_only ! 1 if only timestep should be written. + character(*), intent(in) :: filename + integer, intent(inout) :: ncerr + integer :: ndim, nvar, fmt, itime, fh + integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time + integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time + integer :: v_dpo, v_wao, v_wdo +#ifdef W3_FLX5 + integer :: v_tauao, v_taudo, v_dairo +#endif +#ifdef W3_SETUP + integer :: v_zet_seto +#endif + integer :: v_aso, v_cao, v_cdo, v_iceo + integer :: v_iceho, v_icefo, v_grdid, v_spco + integer :: curdate(8), refdate(8),ierr + double precision :: outjulday + + !If first pass, or if you are writting a file for every time-step: + IF ( IPASS.EQ.1 .OR. timestep_only.EQ.1 ) THEN + ! Create the netCDF file. + ncerr = nf90_create(filename, NF90_NETCDF4, fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Define dimensions. + ncerr = nf90_def_dim(fh, DNAME_NOPTS, NOPTS, d_nopts) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_NSPEC, NSPEC, d_nspec) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_VSIZE, 2, d_vsize) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_NAMELEN, 40, d_namelen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_GRDIDLEN, 13, d_grdidlen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_TIME, NF90_UNLIMITED, d_time) + if (nf90_err(ncerr) .ne. 0) return + + ! Define global attributes. + ncerr = nf90_put_att(fh, NF90_GLOBAL, 'title', IDSTR) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, NF90_GLOBAL, 'version', VEROPT) + if (nf90_err(ncerr) .ne. 0) return + + ! Define scalar variables. + ncerr = nf90_def_var(fh, VNAME_NK, NF90_INT, v_nk) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_NTH, NF90_INT, v_nth) + if (nf90_err(ncerr) .ne. 0) return + + ! Define vars with nopts as a dimension. Point location and name + ncerr = nf90_def_var(fh, VNAME_PTLOC, NF90_FLOAT, (/d_vsize, d_nopts/), v_ptloc) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_PTNME, NF90_CHAR, (/d_namelen, d_nopts/), v_ptnme) + if (nf90_err(ncerr) .ne. 0) return + + ! Define time for each time step + ncerr = nf90_def_var(fh, VNAME_WW3TIME, NF90_INT, (/d_vsize, d_time/),v_ww3time) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_TIME, NF90_DOUBLE, (/d_time/),v_time) + if (nf90_err(ncerr) .ne. 0) return + SELECT CASE (TRIM(CALTYPE)) + CASE ('360_day') + ncerr = nf90_put_att(fh, v_time, 'long_name', 'time in 360 day calendar') + if (nf90_err(ncerr) .ne. 0) return + CASE ('365_day') + ncerr = nf90_put_att(fh, v_time, 'long_name', 'time in 365 day calendar') + if (nf90_err(ncerr) .ne. 0) return + CASE ('standard') + ncerr = nf90_put_att(fh, V_TIME, 'long_name', 'Julian day (UT)') + if (nf90_err(ncerr) .ne. 0) return + END SELECT + ncerr = nf90_put_att(fh, V_TIME, 'standard_name', 'time') + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, V_TIME, 'units', 'days since 1990-01-01 00:00:00') + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, V_TIME, 'conventions','Relative Julian days with decimal part (as parts of the day)') + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, V_TIME, 'axis', 'T') + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_att(fh, V_TIME, 'calendar', TRIM(CALTYPE)) + if (nf90_err(ncerr) .ne. 0) return + + ! Define vars with nopts and time as dimensions + ncerr = nf90_def_var(fh, VNAME_DPO, NF90_FLOAT, (/d_nopts, d_time/), v_dpo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_WAO, NF90_FLOAT, (/d_nopts, d_time/), v_wao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_WDO, NF90_FLOAT, (/d_nopts, d_time/), v_wdo) + if (nf90_err(ncerr) .ne. 0) return +#ifdef W3_FLX5 + ncerr = nf90_def_var(fh, VNAME_TAUAO, NF90_FLOAT, (/d_nopts, d_time/), v_tauao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_TAUDO, NF90_FLOAT, (/d_nopts, d_time/), v_taudo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_DAIRO, NF90_FLOAT, (/d_nopts, d_time/), v_dairo) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_def_var(fh, VNAME_ZET_SETO, NF90_FLOAT, (/d_nopts, d_time/), v_zet_seto) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_def_var(fh, VNAME_ASO, NF90_FLOAT, (/d_nopts, d_time/), v_aso) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_CAO, NF90_FLOAT, (/d_nopts, d_time/), v_cao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_CDO, NF90_FLOAT, (/d_nopts, d_time/), v_cdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_ICEO, NF90_FLOAT, (/d_nopts, d_time/), v_iceo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_ICEHO, NF90_FLOAT, (/d_nopts, d_time/), v_iceho) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_ICEFO, NF90_FLOAT, (/d_nopts, d_time/), v_icefo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_GRDID, NF90_CHAR, (/d_grdidlen, d_nopts, d_time/), v_grdid) + if (nf90_err(ncerr) .ne. 0) return + + ! Define spectral output with dimensions nspec, nopts and time + ncerr = nf90_def_var(fh, VNAME_SPCO, NF90_FLOAT, (/d_nspec, d_nopts, d_time/), v_spco) + if (nf90_err(ncerr) .ne. 0) return + + ! End of all variable definitions + ncerr = nf90_enddef(fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Write the scalar data. + ncerr = nf90_put_var(fh, v_nk, NK) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_var(fh, v_nth, NTH) + if (nf90_err(ncerr) .ne. 0) return + + ! Write the data with NOPTS as a dimension. (no time dimension) + if (associated(PTLOC)) then + ncerr = nf90_put_var(fh, v_ptloc, PTLOC(:,1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + endif + if (associated(PTNME)) then + ncerr = nf90_put_var(fh, v_ptnme, PTNME(1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + endif + + ELSE + ! If we are writing to the same file, re-open the file + ncerr = nf90_open(filename, nf90_write, fh) + if (nf90_err(ncerr) .ne. 0) return + END IF + + !Determine the start for the time dimension + IF ( timestep_only.EQ.1 ) THEN + itime=1 + ELSE + itime=IPASS + END IF + + ! Write Time + IF ( itime > 1 ) THEN + ncerr = nf90_inq_varid(fh, VNAME_WW3TIME, v_ww3time) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_TIME, v_time) + if (nf90_err(ncerr) .ne. 0) return + END IF + ncerr = nf90_put_var(fh, v_ww3time, TIME, start = (/ 1, itime/), & + count = (/ 2, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + CALL U2D('days since 1990-01-01 00:00:00',REFDATE,IERR) + CALL T2D(TIME,CURDATE,IERR) + outjulday=TSUB(REFDATE,CURDATE) + + ncerr = nf90_put_var(fh, v_time, outjulday, start = (/itime/)) + if (nf90_err(ncerr) .ne. 0) return + + + ! If itime > 1 need to inquire varid + IF ( itime > 1 ) THEN + ncerr = nf90_inq_varid(fh, VNAME_DPO, v_dpo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WAO, v_wao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_WDO, v_wdo) + if (nf90_err(ncerr) .ne. 0) return +#ifdef W3_FLX5 + ncerr = nf90_inq_varid(fh, VNAME_TAUAO, v_tauao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_TAUDO, v_taudo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_DAIRO, v_dairo) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_inq_varid(fh, VNAME_ZET_SETO, v_zet_seto) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_inq_varid(fh, VNAME_ASO, v_aso) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CAO, v_cao) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_CDO, v_cdo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEO, v_iceo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEHO, v_iceho) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_ICEFO, v_icefo) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_GRDID, v_grdid) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inq_varid(fh, VNAME_SPCO, v_spco) + if (nf90_err(ncerr) .ne. 0) return + END IF + + ncerr = nf90_put_var(fh, v_dpo, DPO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_wao, WAO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_wdo, WDO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + +#ifdef W3_FLX5 + ncerr = nf90_put_var(fh, v_tauao, TAUAO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_taudo, TAUDO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_dairo, DAIRO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif +#ifdef W3_SETUP + ncerr = nf90_put_var(fh, v_zet_seto, ZET_SETO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return +#endif + ncerr = nf90_put_var(fh, v_aso, ASO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_cao, CAO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_cdo, CDO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_iceo, ICEO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_iceho, ICEHO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_icefo, ICEFO, start = (/ 1, itime/), & + count = (/ nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_grdid, GRDID, start = (/ 1, 1, itime/), & + count = (/ 13, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + !write spectral output + ncerr = nf90_put_var(fh, v_spco, SPCO, start = (/ 1, 1, itime/), & + count = (/nspec, nopts, 1 /)) + if (nf90_err(ncerr) .ne. 0) return + + ! Close the file. + ncerr = nf90_close(fh) + if (nf90_err(ncerr) .ne. 0) return + + END SUBROUTINE W3IOPON_WRITE + + !> Read or write the netCDF point output file, + !> depending on the value of the first parameter. + !> + !> When reading, the entire file is read with one call to this + !> subroutine. + !> + !> When writing, this subroutine can either write one timestep or + !> the whole model run. This is an option in the input file. If the + !> entire model run is to be written, then OFILES(2) is 0. If only + !> one timestep is to be written, then OFILES(2) is 1. + !> + !> If OFILES(2) is 0, the output file is names out_pnt.ww3. If + !> OFILES(2) is 1, the output file is named TIMETAG.out_pnt.ww3. + !> + !> @param[in] INXOUT String indicating read/write. Must be 'READ' or + !> 'WRITE'. + !> @param[in] NDSOP File unit number. + !> @param[out] IOTST Error code: + !> - 0 No error. + !> - -1 Unexpected end of file when reading. + !> @param[in] IMOD Model number for W3GDAT etc. + !> + !> @author Edward Hartnett @date 1-Nov-2023 + SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) + USE W3GDATMD, ONLY: W3SETG + USE W3WDATMD, ONLY: W3SETW + USE W3ODATMD, ONLY: W3SETO + USE W3GDATMD, ONLY: FILEXT + USE W3WDATMD, ONLY: TIME + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, FNMPRE + USE W3ODATMD, ONLY: OFILES + USE W3SERVMD, ONLY: EXTCDE +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif + use netcdf + IMPLICIT NONE + + CHARACTER, INTENT(IN) :: INXOUT*(*) + INTEGER, INTENT(IN) :: NDSOP + INTEGER, INTENT(OUT) :: IOTST + INTEGER, INTENT(IN), OPTIONAL :: IMOD + + CHARACTER(LEN=15) :: TIMETAG + INTEGER :: IGRD + character(len = 124) :: filename + integer :: ncerr + +#ifdef W3_S + CALL STRACE (IENT, 'W3IOPON') +#endif + + ! IPASS essentially is the time variable dimension + IPASS = IPASS + 1 + + ! Optimistically assume success. + IOTST = 0 + + ! Has a model number been specified? + IF (PRESENT(IMOD)) THEN + IGRD = IMOD + ELSE + IGRD = 1 + END IF + + CALL W3SETO(IGRD, NDSE, NDST) + CALL W3SETG(IGRD, NDSE, NDST) + CALL W3SETW(IGRD, NDSE, NDST) + + ! INXOUT must be 'READ' or 'WRITE'. + IF (INXOUT .NE. 'READ' .AND. INXOUT .NE. 'WRITE') THEN + WRITE (NDSE, 900) INXOUT + CALL EXTCDE(1) + END IF + + ! Determine filename. + IF ( OFILES(2) .EQ. 1 ) THEN + ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix + WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) + filename = FNMPRE(:LEN_TRIM(FNMPRE))//TIMETAG//'.out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + ELSE + filename = FNMPRE(:LEN_TRIM(FNMPRE))//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + END IF + + ! Do a read or a write of the point file. + IF (INXOUT .EQ. 'READ') THEN + CALL W3IOPON_READ(IOTST, IMOD, filename, ncerr) + ELSE + CALL W3IOPON_WRITE(OFILES(2), filename, ncerr) + ENDIF + if (nf90_err(ncerr) .ne. 0) then + WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN W3IOPO :' + WRITE(NDSE,*) 'Nonzero return at end of W3IOPON' + WRITE(NDSE,*) 'Error: ', trim(nf90_strerror(ncerr)) + CALL EXTCDE(21) + endif + + !/ + !/ End of W3IOPON ----------------------------------------------------- / + !/ + +900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ & + ' ILEGAL INXOUT VALUE: ',A/) + END SUBROUTINE W3IOPON +#endif + !/ ------------------------------------------------------------------- / !> Read or write point output. !> !> This subroutine can either read or write the point output file, @@ -1045,12 +1847,12 @@ END SUBROUTINE W3IOPE !> -------------|------|----------|-------- !> 40 | character*40 | IDTST | ID string !> 4 | integer | VERTST | Model definition file version number - !> 4 | integer | NK | Dimension of frequency - !> 4 | integer | MTH | Directionality of the frequency + !> 4 | integer | NK | Number of discrete wavenumbers + !> 4 | integer | NTH | Number of discrete directions. !> 4 | integer | NOPTS | Number of output points. - !> 8*NOPTS | integer(2,NOPTS) | PTLOC | Point locations + !> 8*NOPTS | real(2,NOPTS) | PTLOC | Point locations !> 7*NOPTS | character*7 | PTNME | Point names - !> 8 | integer(2) | TIME | Time + !> 8 | integer(2) | TIME | Valid time !> reclen*NOPTS | * | * | records !> !> Each record contains: @@ -1088,7 +1890,9 @@ END SUBROUTINE W3IOPE !> !> @param[in] INXOUT String indicating read/write. Must be 'READ' or !> 'WRITE'. - !> @param[in] NDSOP File unit number. + !> @param[in] NDSOP This is set by this subroutine to the netCDF + !> file ID (ncid) of the opened file. User does not have to + !> initialize this value, and should not change it. !> @param[out] IOTST Error code: !> - 0 No error. !> - -1 Unexpected end of file when reading. @@ -1254,7 +2058,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & CALL EXTCDE ( 1 ) END IF ! - ! IF ( IPASS.EQ.1 ) THEN + ! First pass to this file and we are only writing 1 file for all time IF ( IPASS.EQ.1 .AND. OFILES(2) .EQ. 0) THEN WRITE = INXOUT.EQ.'WRITE' ELSE @@ -1267,10 +2071,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! open file ---------------------------------------------------------- * ! IF ( IPASS.EQ.1 .AND. OFILES(2) .EQ. 0 ) THEN - ! + I = LEN_TRIM(FILEXT) J = LEN_TRIM(FNMPRE) - ! + #ifdef W3_T WRITE (NDST,9001) FNMPRE(:J)//'out_pnt.'//FILEXT(:I) #endif @@ -1389,7 +2193,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! IF ( WRITE ) THEN WRITE (NDSOP) & - IDSTR, VEROPT, NK, NTH, NOPTS + IDSTR, VEROPT, NK, NTH, NOPTS #ifdef W3_ASCII WRITE (NDSOA,*) & 'IDSTR, VEROPT, NK, NTH, NOPTS:', & @@ -1495,7 +2299,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & #endif 'ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I):', & ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I), & - 'ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC):', & + 'ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC):', & ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) #endif ELSE diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index c144ab8d8d..6db2f03af0 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -2601,12 +2601,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! Gets the necessary spectral data ! CALL W3IOPE ( VA ) - CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD & +#ifdef W3_BIN2NC + CALL W3IOPON ( 'WRITE', NDS(8), ITEST, IMOD ) +#else + CALL W3IOPO ( 'WRITE', NDS(8), ITEST, IMOD & #ifdef W3_ASCII ,NDS(15) & #endif ) - END IF +#endif + END IF ! ELSE IF ( J .EQ. 3 ) THEN ! diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index 73e0365354..bce460483c 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -714,8 +714,7 @@ SUBROUTINE WMIOPO ( TOUT ) USE W3ODATMD, ONLY: W3SETO USE WMMDATMD, ONLY: WMSETM USE W3CSPCMD, ONLY: W3CSPC - USE W3IOPOMD, ONLY: W3IOPO - ! + USE W3IOPOMD USE W3GDATMD, ONLY: NK, NTH, NSPEC, XFR, FR1, TH, SGRDS USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPPNT, NOPTS, SPCO, DPO, & @@ -1176,11 +1175,15 @@ SUBROUTINE WMIOPO ( TOUT ) ! TIME = TOUT ! +#ifdef W3_BIN2NC + CALL W3IOPON ( 'WRITE', MDSUP, II, 0) +#else CALL W3IOPO ( 'WRITE', MDSUP, II, 0 & #ifdef W3_ASCII - ,MDSUPA & + ,MDSUPA & #endif ) +#endif ! RETURN ! diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index c35ff6e98e..a1533c73b8 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -184,7 +184,7 @@ PROGRAM W3OUNP USE W3ODATMD, ONLY: W3SETO, W3NOUT USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT, DIMP USE W3IOGRMD, ONLY: W3IOGR - USE W3IOPOMD, ONLY: W3IOPO + USE W3IOPOMD USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, STRSPLIT #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -387,7 +387,11 @@ PROGRAM W3OUNP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! +#if W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif ! IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,930) DO I=1, NOPTS @@ -604,7 +608,11 @@ PROGRAM W3OUNP DO WHILE (DTEST.NE.0) DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) GOTO 888 @@ -1070,7 +1078,11 @@ PROGRAM W3OUNP DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN ! reads TIME from out_pnt.ww3 +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) GOTO 700 @@ -1215,7 +1227,11 @@ PROGRAM W3OUNP ! 7.3 Reinitiazes TIME (close open out_pnt.ww3) and TOUT to process a new bunch of stations CLOSE(NDSOP) ! closes binary file out_pnt* IPASS = 0 ! resets time counter for binary file out_pnt* +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif #ifdef W3_T WRITE(NDSE,*) 'out_pnt* closed and reopened' #endif @@ -1228,7 +1244,11 @@ PROGRAM W3OUNP DO WHILE (DTEST.NE.0) DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) GOTO 700 diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index 6d750687a9..d793783ca0 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -208,13 +208,16 @@ PROGRAM W3OUTP #endif USE W3ODATMD, ONLY: W3SETO, W3NOUT USE W3IOGRMD, ONLY: W3IOGR +#ifdef W3_BIN2NC + USE W3IOPOMD, ONLY: W3IOPON, W3IOPON_READ, W3IOPON_WRITE +#else USE W3IOPOMD, ONLY: W3IOPO +#endif USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif USE W3TIMEMD, ONLY: STME21, TICK21, DSEC21 - !/ USE W3GDATMD USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: NDSE, NDST, NDSO, NOPTS, PTLOC, PTNME, & @@ -359,7 +362,11 @@ PROGRAM W3OUTP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file ! +#if W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif ! WRITE (NDSO,930) DO I=1, NOPTS @@ -457,7 +464,11 @@ PROGRAM W3OUTP DO CALL STME21 ( TIME , IDTIME ) WRITE (NDSO,948) IDTIME +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,949) GOTO 888 @@ -777,7 +788,11 @@ PROGRAM W3OUTP DO DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN +#ifdef W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) +#else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) +#endif IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,949) EXIT diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 819ea01018..824b358f17 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -180,6 +180,7 @@ if [ "$prop2D" = 'y' ] then echo ' ' >> matrix.body + echo "$rtst -s PR1_MPI_BIN2NC -w work_PR1_MPI_BIN2NC -f -p $mpi -n $np $ww3 ww3_tp2.2" >> matrix.body echo "$rtst -s PR1_MPI -w work_PR1_MPI -f -p $mpi -n $np $ww3 ww3_tp2.1" >> matrix.body echo "$rtst -s PR1_MPI -w work_PR1_MPI -f -p $mpi -n $np $ww3 ww3_tp2.2" >> matrix.body echo "$rtst -s PR1_MPI -w work_PR1_MPI -f -p $mpi -n $np $ww3 ww3_tp2.3" >> matrix.body diff --git a/regtests/unittests/CMakeLists.txt b/regtests/unittests/CMakeLists.txt index 69445bfb79..1d3d81f60d 100644 --- a/regtests/unittests/CMakeLists.txt +++ b/regtests/unittests/CMakeLists.txt @@ -24,16 +24,25 @@ endfunction() # Function to build and run a test. function(unit_test name) - add_executable(${name} ${name}.F90) + add_executable(${name} ${name}.F90 ww3_unittest_util.F90) target_link_libraries(${name} PRIVATE ww3_lib) add_test(NAME ${name} COMMAND ${name}) endfunction() +# The binary file mod_def.ww3 is needed for testing. It's created by +# the ww3_grid utility. +#add_custom_target(create_mod_def TEST ../../bin/ww3_grid +# COMMENT "Creating mod_def.ww3 file for testing") + # Copy test data files that are in the repo to the build directory. copy_test_data(switch.io) copy_test_data_2(ww3_grid.inp ww3_grid.inp) # Build and run the tests. unit_test(test_io_points_bin) +unit_test(test_io) +unit_test(test_io2) +unit_test(test_io3) +unit_test(test_io_restart_bin) diff --git a/regtests/unittests/test_io.F90 b/regtests/unittests/test_io.F90 new file mode 100644 index 0000000000..ebe4e23850 --- /dev/null +++ b/regtests/unittests/test_io.F90 @@ -0,0 +1,117 @@ +! This is a test for model IO for WW3. +! +! Ed Hartnett 10/14/23 +program test_io + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i, j, k, l + integer :: ndsop, iotest, imod, ndstst, ierr, ndsbul, ndsm + integer :: ndstrc, ntrace + real :: m2km + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 netCDF point file code.' + + ! These are mysterious but have to be called or else the IPASS + ! variable does not exist and w3iopo() crashes. + call w3nmod(1, 6, 6) + call w3setg(1, 6, 6) + call w3ndat(6, 6) + call w3setw(1, 6, 6) + call w3nout(6, 6) + call w3seto(1, 6, 6) + + ndsm = 20 + ndsop = 20 + ndsbul = 0 + ndstrc = 6 + ntrace = 10 + imod = 1 + + write (ndso,900) +900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & + 15X,'==============================================='/) + + ! Open the file with the output settings for WW3. It is not needed actually. + ! open(ndsi, file = 'ww3_outp.inp', status='old', iostat = ierr) + ! if (ierr .ne. 0) stop 10 + + ! Create a point output file needed for this test. + print *, 'Creating point output test file for this test...' + if (write_test_file() .ne. 0) stop 1 + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! IF (FLAGLL) THEN + ! M2KM = 1. + ! ELSE + ! M2KM = 1.E-3 + ! END IF + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + print *, 'OK!' + print *, 'Reading the point output test file for this test...' + call w3iopo('READ', ndsop, iotest) + if (iotest .ne. 0) stop 10 + close(ndsop) + + ! Make sure we got the values we expected. + if (nopts .ne. 11) stop 11 + expected_loc_1 = 0.0 + do i = 1, nopts + ! Check ptnme and ptloc arrays. + print *, ptnme(i), ptloc(1, i), ptloc(2, i) + if (i .lt. 10) then + my_fmt = '(a,i1)' + else + my_fmt = '(a,i2)' + endif + write(fmt = my_fmt, unit=expected_ptnme) 'Point', i + if (ptnme(i) .ne. expected_ptnme) stop 20 + print *, expected_loc_1 + if (ptloc(1, i) .ne. expected_loc_1) stop 21 + expected_loc_1 = expected_loc_1 + 5000.0 + if (ptloc(2, i) .ne. 0) stop 22 + end do + + print *, 'OK!' + print *, 'initializing some data...' + ipass2 = 0 + do i = 1, nopts + do j = 1, nspec + spco(j, i) = 0.0 + end do + end do + + print *, 'OK!' + print *, 'testing writing the WW3 binary point file in netCDF...' + + ! Write in netCDF. + call w3iopon('WRITE', ndsop, iotest, imod) + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'testing reading the WW3 binary point file in netCDF...' + ipass2 = 0 + call w3iopon('READ', ndsop, iotest, imod) + print *, iotest + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'OK!' + + print *, 'SUCCESS!' +end program test_io + diff --git a/regtests/unittests/test_io2.F90 b/regtests/unittests/test_io2.F90 new file mode 100644 index 0000000000..b7fe5092d9 --- /dev/null +++ b/regtests/unittests/test_io2.F90 @@ -0,0 +1,123 @@ +! This is a test for model IO for WW3. +! +! Ed Hartnett 10/14/23 +program test_io2 + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i, j, k, l + integer :: ndsop, iotest, imod, ndstst, ierr, ndsbul, ndsm + integer :: ndstrc, ntrace + real :: m2km + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 netCDF point file code some more.' + + ! These are mysterious but have to be called or else the IPASS + ! variable does not exist and w3iopo() crashes. + call w3nmod(1, 6, 6) + call w3setg(1, 6, 6) + call w3ndat(6, 6) + call w3setw(1, 6, 6) + call w3nout(6, 6) + call w3seto(1, 6, 6) + + ndsm = 20 + ndsop = 20 + ndsbul = 0 + ndstrc = 6 + ntrace = 10 + imod = 1 + + write (ndso,900) +900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & + 15X,'==============================================='/) + + ! Open the file with the output settings for WW3. It is not needed actually. + ! open(ndsi, file = 'ww3_outp.inp', status='old', iostat = ierr) + ! if (ierr .ne. 0) stop 10 + + ! Create a point output file needed for this test. + print *, 'Creating point output test file for this test...' + if (write_test_file() .ne. 0) stop 1 + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! IF (FLAGLL) THEN + ! M2KM = 1. + ! ELSE + ! M2KM = 1.E-3 + ! END IF + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + print *, 'OK!' + print *, 'Reading the point output test file for this test...' + call w3iopo('READ', ndsop, iotest) + if (iotest .ne. 0) stop 10 + close(ndsop) + + ! Make sure we got the values we expected. + if (nopts .ne. 11) stop 11 + expected_loc_1 = 0.0 + do i = 1, nopts + ! Check ptnme and ptloc arrays. + print *, ptnme(i), ptloc(1, i), ptloc(2, i) + if (i .lt. 10) then + my_fmt = '(a,i1)' + else + my_fmt = '(a,i2)' + endif + write(fmt = my_fmt, unit=expected_ptnme) 'Point', i + if (ptnme(i) .ne. expected_ptnme) stop 20 + print *, expected_loc_1 + if (ptloc(1, i) .ne. expected_loc_1) stop 21 + expected_loc_1 = expected_loc_1 + 5000.0 + if (ptloc(2, i) .ne. 0) stop 22 + end do + + print *, 'OK!' + print *, 'initializing some data...' + ipass2 = 0 + do i = 1, nopts + do j = 1, nspec + spco(j, i) = 0.0 + end do + end do + + print *, 'OK!' + print *, 'testing writing the WW3 binary point file in netCDF...' + + ! Write in netCDF. + ofiles(2) = 1 + call w3iopon('WRITE', ndsop, iotest, imod) + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + ! Another timestep in netCDF. + call w3iopon('WRITE', ndsop, iotest, imod) + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'testing reading the WW3 binary point file in netCDF...' + ipass2 = 0 + call w3iopon('READ', ndsop, iotest) + print *, iotest + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'OK!' + + print *, 'SUCCESS!' +end program test_io2 + diff --git a/regtests/unittests/test_io3.F90 b/regtests/unittests/test_io3.F90 new file mode 100644 index 0000000000..b5f65849c3 --- /dev/null +++ b/regtests/unittests/test_io3.F90 @@ -0,0 +1,110 @@ +! This is a test for model IO for WW3. +! +! Ed Hartnett 10/14/23 +program test_io3 + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + + integer, target :: i, j, k, l + integer :: ndsop, iotest, imod, ndstst, ierr, ndsbul, ndsm + integer :: ndstrc, ntrace + real :: m2km + character*7 expected_ptnme + character*6 my_fmt + real :: expected_loc_1 + integer :: write_test_file + + print *, 'Testing WW3 netCDF point file code even more.' + + ! These are mysterious but have to be called or else the IPASS + ! variable does not exist and w3iopo() crashes. + call w3nmod(1, 6, 6) + call w3setg(1, 6, 6) + call w3ndat(6, 6) + call w3setw(1, 6, 6) + call w3nout(6, 6) + call w3seto(1, 6, 6) + + nth = 4 + ndsm = 20 + ndsop = 20 + ndsbul = 0 + ndstrc = 6 + ntrace = 10 + imod = 1 + + ! 2. Read model definition file. + CALL W3IOGR('READ', NDSM) + WRITE (NDSO,920) GNAME +920 FORMAT (' Grid name : ',A/) + + ! Create a point output file needed for this test. + print *, 'Creating point output test file for this test...' + if (write_test_file() .ne. 0) stop 1 + + ! Read the file out_pnt.ww3 from the model/tests/data directory. + ! print *, 'OK!' + ! print *, 'Reading the point output test file for this test...' + call w3iopo('READ', ndsop, iotest) + if (iotest .ne. 0) stop 10 + close(ndsop) + + ! ! Make sure we got the values we expected. + ! if (nopts .ne. 11) stop 11 + ! expected_loc_1 = 0.0 + ! do i = 1, nopts + ! ! Check ptnme and ptloc arrays. + ! print *, ptnme(i), ptloc(1, i), ptloc(2, i) + ! if (i .lt. 10) then + ! my_fmt = '(a,i1)' + ! else + ! my_fmt = '(a,i2)' + ! endif + ! write(fmt = my_fmt, unit=expected_ptnme) 'Point', i + ! if (ptnme(i) .ne. expected_ptnme) stop 20 + ! print *, expected_loc_1 + ! if (ptloc(1, i) .ne. expected_loc_1) stop 21 + ! expected_loc_1 = expected_loc_1 + 5000.0 + ! if (ptloc(2, i) .ne. 0) stop 22 + ! end do + + print *, 'OK!' + print *, 'initializing some data...' + ipass2 = 0 + do i = 1, nopts + do j = 1, nspec + spco(j, i) = 0.0 + end do + end do + + print *, 'OK!' + print *, 'testing writing the WW3 binary point file in netCDF...' + + ! ! Write in netCDF. + ! ofiles(2) = 1 + ! call w3iopon('WRITE', ndsop, iotest, imod) + ! if (iotest .ne. 0) stop 100 + ! print *, 'OK!' + + ! ! Another timestep in netCDF. + ! call w3iopon('WRITE', ndsop, iotest, imod) + ! if (iotest .ne. 0) stop 100 + ! print *, 'OK!' + + print *, 'testing reading the WW3 binary point file in netCDF...' + ipass2 = 0 + call w3iopon('READ', ndsop, iotest) + print *, iotest + if (iotest .ne. 0) stop 100 + print *, 'OK!' + + print *, 'OK!' + + print *, 'SUCCESS!' +end program test_io3 + diff --git a/regtests/unittests/test_io_points_bin.F90 b/regtests/unittests/test_io_points_bin.F90 index 69c197bce8..4093b24bad 100644 --- a/regtests/unittests/test_io_points_bin.F90 +++ b/regtests/unittests/test_io_points_bin.F90 @@ -79,74 +79,3 @@ program test_io_points_bin print *, 'OK!' print *, 'SUCCESS!' end program test_io_points_bin - -integer function write_test_file() - implicit none - - integer :: ntlu, nk, nth, nopts - character(len=10), parameter :: veropt = '2021-04-06' - character(len=31), parameter :: idstr = 'WAVEWATCH III POINT OUTPUT FILE' - real :: ptloc(2,11) = reshape((/ 0., 0., 5000., 0., 10000., 0., 15000., 0., & - 20000., 0., 25000., 0., 30000., 0., 35000., 0., 40000., 0., 45000., 0., 50000., 0. /), & - (/ 2, 11 /)) - character*40 ptnme(11) - integer :: time(2) = (/ 19680606, 0 /) - integer :: nspec = 72 - integer :: iw(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) - integer :: ii(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) - integer :: il(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) - real :: iceo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) - real :: iceho(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) - real :: icefo(11) = (/ 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000. /) - real :: dpo(11) = (/ 50., 50., 45., 40., 35., 30., 25., 20., 15., 10., 5. /) - real :: wao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) - real :: wdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) - real :: aso(11) = (/ -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, & - -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, -999.900024 /) - real :: cao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) - real :: cdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) - character*13 :: grdid(11) - real :: spco(72, 11) - integer :: i, j - integer :: ierr - - ! Initialize some values. - ntlu = 21 - nk = 3 - nth = 24 - nopts = 11 - do i = 1, nopts - if (i .le. 9) then - write(ptnme(i), '(a,i1)') 'Point', i - else - write(ptnme(i), '(a,i2)') 'Point', i - endif - grdid(i) = 'ww3 ' - end do - - ! Open the file. - open(ntlu, file="out_pnt.ww3", form="unformatted", status="replace", & - action="write", convert="big_endian", iostat=ierr) - if (ierr .ne. 0) stop 111 - - ! Write our values. - write (ntlu, iostat=ierr) idstr, veropt, nk, nth, nopts - if (ierr .ne. 0) stop 112 - write (ntlu, iostat=ierr) ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts) - if (ierr .ne. 0) stop 113 - write (ntlu, iostat=ierr) time - if (ierr .ne. 0) stop 114 - do i=1, nopts - write (ntlu, iostat=ierr) iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), & - aso(i), cao(i), cdo(i), iceo(i), iceho(i), & - icefo(i), grdid(i), (spco(j,i),j=1,nspec) - if (ierr .ne. 0) stop 115 - enddo - - ! Close the file. - close(ntlu) - - ! We're done! - write_test_file = 0 -end function write_test_file - diff --git a/regtests/unittests/test_io_restart_bin.F90 b/regtests/unittests/test_io_restart_bin.F90 new file mode 100644 index 0000000000..026e8d3d2e --- /dev/null +++ b/regtests/unittests/test_io_restart_bin.F90 @@ -0,0 +1,59 @@ +! This is a test for model IO for WW3. This tests the legacy (binary) +! output of restart data, done by function W3IORS(). +! +! Ed Hartnett 1/13/24 +program test_io_restart_bin + use w3iorsmd + use w3iopomd + use w3gdatmd + use w3wdatmd + use w3odatmd + use w3iogrmd + use w3adatmd + implicit none + +! integer, target :: i +! integer :: ndsop, iotest, ndsbul, ndsm +! integer :: ndstrc, ntrace +! character*7 expected_ptnme +! character*6 my_fmt +! real :: expected_loc_1 +! integer :: ndsr = 11 +! real :: dumfpi = 99.9 + +! print *, 'Testing WW3 binary restart file code.' + +! ! These are mysterious but have to be called or else the IPASS +! ! variable does not exist and w3iopo() crashes. +! call w3nmod(1, 6, 6) +! call w3setg(1, 6, 6) +! call w3ndat(6, 6) +! call w3setw(1, 6, 6) +! call w3nout(6, 6) +! call w3seto(1, 6, 6) + +! ndsm = 20 +! ndsop = 20 +! ndsbul = 0 +! ndstrc = 6 +! ntrace = 10 + +! write (ndso,900) +! 900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & +! 15X,'==============================================='/) + +! ! 2. Read model definition file. +! CALL W3IOGR('READ', NDSM) +! WRITE (NDSO,920) GNAME +! 920 FORMAT (' Grid name : ',A/) + +! ! Read the file out_pnt.ww3 from the model/tests/data directory. +! call w3iors('HOT', ndsr, dumfpi) +! if (iotest .ne. 0) stop 10 +! close(ndsop) + + + print *, 'OK!' + print *, 'SUCCESS!' +end program test_io_restart_bin + diff --git a/regtests/unittests/ww3_unittest_util.F90 b/regtests/unittests/ww3_unittest_util.F90 new file mode 100644 index 0000000000..fe20ddb30d --- /dev/null +++ b/regtests/unittests/ww3_unittest_util.F90 @@ -0,0 +1,75 @@ +! This is test code for the WW3 I/O unit tests. +! +! This file holds a function used by multiple tests. +! +! Ed Hartnett, 1/11/24 +integer function write_test_file() + implicit none + + integer :: ntlu, nk, nth, nopts + character(len=10), parameter :: veropt = '2021-04-06' + character(len=31), parameter :: idstr = 'WAVEWATCH III POINT OUTPUT FILE' + real :: ptloc(2,11) = reshape((/ 0., 0., 5000., 0., 10000., 0., 15000., 0., & + 20000., 0., 25000., 0., 30000., 0., 35000., 0., 40000., 0., 45000., 0., 50000., 0. /), & + (/ 2, 11 /)) + character*40 ptnme(11) + integer :: time(2) = (/ 19680606, 0 /) + integer :: nspec = 72 + integer :: iw(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer :: ii(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + integer :: il(11) = (/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /) + real :: iceo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: iceho(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: icefo(11) = (/ 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000., 1000. /) + real :: dpo(11) = (/ 50., 50., 45., 40., 35., 30., 25., 20., 15., 10., 5. /) + real :: wao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: wdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: aso(11) = (/ -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, & + -999.900024, -999.900024, -999.900024, -999.900024, -999.900024, -999.900024 /) + real :: cao(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + real :: cdo(11) = (/ 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /) + character*13 :: grdid(11) + real :: spco(72, 11) + integer :: i, j + integer :: ierr + + ! Initialize some values. + ntlu = 21 + nk = 3 + nth = 24 + nopts = 11 + do i = 1, nopts + if (i .le. 9) then + write(ptnme(i), '(a,i1)') 'Point', i + else + write(ptnme(i), '(a,i2)') 'Point', i + endif + grdid(i) = 'ww3 ' + end do + + ! Open the file. + open(ntlu, file="out_pnt.ww3", form="unformatted", status="replace", & + action="write", convert="big_endian", iostat=ierr) + if (ierr .ne. 0) stop 111 + + ! Write our values. + write (ntlu, iostat=ierr) idstr, veropt, nk, nth, nopts + if (ierr .ne. 0) stop 112 + write (ntlu, iostat=ierr) ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts) + if (ierr .ne. 0) stop 113 + write (ntlu, iostat=ierr) time + if (ierr .ne. 0) stop 114 + do i=1, nopts + write (ntlu, iostat=ierr) iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), & + aso(i), cao(i), cdo(i), iceo(i), iceho(i), & + icefo(i), grdid(i), (spco(j,i),j=1,nspec) + if (ierr .ne. 0) stop 115 + enddo + + ! Close the file. + close(ntlu) + + ! We're done! + write_test_file = 0 +end function write_test_file + diff --git a/regtests/ww3_tp2.2/input/switch_PR1_MPI_BIN2NC b/regtests/ww3_tp2.2/input/switch_PR1_MPI_BIN2NC new file mode 100644 index 0000000000..bb79e85495 --- /dev/null +++ b/regtests/ww3_tp2.2/input/switch_PR1_MPI_BIN2NC @@ -0,0 +1 @@ +NOGRB DIST MPI PR1 FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 BIN2NC diff --git a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB index ff569c11fe..0927be62de 100644 --- a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB +++ b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB @@ -1 +1 @@ -PDLIB SCOTCH NOGRB DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD1 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 +PDLIB SCOTCH NOGRB DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD1 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 BIN2NC From f22c38a534048b670eace57937c488e14321b30c Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 24 Jun 2024 05:38:54 -0700 Subject: [PATCH 048/136] Fix GNU regtest CI failure (#1253) --- .github/workflows/regtest_gnu.yml | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/.github/workflows/regtest_gnu.yml b/.github/workflows/regtest_gnu.yml index 81d1317a3c..d5b71673c3 100644 --- a/.github/workflows/regtest_gnu.yml +++ b/.github/workflows/regtest_gnu.yml @@ -91,7 +91,7 @@ jobs: spack ~/.spack work_oasis3-mct - key: spack2-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} + key: spack-${{ runner.os }}-${{ env.cache_key }}-${{ hashFiles('ww3/model/ci/spack_gnu.yaml') }} - name: build-ww3 run: | @@ -102,10 +102,10 @@ jobs: export CC=mpicc export FC=mpif90 export OASISDIR=${GITHUB_WORKSPACE}/work_oasis3-mct -# mkdir build && cd build + # mkdir build && cd build export LD_LIBRARY_PATH="/home/runner/work/WW3/WW3/spack/var/spack/environments/ww3-gnu/.spack-env/view/:$LD_LIBRARY_PATH" -# cmake -DSWITCH=${GITHUB_WORKSPACE}/ww3/regtests/unittests/data/switch.io -DCMAKE_BUILD_TYPE=Debug .. -# make -j2 VERBOSE=1 + # cmake -DSWITCH=${GITHUB_WORKSPACE}/ww3/regtests/unittests/data/switch.io -DCMAKE_BUILD_TYPE=Debug .. + # make -j2 VERBOSE=1 cd ${GITHUB_WORKSPACE}/ww3 ls -l ${GITHUB_WORKSPACE}/ww3/model/bin/ww3_from_ftp.sh -k @@ -116,18 +116,15 @@ jobs: cd work_PR1_MPI pwd ls -l - ncdump -h out_pnt.ww3.nc > ncdump_out.txt - cat ncdump_out.txt - pwd - cat ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt - cmp ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt ncdump_out.txt - + # ncdump -h out_pnt.ww3.nc > ncdump_out.txt + # cat ncdump_out.txt + # pwd + # cat ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt + # cmp ${GITHUB_WORKSPACE}/ww3/regtests/ww3_tp2.5/out_pnt_ncdump.txt ncdump_out.txt + - name: cache-data id: cache-data uses: actions/cache@v3 with: path: ww3/ww3_from_ftp.v7.14.1.tar.gz key: ww3_from_ftp.v7.14.1 - - - From af38c437084308dd06ea1b03886cad7d2805ee33 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Wed, 3 Jul 2024 06:18:40 -0700 Subject: [PATCH 049/136] Fix code stability issue in ww3_outp (#1258) Co-authored-by: saeideh banihashemi --- model/src/w3bullmd.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/model/src/w3bullmd.F90 b/model/src/w3bullmd.F90 index 10301e8ca2..af749549a1 100644 --- a/model/src/w3bullmd.F90 +++ b/model/src/w3bullmd.F90 @@ -268,8 +268,8 @@ SUBROUTINE W3BULL & ! CSVBLINE = BLANK2 ! + IPG1 = 0 IF (IOUT .EQ. 1) THEN - IPG1 = 0 DO IP=1, NPTAB HST(IP,1) = -99.9 TPT(IP,1) = -99.9 @@ -286,10 +286,12 @@ SUBROUTINE W3BULL & ! HSTOT = XPART(1,0) TP = XPART(2,0) - HSP = XPART(1,1:NPART) - TPP = XPART(2,1:NPART) - WNP = TPI / XPART(3,1:NPART) - DMP = MOD( XPART(4,1:NPART) + 180., 360.) + DO IP=1, NPART + HSP(IP) = XPART(1,IP) + TPP(IP) = XPART(2,IP) + WNP(IP) = TPI / XPART(3,IP) + DMP(IP) = MOD( XPART(4,IP) + 180., 360.) + ENDDO NZERO = 0 NZERO = COUNT( HSP <= BHSMIN .AND. HSP /= 0. ) From ca58c139e9f4b25250d9292afbfe169c7171c03c Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 15 Jul 2024 05:49:21 -0700 Subject: [PATCH 050/136] Updates to NCEP regtests for Orion Rocky9 OS(#1263) --- regtests/bin/matrix_cmake_ncep | 52 +++++++++++++++++----------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/regtests/bin/matrix_cmake_ncep b/regtests/bin/matrix_cmake_ncep index 2eafd89869..1fa1a2d6fd 100755 --- a/regtests/bin/matrix_cmake_ncep +++ b/regtests/bin/matrix_cmake_ncep @@ -22,11 +22,11 @@ usage () { cat 2>&1 << EOF - Usage: $myname model_dir compiler + Usage: $myname model_dir compiler Required: model_dir : path to model dir of WW3 source - Optional: - compiler : intel (default) or gnu + Optional: + compiler : intel (default) or gnu EOF } @@ -36,16 +36,16 @@ EOF main_dir="$1" ; shift if [ ! $# = 0 ] then - compiler="$1"; shift - else + compiler="$1"; shift + else compiler='intel' - fi + fi else usage exit 1 fi - - + + # Convert main_dir to absolute path main_dir="`cd $main_dir 1>/dev/null 2>&1 && pwd`" @@ -60,51 +60,51 @@ EOF modbacio='bacio/2.4.1' modg2='g2/3.4.5' modw3emc='w3emc/2.10.0' - modesmf='esmf/8.5.0' + modesmf='esmf/8.6.0' modscotch='scotch/7.0.4' # Set batchq queue, choose modules and other custom variables to fit system and # to define headers etc (default to original version if empty) ishera=`hostname | grep hfe` - isorion=`hostname | grep Orion` + isorion=`hostname | grep orion` ishercules=`hostname | grep hercules` if [ $ishera ] then batchq='slurm' if [ $compiler = "intel" ] - then + then spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.6.0/envs/unified-env-rocky8/install/modulefiles/Core' modcomp='stack-intel/2021.5.0' modmpi='stack-intel-oneapi-mpi/2021.5.1' metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hera/intel/spack-stack/1.6.0/parmetis-4.0.3/install' modcmake='cmake/3.23.1' elif [ $compiler = "gnu" ] - then + then spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.6.0/envs/unified-env-rocky8/install/modulefiles/Core' modcomp='stack-gcc/9.2.0' modmpi='stack-openmpi/4.1.5' metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hera/gnu/spack-stack/1.6.0/parmetis-4.0.3/install' modcmake='cmake/3.23.1' - else - echo "Compiler $compiler not supported on hera" - exit 1 - fi + else + echo "Compiler $compiler not supported on hera" + exit 1 + fi elif [ $isorion ] then if [ $compiler = "intel" ] then batchq='slurm' - spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' - modcomp='stack-intel/2022.0.2' - modmpi='stack-intel-oneapi-mpi/2021.5.1' + spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.6.0/envs/unified-env-rocky9/install/modulefiles/Core' + modcomp='stack-intel/2021.9.0' + modmpi='stack-intel-oneapi-mpi/2021.9.0' metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/orion/intel/spack-stack/1.6.0/parmetis-4.0.3/install' modcmake='cmake/3.23.1' else - echo "Compiler $compiler not supported on orion" + echo "Compiler $compiler not supported on orion" exit 1 - fi - elif [ $ishercules ] - then + fi + elif [ $ishercules ] + then batchq='slurm' if [ $compiler = "intel" ] then @@ -114,7 +114,7 @@ EOF metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/hercules/intel/spack-stack/1.6.0/parmetis-4.0.3/install' modcmake='cmake/3.23.1' elif [ $compiler = "gnu" ] - then + then spackstackpath='/work/noaa/epic/role-epic/spack-stack/hercules/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' spackstackpath2='/work/noaa/epic/role-epic/spack-stack/hercules/modulefiles' modcomp='stack-gcc/12.2.0' @@ -122,7 +122,7 @@ EOF metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/hercules/gnu/spack-stack/1.6.0/parmetis-4.0.3/install' modcmake='cmake/3.23.1' else - echo "Compiler $compiler not supported on hercules" + echo "Compiler $compiler not supported on hercules" exit 1 fi else @@ -195,7 +195,7 @@ EOF echo " module use $spackstackpath" >> matrix.head if [ ! -z $spackstackpath2 ]; then echo " module use $spackstackpath2" >> matrix.head - fi + fi echo " module load $modcomp" >> matrix.head echo " module load $modmpi" >> matrix.head echo " module load $modcmake" >> matrix.head From a2c086e69467b1a3ca28287a62ab4b0cd9e3c8a5 Mon Sep 17 00:00:00 2001 From: Chris Bunney <48915820+ukmo-ccbunney@users.noreply.github.com> Date: Fri, 19 Jul 2024 17:23:36 +0100 Subject: [PATCH 051/136] Add depth scaling value to SMC regression tests. (#1264) --- regtests/ww3_tp2.10/input/ww3_grid.nml | 7 +++++++ regtests/ww3_tp2.16/input/ww3_grid.nml | 7 +++++++ 2 files changed, 14 insertions(+) diff --git a/regtests/ww3_tp2.10/input/ww3_grid.nml b/regtests/ww3_tp2.10/input/ww3_grid.nml index ee9ac10e49..26e0465dc3 100644 --- a/regtests/ww3_tp2.10/input/ww3_grid.nml +++ b/regtests/ww3_tp2.10/input/ww3_grid.nml @@ -67,6 +67,13 @@ SMC%SUBTR%FILENAME = '../input/ErieObstr.dat' / +! -------------------------------------------------------------------- ! +! Scaling factor for depth input file +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -1.0 +/ + ! -------------------------------------------------------------------- ! ! WAVEWATCH III - end of namelist ! ! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.16/input/ww3_grid.nml b/regtests/ww3_tp2.16/input/ww3_grid.nml index 19b0fdc05d..c97e3126d8 100644 --- a/regtests/ww3_tp2.16/input/ww3_grid.nml +++ b/regtests/ww3_tp2.16/input/ww3_grid.nml @@ -70,6 +70,13 @@ SMC%AJSID%FILENAME = '../input/A50AJSide.dat' / +! -------------------------------------------------------------------- ! +! Scaling factor for depth input file +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -1.0 +/ + ! -------------------------------------------------------------------- ! ! WAVEWATCH III - end of namelist ! ! -------------------------------------------------------------------- ! From b4e119e18c747fe20d5794ab6dfa33bdc3617aed Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 19 Jul 2024 14:23:36 -0400 Subject: [PATCH 052/136] Simplify MPI ifdefs in subroutine W3MPIO (#1266) --- model/src/w3initmd.F90 | 620 ----------------------------------------- 1 file changed, 620 deletions(-) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 044a18760c..4badbcb1a3 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -2272,22 +2272,18 @@ SUBROUTINE W3MPIO ( IMOD ) ! IF ( IAPROC .LE. NAPROC ) THEN IT = IT0 -#endif #ifdef W3_MPIT WRITE (NDST,9010) '(SEND)' #endif ! -#ifdef W3_MPI IF ( FLGRDALL( 1, 12) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (ICEF (IAPROC), 1, WW3_FIELD_VEC, IROOT, IT, & MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 1/09', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 1) ) THEN @@ -2295,11 +2291,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (HS (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 2) ) THEN @@ -2307,11 +2301,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WLM (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 3) ) THEN @@ -2319,11 +2311,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (T02 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 4) ) THEN @@ -2331,11 +2321,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (T0M1 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 5) ) THEN @@ -2343,11 +2331,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (T01 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 6) .OR. FLGRDALL( 2,18) ) THEN @@ -2356,11 +2342,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (FP0 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 7) ) THEN @@ -2368,11 +2352,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (THM (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/07', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 8) ) THEN @@ -2380,11 +2362,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (THS (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/09', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 9) ) THEN @@ -2392,11 +2372,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (THP0 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/09', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 10) ) THEN @@ -2404,11 +2382,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (HSIG (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/10', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 11) ) THEN @@ -2416,11 +2392,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (STMAXE (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/11', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 12) ) THEN @@ -2428,11 +2402,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (STMAXD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/12', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 13) ) THEN @@ -2440,11 +2412,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (HMAXE (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/13', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 14) ) THEN @@ -2452,11 +2422,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (HCMAXE (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/14', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 15) ) THEN @@ -2464,11 +2432,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (HMAXD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/15', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 16) ) THEN @@ -2476,11 +2442,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (HCMAXD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/16', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 17) ) THEN @@ -2488,11 +2452,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WBT (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/17', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 19) ) THEN @@ -2500,11 +2462,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WNMEAN(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/19', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 3, 1) ) THEN @@ -2513,11 +2473,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (EF(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'EF', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2527,11 +2485,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TH1M(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'TH1M', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2541,11 +2497,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (STH1M(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'STH1M', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2555,11 +2509,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TH2M(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'TH2M', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2569,11 +2521,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (STH2M(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'STH2M', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2583,11 +2533,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PHS(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2597,11 +2545,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PTP(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2611,11 +2557,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PLP(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2625,11 +2569,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PDIR(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2639,11 +2581,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PSI(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2653,11 +2593,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PWS(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2667,11 +2605,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PTHP0(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/07', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2681,11 +2617,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PQP (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/08', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2695,11 +2629,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PPE (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/09', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2709,11 +2641,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PGW (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/10', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2723,11 +2653,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PSW (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/11', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2737,11 +2665,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PTM1(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/12', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2752,11 +2678,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PT1 (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/13', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2766,11 +2690,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PT2 (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/14', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2780,11 +2702,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PEP (1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/15', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -2793,11 +2713,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PWST (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/16', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 4,17) ) THEN @@ -2805,11 +2723,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PNR (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/17', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 1) ) THEN @@ -2817,29 +2733,23 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (UST (IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (USTDIR(IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (ASF (IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 2) ) THEN @@ -2847,11 +2757,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (CHARN(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 3) ) THEN @@ -2859,11 +2767,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (CGE (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 4) ) THEN @@ -2871,11 +2777,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PHIAW(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 5) ) THEN @@ -2883,20 +2787,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TAUWIX(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TAUWIY(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 6) ) THEN @@ -2904,20 +2804,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TAUWNX(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TAUWNY(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 7) ) THEN @@ -2925,11 +2821,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WHITECAP(1,1),NSEALM , MPI_REAL, IROOT,& IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/07', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 8) ) THEN @@ -2937,11 +2831,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WHITECAP(1,2),NSEALM , MPI_REAL, IROOT,& IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/08', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 9) ) THEN @@ -2949,11 +2841,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WHITECAP(1,3),NSEALM , MPI_REAL, IROOT,& IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/09', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5,10) ) THEN @@ -2961,11 +2851,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (WHITECAP(1,4),NSEALM , MPI_REAL, IROOT,& IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/10', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 11) ) THEN @@ -2973,11 +2861,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TWS(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/11', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 1) ) THEN @@ -2985,29 +2871,23 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (SXX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (SYY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (SXY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 2) ) THEN @@ -3015,20 +2895,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TAUOX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TAUOY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 3) ) THEN @@ -3036,11 +2912,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (BHD(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 4) ) THEN @@ -3048,11 +2922,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PHIOC (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 5) ) THEN @@ -3060,20 +2932,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TUSX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TUSY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 6) ) THEN @@ -3081,20 +2949,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (USSX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (USSY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 7) ) THEN @@ -3102,20 +2966,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PRMS (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/07', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TPMS (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/07', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 8) ) THEN @@ -3124,11 +2984,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (US3D(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'US3D ', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3138,11 +2996,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (P2SMS(1,K),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'P2SMS', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3151,20 +3007,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TAUICE (1,1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TAUICE (1,2),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6,11) ) THEN @@ -3172,11 +3024,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PHICE (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/11', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 12) ) THEN @@ -3185,11 +3035,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (USSP(1,IK),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'USSP ', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3198,20 +3046,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TAUOCX(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TAUOCY(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 1) ) THEN @@ -3219,20 +3063,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (ABA (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (ABD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 2) ) THEN @@ -3240,20 +3080,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (UBA (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (UBD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 3) ) THEN @@ -3261,29 +3097,23 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (BEDFORMS(1,1),NSEALM , MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (BEDFORMS(1,2),NSEALM , MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (BEDFORMS(1,3),NSEALM , MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 4) ) THEN @@ -3291,11 +3121,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (PHIBBL(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 5) ) THEN @@ -3303,20 +3131,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (TAUBBL(1,1),NSEALM , MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (TAUBBL(1,2),NSEALM , MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 1) ) THEN @@ -3324,20 +3148,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (MSSX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (MSSY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 2) ) THEN @@ -3345,20 +3165,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (MSCX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (MSCY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 3) ) THEN @@ -3366,11 +3182,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (MSSD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 4) ) THEN @@ -3378,11 +3192,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (MSCD (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 5) ) THEN @@ -3390,11 +3202,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (QP (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 6) ) THEN @@ -3402,67 +3212,49 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (QKK (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/06', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 8, 7) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (SKEW (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/07', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 8, 8) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (EMBIA1 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/08', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 8, 9) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (EMBIA2 (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/09', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_SEND_INIT (DTDYN(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/01', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 2) ) THEN @@ -3470,11 +3262,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (FCUT (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/02', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 3) ) THEN @@ -3482,11 +3272,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (CFLXYMAX(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/03', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 4) ) THEN @@ -3494,11 +3282,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (CFLTHMAX(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/04', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 5) ) THEN @@ -3506,11 +3292,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (CFLKMAX(1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/05', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF ! DO I=1, NOEXTR @@ -3519,23 +3303,19 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_SEND_INIT (USERO(1,I),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) -#endif #ifdef W3_MPIT WRITE (STRING,'(A3,I2.2)') '10/', I WRITE (NDST,9011) IH, STRING, IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_MPI END IF END DO ! NRQGO = IH -#endif #ifdef W3_MPIT WRITE (NDST,9012) WRITE (NDST,9013) NRQGO, NRQMAX #endif ! -#ifdef W3_MPI END IF !IF ( IAPROC .LE. NAPROC ) THEN ! IF ( NRQGO .GT. NRQMAX ) THEN @@ -3556,12 +3336,10 @@ SUBROUTINE W3MPIO ( IMOD ) ! 1.c Receives of fields ! CALL W3XETA ( IMOD, NDSE, NDST ) -#endif #ifdef W3_MPIT WRITE (NDST,9010) '(RECV)' #endif ! -#ifdef W3_MPI IH = 0 ! DO I0=1, NAPROC @@ -3573,11 +3351,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (ICEF (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 1/09', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 1) ) THEN @@ -3585,11 +3361,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (HS (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 2) ) THEN @@ -3597,11 +3371,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WLM (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 3) ) THEN @@ -3609,11 +3381,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (T02 (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 4) ) THEN @@ -3621,11 +3391,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (T0M1 (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 5) ) THEN @@ -3633,11 +3401,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (T01(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 6) .OR. FLGRDALL( 2,18) ) THEN @@ -3646,11 +3412,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (FP0 (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 7) ) THEN @@ -3658,11 +3422,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (THM (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/07', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 8) ) THEN @@ -3670,11 +3432,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (THS (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/08', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 9) ) THEN @@ -3682,11 +3442,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (THP0 (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/09', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 10) ) THEN @@ -3694,11 +3452,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (HSIG (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/10', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 11) ) THEN @@ -3706,11 +3462,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (STMAXE (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/11', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 12) ) THEN @@ -3718,11 +3472,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (STMAXD(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/12', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 13) ) THEN @@ -3730,11 +3482,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (HMAXE (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/13', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 14) ) THEN @@ -3742,11 +3492,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (HCMAXE(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/14', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 15) ) THEN @@ -3754,11 +3502,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (HMAXD (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/15', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 16) ) THEN @@ -3766,11 +3512,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (HCMAXD(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/16', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 17) ) THEN @@ -3778,11 +3522,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WBT(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/17', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 2, 19) ) THEN @@ -3790,11 +3532,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WNMEAN(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 2/19', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 3, 1) ) THEN @@ -3803,11 +3543,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (EF(I0,IK),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'EF', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3817,11 +3555,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TH1M(I0,IK),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'TH1M', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3831,11 +3567,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (STH1M(I0,IK),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'STH1M', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3845,11 +3579,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TH2M(I0,IK),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'TH2M', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3859,11 +3591,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (STH2M(I0,IK),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'STH2M', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3873,11 +3603,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PHS(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3887,11 +3615,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PTP(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3901,11 +3627,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PLP(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3915,11 +3639,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PDIR(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3929,11 +3651,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PSI(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3943,11 +3663,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PWS(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3957,11 +3675,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PTHP0(I0,K),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/07', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3971,11 +3687,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PQP(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/08', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3985,11 +3699,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PPE(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/09', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -3999,11 +3711,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PGW(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/10', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4013,11 +3723,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PSW(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/11', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4027,11 +3735,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PTM1(I0,K),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/12', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4041,11 +3747,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PT1(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/13', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4055,11 +3759,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PT2(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/14', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4069,11 +3771,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PEP(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/15', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4082,11 +3782,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PWST (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/16', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 4,17) ) THEN @@ -4094,11 +3792,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PNR (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 4/17', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 1) ) THEN @@ -4106,29 +3802,23 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (UST (I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (USTDIR(I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (ASF (I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 2) ) THEN @@ -4136,11 +3826,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (CHARN(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 3) ) THEN @@ -4148,11 +3836,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (CGE (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 4) ) THEN @@ -4160,11 +3846,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PHIAW(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 5) ) THEN @@ -4172,20 +3856,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TAUWIX(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TAUWIY(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 6) ) THEN @@ -4193,20 +3873,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TAUWNX(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TAUWNY(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 7) ) THEN @@ -4214,11 +3890,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WHITECAP(I0,1),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/07', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 8) ) THEN @@ -4226,11 +3900,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WHITECAP(I0,2),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/08', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5, 9) ) THEN @@ -4238,11 +3910,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WHITECAP(I0,3),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/09', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5,10) ) THEN @@ -4250,11 +3920,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (WHITECAP(I0,4),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/10', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 5,11) ) THEN @@ -4262,11 +3930,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TWS(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/11', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 1) ) THEN @@ -4274,29 +3940,23 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (SXX (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (SYY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (SXY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 2) ) THEN @@ -4304,20 +3964,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TAUOX (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TAUOY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 3) ) THEN @@ -4325,11 +3981,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (BHD(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 4) ) THEN @@ -4337,11 +3991,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PHIOC (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 5) ) THEN @@ -4349,20 +4001,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TUSX (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TUSY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 6) ) THEN @@ -4370,20 +4018,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (USSX (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (USSY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 7) ) THEN @@ -4391,20 +4035,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PRMS (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/07', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TPMS (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/07', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 8) ) THEN @@ -4413,11 +4053,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (US3D(I0,IK),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'US3D ', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4427,11 +4065,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (P2SMS(I0,K),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'P3SMS', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4440,20 +4076,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TAUICE (I0,1),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TAUICE (I0,2),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6,11) ) THEN @@ -4461,11 +4093,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PHICE (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/11', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 6, 12) ) THEN @@ -4474,11 +4104,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (USSP(I0,IK),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, 'USSP ', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END DO END IF ! @@ -4487,20 +4115,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TAUOCX(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TAUOCY(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 1) ) THEN @@ -4508,20 +4132,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (ABA (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (ABD (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 2) ) THEN @@ -4529,20 +4149,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (UBA (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (UBD (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 3) ) THEN @@ -4550,29 +4166,23 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (BEDFORMS(I0,1),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (BEDFORMS(I0,2),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (BEDFORMS(I0,3),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 4) ) THEN @@ -4580,11 +4190,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (PHIBBL(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 7, 5) ) THEN @@ -4592,20 +4200,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (TAUBBL(I0,1),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (TAUBBL(I0,2),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 1) ) THEN @@ -4613,20 +4217,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (MSSX (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (MSSY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 2) ) THEN @@ -4634,20 +4234,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (MSCX (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (MSCY (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 3) ) THEN @@ -4655,11 +4251,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (MSSD (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 4) ) THEN @@ -4667,11 +4261,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (MSCD (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 5) ) THEN @@ -4679,11 +4271,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (QP (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 8, 6) ) THEN @@ -4691,67 +4281,49 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (QKK (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/06', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 8, 7) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (SKEW (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/07', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 8, 8) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (EMBIA1 (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/08', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 8, 9) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (EMBIA2 (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 8/09', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF -#endif ! -#ifdef W3_MPI IF ( FLGRDALL( 9, 1) ) THEN IH = IH + 1 IT = IT + 1 CALL MPI_RECV_INIT (DTDYN(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/01', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 2) ) THEN @@ -4759,11 +4331,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (FCUT (I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/02', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 3) ) THEN @@ -4771,11 +4341,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (CFLXYMAX(I0),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/03', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 4) ) THEN @@ -4783,11 +4351,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (CFLTHMAX(I0),1,WW3_FIELD_VEC, IFROM, IT,& MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/04', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLGRDALL( 9, 5) ) THEN @@ -4795,11 +4361,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (CFLKMAX(I0),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 9/05', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF ! DO I=1, NOEXTR @@ -4809,25 +4373,21 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT + 1 CALL MPI_RECV_INIT (USERO(I0,I),1,WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (STRING,'(A3,I2.2)') '10/', I WRITE (NDST,9011) IH, STRING, IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_MPI END IF END DO ! END DO ! NRQGO2 = IH -#endif #ifdef W3_MPIT WRITE (NDST,9012) WRITE (NDST,9014) NRQGO2, NRQMAX*NAPROC #endif ! -#ifdef W3_MPI CALL W3SETA ( IMOD, NDSE, NDST ) ! END IF ! IF ( IAPROC .EQ. NAPFLD ) THEN @@ -4853,7 +4413,6 @@ SUBROUTINE W3MPIO ( IMOD ) ALLOCATE ( OUTPTS(IMOD)%OUT4%IRQRS(3*NAPROC) ) ENDIF IRQRS => OUTPTS(IMOD)%OUT4%IRQRS -#endif ! ! 2.b Fields at end of file (always) ! @@ -4861,39 +4420,32 @@ SUBROUTINE W3MPIO ( IMOD ) WRITE (NDST,9020) #endif ! -#ifdef W3_MPI IF ( IAPROC.NE.NAPRST .AND. IAPROC.LE.NAPROC ) THEN ! IH = IH + 1 IT = IT0 + 1 CALL MPI_SEND_INIT (UST (IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S U*', IROOT, IT, IRQRS(IH), IERR #endif ! -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 2 CALL MPI_SEND_INIT (USTDIR(IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S UD', IROOT, IT, IRQRS(IH), IERR #endif ! -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 3 CALL MPI_SEND_INIT (FPIS(IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S FP', IROOT, IT, IRQRS(IH), IERR #endif ! -#ifdef W3_MPI ELSE IF ( IAPROC .EQ. NAPRST ) THEN DO I0=1, NAPROC IFROM = I0 - 1 @@ -4903,31 +4455,25 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 1 CALL MPI_RECV_INIT (UST (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R U*', IFROM, IT, IRQRS(IH), IERR #endif ! -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 2 CALL MPI_RECV_INIT (USTDIR(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R UD', IFROM, IT, IRQRS(IH), IERR #endif ! -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 3 CALL MPI_RECV_INIT (FPIS(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R FP', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF END DO END IF @@ -4938,20 +4484,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 4 CALL MPI_SEND_INIT (CX(IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S CX', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 5 CALL MPI_SEND_INIT (CY(IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S CY', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 1, 12) ) THEN @@ -4959,11 +4501,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 6 CALL MPI_SEND_INIT (ICEF(IAPROC), 1, WW3_FIELD_VEC, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S IF', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 1) ) THEN @@ -4971,11 +4511,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 7 CALL MPI_SEND_INIT (HS (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S HS', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 2) ) THEN @@ -4983,11 +4521,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 8 CALL MPI_SEND_INIT (WLM (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S WL', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 4) ) THEN @@ -4995,11 +4531,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 9 CALL MPI_SEND_INIT (T0M1(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S T0', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI ENDIF ! IF ( FLOGRR( 2, 5) ) THEN @@ -5007,11 +4541,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 10 CALL MPI_SEND_INIT (T01 (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S T1', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI ENDIF ! IF ( FLOGRR( 2, 6) ) THEN @@ -5019,11 +4551,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 11 CALL MPI_SEND_INIT (FP0 (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S FP', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 7) ) THEN @@ -5031,11 +4561,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 12 CALL MPI_SEND_INIT (THM (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S TH', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 19) ) THEN @@ -5043,11 +4571,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 13 CALL MPI_SEND_INIT (WNMEAN(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S WM', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 5, 2) ) THEN @@ -5055,11 +4581,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 14 CALL MPI_SEND_INIT (CHARN(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S CH', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI ENDIF ! IF ( FLOGRR( 5, 5) ) THEN @@ -5067,20 +4591,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 15 CALL MPI_SEND_INIT (TAUWIX(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S WX', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 16 CALL MPI_SEND_INIT (TAUWIY(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S WY', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 5, 11) ) THEN @@ -5088,11 +4608,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 17 CALL MPI_SEND_INIT (TWS (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S TS', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 2) ) THEN @@ -5100,20 +4618,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 18 CALL MPI_SEND_INIT (TAUOX(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S OX', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 19 CALL MPI_SEND_INIT (TAUOY(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S OY', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 3) ) THEN @@ -5121,11 +4635,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 20 CALL MPI_SEND_INIT (BHD (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S BH', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 4) ) THEN @@ -5133,11 +4645,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 21 CALL MPI_SEND_INIT (PHIOC(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S PH', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 5) ) THEN @@ -5145,20 +4655,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 22 CALL MPI_SEND_INIT (TUSX (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S UX', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 23 CALL MPI_SEND_INIT (TUSY (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S UY', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 6) ) THEN @@ -5166,20 +4672,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 24 CALL MPI_SEND_INIT (USSX (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S SX', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 25 CALL MPI_SEND_INIT (USSY (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S SY', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6,10) ) THEN @@ -5187,20 +4689,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 26 CALL MPI_SEND_INIT (TAUICE(1,1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S I1', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 27 CALL MPI_SEND_INIT (TAUICE(1,2), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S I2', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6,13) ) THEN @@ -5208,20 +4706,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 28 CALL MPI_SEND_INIT (TAUOCX(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S TX', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 29 CALL MPI_SEND_INIT (TAUOCY(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S TY', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 7, 2) ) THEN @@ -5229,20 +4723,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 30 CALL MPI_SEND_INIT (UBA (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S BA', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 31 CALL MPI_SEND_INIT (UBD (1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S BD', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 7, 4) ) THEN @@ -5250,11 +4740,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 32 CALL MPI_SEND_INIT (PHIBBL(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S PB', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 7, 5) ) THEN @@ -5262,20 +4750,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 33 CALL MPI_SEND_INIT (TAUBBL(1,1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S T1', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 34 CALL MPI_SEND_INIT (TAUBBL(1,2), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S T2', IROOT, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( IAPROC .EQ. NAPRST ) THEN @@ -5289,20 +4773,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 4 CALL MPI_RECV_INIT (CX (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R CX', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IT0 + 5 IT = IT + 1 CALL MPI_RECV_INIT (CY (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R CY', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 1, 12) ) THEN @@ -5310,11 +4790,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 6 CALL MPI_RECV_INIT (ICEF (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R IF', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 1) ) THEN @@ -5322,11 +4800,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 7 CALL MPI_RECV_INIT (HS (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R HS', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 2) ) THEN @@ -5334,11 +4810,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 8 CALL MPI_RECV_INIT (WLM (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R WL', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 4) ) THEN @@ -5346,11 +4820,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 9 CALL MPI_RECV_INIT (T0M1(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R T0', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI ENDIF ! IF ( FLOGRR( 2, 5) ) THEN @@ -5358,11 +4830,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 10 CALL MPI_RECV_INIT (T01 (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R T1', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI ENDIF ! IF ( FLOGRR( 2, 6) ) THEN @@ -5370,11 +4840,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 11 CALL MPI_RECV_INIT (FP0 (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R FP', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 7) ) THEN @@ -5382,11 +4850,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 12 CALL MPI_RECV_INIT (THM (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R TH', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 2, 19) ) THEN @@ -5394,11 +4860,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 13 CALL MPI_RECV_INIT (WNMEAN(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R WM', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 5, 2) ) THEN @@ -5406,11 +4870,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 14 CALL MPI_RECV_INIT (CHARN(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R CH', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI ENDIF ! IF ( FLOGRR( 5, 5) ) THEN @@ -5418,20 +4880,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 15 CALL MPI_RECV_INIT (TAUWIX(I0),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R WX', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 16 CALL MPI_RECV_INIT (TAUWIY(I0),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R WY', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 5,11) ) THEN @@ -5439,11 +4897,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 17 CALL MPI_RECV_INIT (TWS (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R TS', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 2) ) THEN @@ -5451,20 +4907,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 18 CALL MPI_RECV_INIT (TAUOX(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R OX', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 19 CALL MPI_RECV_INIT (TAUOY(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R OY', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 3) ) THEN @@ -5472,11 +4924,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 20 CALL MPI_RECV_INIT (BHD (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R BH', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 4) ) THEN @@ -5484,11 +4934,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 21 CALL MPI_RECV_INIT (PHIOC(I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R PH', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 5) ) THEN @@ -5496,20 +4944,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 22 CALL MPI_RECV_INIT (TUSX (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R UX', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 23 CALL MPI_RECV_INIT (TUSY (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R UY', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6, 6) ) THEN @@ -5517,20 +4961,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 24 CALL MPI_RECV_INIT (USSX (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R SX', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 25 CALL MPI_RECV_INIT (USSY (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R SY', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6,10) ) THEN @@ -5538,20 +4978,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 26 CALL MPI_RECV_INIT (TAUICE(I0,1),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R I1', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 27 CALL MPI_RECV_INIT (TAUICE(I0,2),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R I2', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 6,13) ) THEN @@ -5559,20 +4995,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 28 CALL MPI_RECV_INIT (TAUOCX(I0),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R SX', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 29 CALL MPI_RECV_INIT (TAUOCY(I0),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R SY', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 7, 2) ) THEN @@ -5580,20 +5012,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 30 CALL MPI_RECV_INIT (UBA (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R BA', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 31 CALL MPI_RECV_INIT (UBD (I0),1,WW3_FIELD_VEC, & IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R BD', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 7, 4) ) THEN @@ -5601,11 +5029,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 32 CALL MPI_RECV_INIT (PHIBBL(I0),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R PB', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF ! IF ( FLOGRR( 7, 5) ) THEN @@ -5613,20 +5039,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 33 CALL MPI_RECV_INIT (TAUBBL(I0,1),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R T1', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 34 CALL MPI_RECV_INIT (TAUBBL(I0,2),1,WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R T2', IFROM, IT, IRQRS(IH), IERR #endif -#ifdef W3_MPI END IF END DO ! @@ -5640,7 +5062,6 @@ SUBROUTINE W3MPIO ( IMOD ) ELSE IT0 = IT0 + 3 ENDIF -#endif ! #ifdef W3_MPIT WRITE (NDST,9022) @@ -5649,19 +5070,16 @@ SUBROUTINE W3MPIO ( IMOD ) ! ! 2.c Data server mode ! -#ifdef W3_MPI IF ( IOSTYP .GT. 0 ) THEN ! NBLKRS = 10 RSBLKS = MAX ( 5 , NSEALM/NBLKRS ) IF ( NBLKRS*RSBLKS .LT. NSEALM ) RSBLKS = RSBLKS + 1 NBLKRS = 1 + (NSEALM-1)/RSBLKS -#endif ! #ifdef W3_MPIT WRITE (NDST,9025) RSBLKS, NBLKRS #endif -#ifdef W3_MPI IH = 0 ! IF ( IAPROC .NE. NAPRST ) THEN @@ -5677,11 +5095,9 @@ SUBROUTINE W3MPIO ( IMOD ) NSEAB = 1 + JSEAN - JSEA0 CALL MPI_SEND_INIT (VA(1,JSEA0), NSPEC*NSEAB, MPI_REAL, IROOT, IT, & MPI_COMM_WAVE, IRQRSS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9026) IH, 'S', IB, IROOT, IT, IRQRSS(IH), IERR, NSEAB #endif -#ifdef W3_MPI END DO ! ELSE @@ -5703,33 +5119,27 @@ SUBROUTINE W3MPIO ( IMOD ) IBOFF = MOD(IB-1,2)*RSBLKS CALL MPI_RECV_INIT (VAAUX(1,1+IBOFF,I0), NSPEC*NSEAB, MPI_REAL, & IFROM, IT, MPI_COMM_WAVE, IRQRSS(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9026) IH, 'R', IB, IFROM, IT, IRQRSS(IH), IERR, NSEAB #endif -#ifdef W3_MPI END IF END DO END DO ! END IF -#endif ! #ifdef W3_MPIT WRITE (NDST,9027) WRITE (NDST,9028) IH #endif -#ifdef W3_MPI IT0 = IT0 + NBLKRS ! END IF ! END IF ! IF ((FLOUT(4) .OR. FLOUT(8)) .and. (.not. LPDLIB)) THEN -#endif ! ! 3. Set-up for W3IOBC ( SENDs ) ------------------------------------ / ! -#ifdef W3_MPI NRQBP = 0 NRQBP2 = 0 IH = 0 @@ -5741,7 +5151,6 @@ SUBROUTINE W3MPIO ( IMOD ) OUTPTS(IMOD)%OUT5%IRQBP2(NBO2(NFBPO)) ) IRQBP1 => OUTPTS(IMOD)%OUT5%IRQBP1 IRQBP2 => OUTPTS(IMOD)%OUT5%IRQBP2 -#endif ! ! 3.a Loops over files and points ! @@ -5749,7 +5158,6 @@ SUBROUTINE W3MPIO ( IMOD ) WRITE (NDST,9030) 'MPI_SEND_INIT' #endif ! -#ifdef W3_MPI DO J=1, NFBPO DO I=NBO2(J-1)+1, NBO2(J) ! @@ -5766,22 +5174,17 @@ SUBROUTINE W3MPIO ( IMOD ) IH = IH + 1 CALL MPI_SEND_INIT (VA(1,JSEA),NSPEC,MPI_REAL, IROOT, IT, MPI_COMM_WAVE, & IRQBP1(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9031) IH, I, J, IROOT, IT, IRQBP1(IH), IERR #endif -#ifdef W3_MPI END IF ! END DO END DO -#endif ! ! ... End of loops 4.a ! -#ifdef W3_MPI NRQBP = IH -#endif ! #ifdef W3_MPIT WRITE (NDST,9032) @@ -5790,12 +5193,10 @@ SUBROUTINE W3MPIO ( IMOD ) ! ! 3.d Set-up for W3IOBC ( RECVs ) ------------------------------------ / ! -#ifdef W3_MPI IF ( IAPROC .EQ. NAPBPT ) THEN ! IH = 0 IT = IT0 -#endif ! ! 3.e Loops over files and points ! @@ -5803,7 +5204,6 @@ SUBROUTINE W3MPIO ( IMOD ) WRITE (NDST,9030) 'MPI_RECV_INIT' #endif ! -#ifdef W3_MPI DO J=1, NFBPO DO I=NBO2(J-1)+1, NBO2(J) ! @@ -5819,17 +5219,14 @@ SUBROUTINE W3MPIO ( IMOD ) ITARG = ISPROC - 1 CALL MPI_RECV_INIT (ABPOS(1,IH),NSPEC,MPI_REAL, ITARG, IT, MPI_COMM_WAVE, & IRQBP2(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9031) IH, I, J, ITARG, IT, IRQBP2(IH), IERR #endif ! -#ifdef W3_MPI END DO END DO ! NRQBP2 = IH -#endif ! ! ... End of loops 4.e ! @@ -5838,13 +5235,11 @@ SUBROUTINE W3MPIO ( IMOD ) WRITE (NDST,9033) NRQBP2 #endif ! -#ifdef W3_MPI END IF ! IT0 = IT0 + NBO2(NFBPO) ! END IF -#endif ! #ifdef W3_MPIT WRITE (NDST,*) @@ -5852,12 +5247,10 @@ SUBROUTINE W3MPIO ( IMOD ) ! ! 4. Set-up for W3IOTR ---------------------------------------------- / ! -#ifdef W3_MPI IH = 0 IROOT = NAPTRK - 1 ! IF ( FLOUT(3) ) THEN -#endif ! ! 4.a U* ! @@ -5865,7 +5258,6 @@ SUBROUTINE W3MPIO ( IMOD ) WRITE (NDST,9040) #endif ! -#ifdef W3_MPI IF ( IAPROC .NE. NAPTRK ) THEN ALLOCATE ( OUTPTS(IMOD)%OUT3%IRQTR(2) ) IRQTR => OUTPTS(IMOD)%OUT3%IRQTR @@ -5873,20 +5265,16 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 1 CALL MPI_SEND_INIT (UST (IAPROC),1,WW3_FIELD_VEC, IROOT, IT, MPI_COMM_WAVE, & IRQTR(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9041) IH, 'S U*', IROOT, IT, IRQTR(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 2 CALL MPI_SEND_INIT (USTDIR(IAPROC),1,WW3_FIELD_VEC, IROOT, IT, MPI_COMM_WAVE, & IRQTR(IH), IERR ) -#endif #ifdef W3_MPIT WRITE (NDST,9041) IH, 'S U*', IROOT, IT, IRQTR(IH), IERR #endif -#ifdef W3_MPI ELSE ALLOCATE ( OUTPTS(IMOD)%OUT3%IRQTR(2*NAPROC) ) IRQTR => OUTPTS(IMOD)%OUT3%IRQTR @@ -5897,40 +5285,32 @@ SUBROUTINE W3MPIO ( IMOD ) IT = IT0 + 1 CALL MPI_RECV_INIT(UST (I0),1,WW3_FIELD_VEC, IFROM, IT, MPI_COMM_WAVE, & IRQTR(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9041) IH, 'R U*', IFROM, IT, IRQTR(IH), IERR #endif -#ifdef W3_MPI IH = IH + 1 IT = IT0 + 2 CALL MPI_RECV_INIT(USTDIR(I0),1,WW3_FIELD_VEC, IFROM, IT, MPI_COMM_WAVE, & IRQTR(IH), IERR) -#endif #ifdef W3_MPIT WRITE (NDST,9041) IH, 'R U*', IFROM, IT, IRQTR(IH), IERR #endif -#ifdef W3_MPI END IF END DO END IF ! NRQTR = IH IT0 = IT0 + 2 -#endif ! #ifdef W3_MPIT WRITE (NDST,9042) WRITE (NDST,9043) NRQTR #endif ! -#ifdef W3_MPI END IF -#endif ! ! 5. Set-up remaining counters -------------------------------------- / ! -#ifdef W3_MPI IT0PRT = IT0 IT0PNT = IT0PRT + 2*NAPROC IT0TRK = IT0PNT + 5000 From abc77b992c54d0b05169c624c35cebf25da97a68 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Thu, 1 Aug 2024 14:46:01 -0700 Subject: [PATCH 053/136] Enable doxygen documentation in the cmake build system (#1281) --- CMakeLists.txt | 12 ++++++++++-- docs/CMakeLists.txt | 1 + docs/Doxyfile.in | 6 +++--- docs/cmake/EnableDoxygen.cmake | 27 +++++++++++++++++++++++++++ 4 files changed, 41 insertions(+), 5 deletions(-) create mode 100644 docs/CMakeLists.txt create mode 100644 docs/cmake/EnableDoxygen.cmake diff --git a/CMakeLists.txt b/CMakeLists.txt index b485488b3c..5070e3aa58 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -13,7 +13,7 @@ project( get_directory_property(hasParent PARENT_DIRECTORY) if(hasParent) - # Unset flags that come from Parent (ie UFS or other coupled build) + # Unset flags that come from Parent (ie UFS or other coupled build) # for potential (-r8/-r4) conflict set(CMAKE_Fortran_FLAGS "") set(CMAKE_C_FLAGS "") @@ -22,8 +22,9 @@ endif() set(MULTI_ESMF OFF CACHE BOOL "Build ww3_multi_esmf library") set(NETCDF ON CACHE BOOL "Build NetCDF programs (requires NetCDF)") -set(ENDIAN "BIG" CACHE STRING "Endianness of unformatted output files. Valid values are 'BIG', 'LITTLE', 'NATIVE'.") +set(ENDIAN "BIG" CACHE STRING "Endianness of unformatted output files. Valid values are 'BIG', 'LITTLE', 'NATIVE'.") set(EXCLUDE_FIND "" CACHE STRING "Don't try and search for these libraries (assumd to be handled by the compiler/wrapper)") +set(ENABLE_DOCS OFF CACHE BOOL "Enable building of doxygen generated documentation") # make sure all "exclude_find" entries are lower case list(TRANSFORM EXCLUDE_FIND TOLOWER) @@ -59,6 +60,13 @@ endif() add_subdirectory(model) +# Turn on doxygen documentation +if (ENABLE_DOCS) + list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/docs/cmake") + include(EnableDoxygen) + add_subdirectory(docs) +endif() + # Turn on unit testing. #include(CTest) #if(BUILD_TESTING) diff --git a/docs/CMakeLists.txt b/docs/CMakeLists.txt new file mode 100644 index 0000000000..7aa89edeb6 --- /dev/null +++ b/docs/CMakeLists.txt @@ -0,0 +1 @@ +EnableDoxygen(docs) diff --git a/docs/Doxyfile.in b/docs/Doxyfile.in index 23349c8dab..93a26c5a2c 100644 --- a/docs/Doxyfile.in +++ b/docs/Doxyfile.in @@ -58,7 +58,7 @@ PROJECT_LOGO = # entered, it will be relative to the location where doxygen was started. If # left blank the current directory will be used. -OUTPUT_DIRECTORY = docs +OUTPUT_DIRECTORY = @doc_output@ # If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- # directories (in 2 levels) under the output directory of each output format and @@ -829,7 +829,7 @@ WARN_LOGFILE = # spaces. See also FILE_PATTERNS and EXTENSION_MAPPING # Note: If this tag is empty the current directory is searched. -INPUT = model/src +INPUT = @src_input@ # This tag can be used to specify the character encoding of the source files # that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses @@ -2285,7 +2285,7 @@ CLASS_DIAGRAMS = NO # DIA_PATH tag allows you to specify the directory where the dia binary resides. # If left empty dia is assumed to be found in the default search path. -DIA_PATH = +DIA_PATH = # If set to YES the inheritance and collaboration graphs will hide inheritance # and usage relations if the target is undocumented or is not a class. diff --git a/docs/cmake/EnableDoxygen.cmake b/docs/cmake/EnableDoxygen.cmake new file mode 100644 index 0000000000..20af91e59c --- /dev/null +++ b/docs/cmake/EnableDoxygen.cmake @@ -0,0 +1,27 @@ +# Doxygen documentation- Matt Masarik 24-Jul-2024. +function(EnableDoxygen outdir) + find_package(Doxygen REQUIRED) + if (NOT DOXYGEN_FOUND) + add_custom_target(enable_docs + COMMAND false + COMMENT "Doxygen not found") + return() + endif() + + set(src_input "${CMAKE_SOURCE_DIR}/model/src") + set(doc_output "${CMAKE_BINARY_DIR}/${outdir}") + file(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/${outdir}/html) + CONFIGURE_FILE(${CMAKE_SOURCE_DIR}/docs/Doxyfile.in + ${CMAKE_BINARY_DIR}/${outdir}/Doxyfile @ONLY) + set(DOXYGEN_GENERATE_HTML YES) + set(DOXYGEN_QUIET YES) + add_custom_target(enable_docs + COMMAND + ${DOXYGEN_EXECUTABLE} ${CMAKE_BINARY_DIR}/${outdir}/Doxyfile + WORKING_DIRECTORY + ${CMAKE_BINARY_DIR}/${outdir} + COMMENT + "Generate Doxygen HTML documentation") + message("-- Doxygen HTML index page: " + ${CMAKE_BINARY_DIR}/${outdir}/html/index.html) +endfunction() From 7705171721e825d58e1e867e552e328fc812bfdd Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Fri, 8 Nov 2024 10:47:05 -0800 Subject: [PATCH 054/136] README.md: update with link to doxygen documentation (#1316) --- README.md | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/README.md b/README.md index fa2c1df639..42ac911786 100644 --- a/README.md +++ b/README.md @@ -1,23 +1,25 @@ # The WAVEWATCH III Framework -WAVEWATCH III® is a community wave modeling framework that includes the +WAVEWATCH III® is a community wave modeling framework that includes the latest scientific advancements in the field of wind-wave modeling and dynamics. ## General Features -WAVEWATCH III® solves the random phase spectral action density -balance equation for wavenumber-direction spectra. The model includes options -for shallow-water (surf zone) applications, as well as wetting and drying of -grid points. Propagation of a wave spectrum can be solved using regular -(rectilinear or curvilinear) and unstructured (triangular) grids. See -[About WW3](https://github.com/NOAA-EMC/WW3/wiki/About-WW3) for a -detailed description of WAVEWATCH III® . +WAVEWATCH III® solves the random phase spectral action density +balance equation for wavenumber-direction spectra. The model includes options +for shallow-water (surf zone) applications, as well as wetting and drying of +grid points. Propagation of a wave spectrum can be solved using regular +(rectilinear or curvilinear) and unstructured (triangular) grids. See +[About WW3](https://github.com/NOAA-EMC/WW3/wiki/About-WW3) for a +detailed description of WAVEWATCH III®. For a web-based +view of the WAVEWATCH III® source code +refer to the [WW3 doxygen documentation](https://noaa-emc.github.io/WW3). ## Installation -The WAVEWATCH III® framework package has two parts that need to be combined so -all runs smoothly: the GitHub repo itself, and a binary data file bundle that -needs to be obtained from our ftp site. Steps to successfully acquire and install +The WAVEWATCH III® framework package has two parts that need to be combined so +all runs smoothly: the GitHub repo itself, and a binary data file bundle that +needs to be obtained from our ftp site. Steps to successfully acquire and install the framework are outlined in our [Quick Start](https://github.com/NOAA-EMC/WW3/wiki/Quick-Start) guide. @@ -35,4 +37,3 @@ endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government. - From bd7b90d68ea0778c83d36c71c7d69da52637ad30 Mon Sep 17 00:00:00 2001 From: Matthew Masarik <86749872+MatthewMasarik-NOAA@users.noreply.github.com> Date: Mon, 25 Nov 2024 05:56:20 -0800 Subject: [PATCH 055/136] ww3_ufs1.x: fix typo in switch_MPI_OMPH (#1323) --- regtests/ww3_ufs1.1/input/switch_MPI_OMPH | 2 +- regtests/ww3_ufs1.2/input/switch_MPI_OMPH | 2 +- regtests/ww3_ufs1.3/input/switch_MPI_OMPH | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/regtests/ww3_ufs1.1/input/switch_MPI_OMPH b/regtests/ww3_ufs1.1/input/switch_MPI_OMPH index 8be0a29a5b..eb4b41e904 100644 --- a/regtests/ww3_ufs1.1/input/switch_MPI_OMPH +++ b/regtests/ww3_ufs1.1/input/switch_MPI_OMPH @@ -1 +1 @@ -NCO NOGRB DIST MPI OMPG OMGH SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 +NCO NOGRB DIST MPI OMPG OMPH SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 diff --git a/regtests/ww3_ufs1.2/input/switch_MPI_OMPH b/regtests/ww3_ufs1.2/input/switch_MPI_OMPH index 8be0a29a5b..eb4b41e904 100644 --- a/regtests/ww3_ufs1.2/input/switch_MPI_OMPH +++ b/regtests/ww3_ufs1.2/input/switch_MPI_OMPH @@ -1 +1 @@ -NCO NOGRB DIST MPI OMPG OMGH SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 +NCO NOGRB DIST MPI OMPG OMPH SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 diff --git a/regtests/ww3_ufs1.3/input/switch_MPI_OMPH b/regtests/ww3_ufs1.3/input/switch_MPI_OMPH index 8be0a29a5b..eb4b41e904 100644 --- a/regtests/ww3_ufs1.3/input/switch_MPI_OMPH +++ b/regtests/ww3_ufs1.3/input/switch_MPI_OMPH @@ -1 +1 @@ -NCO NOGRB DIST MPI OMPG OMGH SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 +NCO NOGRB DIST MPI OMPG OMPH SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 From b7afba7e020fbfe8e7c1657943368ce0f10352c5 Mon Sep 17 00:00:00 2001 From: Aron Roland Date: Thu, 12 Dec 2024 22:47:32 +0100 Subject: [PATCH 056/136] Fixing uninitialized issues within the implicit scheme (#1142) Co-authored-by: Ty Hesser Co-authored-by: Tyler James Hesser --- model/src/w3profsmd_pdlib.F90 | 24 ++++++++++++++++++------ model/src/w3sdb1md.F90 | 12 +++++------- model/src/w3srcemd.F90 | 17 +++++++++++------ model/src/w3str1md.F90 | 11 ++++++----- model/src/w3wavemd.F90 | 10 ++++++++++ 5 files changed, 50 insertions(+), 24 deletions(-) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 6759fb53e9..140fdc33bc 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -2854,12 +2854,24 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) ! USE W3ODATMD, only: IAPROC USE W3GDATMD, only: B_JGS_USE_JACOBI + USE W3TIMEMD, only: DSEC21 + USE W3ODATMD, only: TBPI0, TBPIN, FLBPI + USE W3WDATMD, only: TIME LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY + REAL :: RD1, RD2 + + IF ( FLBPI ) THEN + RD1 = DSEC21 ( TBPI0, TIME ) + RD2 = DSEC21 ( TBPI0, TBPIN ) + ELSE + RD1=1. + RD2=0. + END IF - CALL PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) + CALL PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, RD1, RD2, DTG, VGX, VGY, LCALC) !/ !/ End of W3XYPFSN ----------------------------------------------------- / !/ @@ -6328,7 +6340,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL #endif END SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) + SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, RD10, RD20, DTG, VGX, VGY, LCALC) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -6402,7 +6414,7 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) INTEGER, INTENT(IN) :: IMOD - REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY + REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY, RD10, RD20 REAL :: KTMP(3), UTILDE(NTH), ST(NTH,NPA) REAL :: FL11(NTH), FL12(NTH), FL21(NTH), FL22(NTH), FL31(NTH), FL32(NTH), KKSUM(NTH,NPA) @@ -6411,7 +6423,7 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) REAL :: KSIG(NPA), CGSIG(NPA), CXX(NTH,NPA), CYY(NTH,NPA) REAL :: LAMBDAX(NTH), LAMBDAY(NTH) REAL :: DTMAX(NTH), DTMAXEXP(NTH), DTMAXOUT, DTMAXGL - REAL :: FIN(1), FOUT(1), REST, CFLXY, RD1, RD2, RD10, RD20 + REAL :: FIN(1), FOUT(1), REST, CFLXY, RD1, RD2 REAL :: UOLD(NTH,NPA), U(NTH,NPA) REAL, PARAMETER :: ONESIXTH = 1.0/6.0 @@ -6570,8 +6582,8 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) IF ( FLBPI ) THEN DO ITH = 1, NTH ISP = ITH + (IK-1) * NTH - RD1 = RD10 - DTG * REAL(ITER(IK)-IT)/REAL(ITER(IK)) - RD2 = RD20 + RD1=RD10 - DTMAXGL * REAL(ITER(IK)-IT)/REAL(ITER(IK)) + RD2=RD20 IF ( RD2 .GT. 0.001 ) THEN RD2 = MIN(1.,MAX(0.,RD1/RD2)) RD1 = 1. - RD2 diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index 34c7ec3bfb..7b4c0ce024 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -187,6 +187,7 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) USE W3ODATMD, ONLY: NDST USE W3GDATMD, ONLY: SIG USE W3ODATMD, only : IAPROC + USE W3PARALL, only : THR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -218,7 +219,7 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) INTEGER, SAVE :: IENT = 0 #endif REAL*8 :: HM, BB, ARG, Q0, QB, B, CBJ, HRMS, EB(NK) - REAL*8 :: AUX, CBJ2, RATIO, S0, S1, THR, BR1, BR2, FAK + REAL*8 :: AUX, CBJ2, RATIO, S0, S1, BR1, BR2, FAK REAL :: ETOT, FMEAN2 #ifdef W3_T0 REAL :: DOUT(NK,NTH) @@ -231,12 +232,9 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) #endif ! ! 0. Initialzations ------------------------------------------------- / - ! Never touch this 4 lines below ... otherwise my exceptionhandling will not work. - S = 0. - D = 0. - - THR = DBLE(1.E-15) - IF (SUM(A) .LT. THR) RETURN + IF (EMEAN .LT. TINY(1.d0)) THEN + RETURN + ENDIF IWB = 1 ! diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index e90ba88ebe..eeb2a95a1a 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -1,4 +1,4 @@ -!> @file + !> @brief Source term integration routine. !> !> @author H. L. Tolman @@ -1244,7 +1244,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & IF (.NOT. FSSOURCE .or. LSLOC) THEN #endif #ifdef W3_TR1 - CALL W3STR1 ( SPEC, SPECOLD, CG1, WN1, DEPTH, IX, VSTR, VDTR ) + CALL W3STR1 ( SPEC, CG1, WN1, DEPTH, IX, VSTR, VDTR ) #endif #ifdef W3_PDLIB ENDIF @@ -1534,8 +1534,13 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) ENDIF PreVS = DVS / FAKS - eVS = PreVS / CG1(IK) * CLATSL - eVD = MIN(0.,VD(ISP)) + IF (IOBP_LOC(JSEA) .EQ. 3) THEN + eVS = 0 + eVD = 0 + ELSE + eVS = PreVS / CG1(IK) * CLATSL + eVD = MIN(0.,VD(ISP)) + ENDIF B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * (eVS - eVD*SPEC(ISP)*JAC) ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) - SIDT * eVD #ifdef W3_DB1 @@ -1548,9 +1553,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & evS = -evS evD = 2*evD ENDIF -#endif B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * eVS ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) - SIDT * eVD +#endif #ifdef W3_TR1 eVS = VSTR(ISP) * JAC @@ -1562,9 +1567,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & evS = -evS evD = 2*evD ENDIF -#endif B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * eVS ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) - SIDT * eVD +#endif END DO END DO diff --git a/model/src/w3str1md.F90 b/model/src/w3str1md.F90 index d8067abd7e..ce14b6b365 100644 --- a/model/src/w3str1md.F90 +++ b/model/src/w3str1md.F90 @@ -180,7 +180,7 @@ MODULE W3STR1MD !> !> @author A. J. van der Westhuysen @date 13-Jan-2013 !> - SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) + SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -259,7 +259,6 @@ SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) ! CG R.A. I Group velocities. ! WN R.A. I Wavenumbers. ! DEPTH Real I Mean water depth. - ! EMEAN Real I Mean wave energy. ! FMEAN Real I Mean wave frequency. ! S R.A. O Source term (1-D version). ! D R.A. O Diagonal term of derivative (1-D version). @@ -320,7 +319,7 @@ SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) !/ ------------------------------------------------------------------- / !/ Parameter list !/ - REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC), AOLD(NSPEC) + REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC) INTEGER, INTENT(IN) :: IX REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC) !/ @@ -391,11 +390,13 @@ SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) #ifdef W3_S CALL STRACE (IENT, 'W3STR1') #endif - -!AR: todo: check all PRX routines for differences, check original thesis of elderberky. ! ! 1. Integral over directions ! + IF (MAXVAL(A) .LT. TINY(1.)) THEN + RETURN + ENDIF + SIGM01 = 0. EMEAN = 0. JACEPS = 1E-12 diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 6db2f03af0..83d3be9e5c 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1453,6 +1453,12 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 13') ! #ifdef W3_PDLIB + + IF (LPDLIB .and. .not. FLSOU .and. .not. FSSOURCE) THEN + B_JAC = 0. + ASPAR_JAC = 0. + ENDIF + IF (LPDLIB .and. FLSOU .and. FSSOURCE) THEN #endif @@ -1484,6 +1490,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL INIT_GET_ISEA(ISEA, JSEA) + IF ((IOBP_LOC(JSEA).eq.1..or.IOBP_LOC(JSEA).eq. 3).and.IOBDP_LOC(JSEA).eq.1.and.IOBPA_LOC(JSEA).eq.0) THEN + IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) DELA=1. @@ -1556,6 +1564,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & WRITE(740+IAPROC,*) ' SHAVETOT=', SHAVETOT(JSEA) FLUSH(740+IAPROC) #endif + ENDIF END DO ! JSEA END IF ! PDLIB #endif @@ -2158,6 +2167,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) + IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) DELA=1. From d1fdda99562ca414a1126526ade3d22c70d2085f Mon Sep 17 00:00:00 2001 From: Erin E Thomas <60432101+erinethomas@users.noreply.github.com> Date: Thu, 12 Dec 2024 14:52:29 -0700 Subject: [PATCH 057/136] IC4M10: New wave damping scheme in sea ice (#1293) Based on Meylan Horvat Bitz and Bennetts, Ocean Modelling, 2021. Co-Authors include: Erin Thomas, Cecilia Bitz, David Bailey, Nick Szapiro. Co-authored-by: Erin Thomas --- model/src/w3sic4md.F90 | 43 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) diff --git a/model/src/w3sic4md.F90 b/model/src/w3sic4md.F90 index 3cc7da357d..c6daacb201 100644 --- a/model/src/w3sic4md.F90 +++ b/model/src/w3sic4md.F90 @@ -89,6 +89,7 @@ MODULE W3SIC4MD ! *** Rogers et al. tech. rep. 2021 (RYW2021) ! *** Yu et al. CRST 2022 ! *** Yu JMSE 2022 + ! *** Meylan et al. Ocean Modeling 2021 ! ! 6. Switches : ! @@ -138,6 +139,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) !/ 11-Jan-2024 : Method 8 added (Meylan et al. 2018) (E. Rogers) !/ 11-Jan-2024 : Method 9 added (Rogers et al., 2021) !/ denoted "RYW2021" (E. Rogers) + !/ 14-Aug-2024 : Method 10 added (Meylan et al. 2021) (E. Thomas) !/ !/ FIXME : Move field input to W3SRCE and provide !/ (S.Zieger) input parameter to W3SIC1 to make the subroutine @@ -307,6 +309,8 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ! suggested default is marked with "(*SD*)", for consistency ! with SWAN (v41.31AB or later) ! + ! 10) Meylan et al. 2021 (Ocean Modeling): ocean-wave attenuation + ! due to scattering by sea ice floes. ! ------------------------------------------------------------------ ! ! For all methods, the user can specify namelist @@ -450,6 +454,8 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) REAL, ALLOCATABLE :: FREQ(:) ! wave frequency REAL, ALLOCATABLE :: MARG1(:), MARG2(:) ! Arguments for M2 REAL, ALLOCATABLE :: KARG1(:), KARG2(:), KARG3(:) !Arguments for M3 + REAL :: x1,x2,x3,x1sqr,x2sqr,x3sqr !Arguments for M10 + REAL :: perfour,amhb,bmhb !Arguments for M10 LOGICAL :: NML_INPUT ! if using namelist input for M2 !/ @@ -699,6 +705,43 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) DO IK=1,NK WN_I(IK) = Chf*(hice**mpow)*(FREQ(IK)**npow) END DO + + CASE (10) + ! Cubic fit to Meylan, Horvat & Bitz 2021 + ! ICECOEF1 is thickness + ! ICECOEF5 is floe size + ! TPI/SIG is period + x3=min(ICECOEF1,3.5) ! limit thickness to 3.5 m + x3=max(x3,0.1) ! limit thickness >0.1 m since I make fit below + x2=min(ICECOEF5*0.5,100.0) ! convert dia to radius, limit to 100m + x2=max(2.5,x2) + x2sqr=x2*x2 + x3sqr=x3*x3 + amhb = 2.12e-3 + bmhb = 4.59e-2 + + DO IK=1, NK + x1=TPI/SIG(IK) ! period + x1sqr=x1*x1 + KARG1(ik)=-0.26982 + 1.5043*x3 - 0.70112*x3sqr + 0.011037*x2 + & + (-0.0073178)*x2*x3 + 0.00036604*x2*x3sqr + & + (-0.00045789)*x2sqr + 1.8034e-05*x2sqr*x3 + & + (-0.7246)*x1 + 0.12068*x1*x3 + & + (-0.0051311)*x1*x3sqr + 0.0059241*x1*x2 + & + 0.00010771*x1*x2*x3 - 1.0171e-05*x1*x2sqr + & + 0.0035412*x1sqr - 0.0031893*x1sqr*x3 + & + (-0.00010791)*x1sqr*x2 + & + 0.00031073*x1**3 + 1.5996e-06*x2**3 + 0.090994*x3**3 + KARG1(IK)=min(KARG1(IK),0.0) + ALPHA(IK) = 10.0**KARG1(IK) + perfour=x1sqr*x1sqr + if ((x1.gt.5.0) .and. (x1.lt.20.0)) then + ALPHA(IK) = ALPHA(IK) + amhb/x1sqr+bmhb/perfour + else if (x1.gt.20.0) then + ALPHA(IK) = amhb/x1sqr+bmhb/perfour + endif + WN_I(IK) = ALPHA(IK) * 0.5 + end do CASE DEFAULT WN_I = ICECOEF1 !Default to IC1: Uniform in k From d82913b8966b2209eb36419a98e3a05cd0aa079a Mon Sep 17 00:00:00 2001 From: Saeideh Banihashemi <91982033+sbanihash@users.noreply.github.com> Date: Thu, 12 Dec 2024 13:54:12 -0800 Subject: [PATCH 058/136] Addition of Regression Test (ww3_tic1.1/IC4_M10) (#1331) --- regtests/bin/matrix.base | 1 + regtests/ww3_tic1.1/info | 9 +++ .../input_IC4_M10/namelists_1-D.nml | 2 + regtests/ww3_tic1.1/input_IC4_M10/points.list | 16 ++++ regtests/ww3_tic1.1/input_IC4_M10/switch | 1 + .../ww3_tic1.1/input_IC4_M10/ww3_grid.inp | 43 ++++++++++ .../ww3_tic1.1/input_IC4_M10/ww3_grid.nml | 81 +++++++++++++++++++ .../ww3_tic1.1/input_IC4_M10/ww3_ounf.inp | 20 +++++ .../ww3_tic1.1/input_IC4_M10/ww3_ounf.nml | 29 +++++++ .../ww3_tic1.1/input_IC4_M10/ww3_outf.inp | 13 +++ .../input_IC4_M10/ww3_outp_spec.inp | 19 +++++ .../input_IC4_M10/ww3_outp_tab50.inp | 19 +++++ .../input_IC4_M10/ww3_outp_tab51.inp | 10 +++ .../input_IC4_M10/ww3_prep_icecon.inp | 38 +++++++++ .../ww3_tic1.1/input_IC4_M10/ww3_shel.inp | 69 ++++++++++++++++ .../ww3_tic1.1/input_IC4_M10/ww3_strt.inp | 17 ++++ 16 files changed, 387 insertions(+) create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/namelists_1-D.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/points.list create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/switch create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_outf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_spec.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab50.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab51.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_prep_icecon.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_shel.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10/ww3_strt.inp diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 824b358f17..4b7e1e71ae 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -1957,6 +1957,7 @@ echo "$rtst -w work_IC4_M7 -i input_IC4_M7 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -w work_IC4_M8 -i input_IC4_M8 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -w work_IC4_M9 -i input_IC4_M9 $ww3 ww3_tic1.1" >> matrix.body + echo "$rtst -w work_IC4_M10 -i input_IC4_M10 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M1 -i input_IC5_M1 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M2 -i input_IC5_M2 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M3 -i input_IC5_M3 $ww3 ww3_tic1.1" >> matrix.body diff --git a/regtests/ww3_tic1.1/info b/regtests/ww3_tic1.1/info index 589317ea53..bb3c7e84aa 100644 --- a/regtests/ww3_tic1.1/info +++ b/regtests/ww3_tic1.1/info @@ -54,6 +54,7 @@ # IC4METHOD = 8 - Meylan et al. (2018) ; Liu et al. (2020) # # (NB: redundant with IC5+IC5VEMOD=3) # # IC4METHOD = 9 - RYW (2021) ; Yu et al. (2022) # +# IC4METHOD = 10 - Meylan et al. (2021) # # IC5 = Choose from three different effective medium models # # IC5VEMOD = 1 - Extended Fox and Squire model (EFS) # # IC5VEMOD = 2 - Robinson and Palmer model (RP) # @@ -101,6 +102,14 @@ # 'IC1' 19680606 000000 5.35E-6 # # 'IC2' 19680606 000000 16.05E-6 # # # +# ------------> &SIC4 IC4METHOD = 10 / # +# ...ICECOEF1, ICECOEF5 are required: # +# T T Ice parameter 1 # +# T T Ice parameter 5 # +# ... # +# 'IC1' 19680606 000000 0.2 # +# 'IC5' 19680606 000000 0.459 # +# # # Reference (w/plots): Rogers and Orzech, NRL Memorandum Report (2013) # # available from http://www7320.nrlssc.navy.mil/pubs.php # # (This report only covers IC1 and IC2, not IC3, which is newer) # diff --git a/regtests/ww3_tic1.1/input_IC4_M10/namelists_1-D.nml b/regtests/ww3_tic1.1/input_IC4_M10/namelists_1-D.nml new file mode 100644 index 0000000000..53fac9fd0e --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/namelists_1-D.nml @@ -0,0 +1,2 @@ +&SIC4 IC4METHOD = 10 / +END OF NAMELISTS diff --git a/regtests/ww3_tic1.1/input_IC4_M10/points.list b/regtests/ww3_tic1.1/input_IC4_M10/points.list new file mode 100644 index 0000000000..e2a0afe3d4 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/points.list @@ -0,0 +1,16 @@ +0.00 0. 'Point 1 ' +1.00E3 0. 'Point 2 ' +2.00E3 0. 'Point 3 ' +3.00E3 0. 'Point 4 ' +4.00E3 0. 'Point 5 ' +5.00E3 0. 'Point 6 ' +6.00E3 0. 'Point 7 ' +7.00E3 0. 'Point 8 ' +8.00E3 0. 'Point 9 ' +9.00E3 0. 'Point 10 ' +10.00E3 0. 'Point 11 ' +11.00E3 0. 'Point 12 ' +12.00E3 0. 'Point 13 ' +13.00E3 0. 'Point 14 ' +14.00E3 0. 'Point 15 ' +15.00E3 0. 'Point 16 ' diff --git a/regtests/ww3_tic1.1/input_IC4_M10/switch b/regtests/ww3_tic1.1/input_IC4_M10/switch new file mode 100644 index 0000000000..31ef85baed --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/switch @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC4 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.inp new file mode 100644 index 0000000000..19e03a81c5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.inp @@ -0,0 +1,43 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + '1-D parameterized ice test ' +$ +$ 1.1 0.04118 25 24 0.0 + 1.1 0.0418 31 36 5.0 +$ + F T F F F T + 60. 60. 60. 60. +$ +$ IC4METHOD determines calculation +$ IC4METHOD = 1 - Wadhams et al. (1988) +$ IC4METHOD = 2 - Meylan et al. (2014) +$ IC4METHOD = 3 - Kohout & Meylan (2008) in Horvat & Tziperman (2015) +$ IC4METHOD = 4 - Kohout et al. (2014) +$ IC4METHOD = 5 - Simple ki step function +$ IC4METHOD = 6 - Simple ki step function via namelist +$ IC4METHOD = 7 - Doble et al. (GRL 2015) +$ IC4METHOD = 8 - Meylan et al. (2018) ; Liu et al. (2020) +$ IC4METHOD = 9 - RYW (2021) ; Yu et al. (2022) +$ IC4M8 Fit to R21A L ChfM2=0.059 +$ IC4M10 + &SIC4 IC4METHOD = 10 , IC4CN = 0.059/ +END OF NAMELISTS +$ + 'RECT' F 'NONE' + 156 3 + 1.0E3 1.0E3 1. + -1.0E3 -1.0E3 1. +$ dlim dmin file# scale layout# format# formatdescrip filetype# filenm + -0.1 0.1 401 -1.0 1 1 '(....)' 'NAME' '../input_IC1/depth1d.flat' +$ + 10 1 1 '(....)' 'PART' 'input' +$ +$ First grid +$ + 2 2 F +$ + 0 0 F + 0 0 F + 0 0 +$ + 0. 0. 0. 0. 0 diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.nml b/regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.nml new file mode 100644 index 0000000000..e3f8dd58a7 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_grid.nml @@ -0,0 +1,81 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.0418 + SPECTRUM%NK = 31 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 5.0 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 60. + TIMESTEPS%DTXY = 60. + TIMESTEPS%DTKTH = 60. + TIMESTEPS%DTMIN = 60. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = '1-D parameterized ice test' + GRID%NML = '../input_IC4_M10/namelists_1-D.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'CART' + GRID%CLOS = 'NONE' + GRID%ZLIM = -0.1 + GRID%DMIN = 0.1 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 156 + RECT%NY = 3 + RECT%SX = 1.0E3 + RECT%SY = 1.0E3 + RECT%X0 = -1.0E3 + RECT%Y0 = -1.0E3 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -1.0 + DEPTH%FILENAME = '../input_IC1/depth1d.flat' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 1 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 2 2 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.inp new file mode 100644 index 0000000000..4104d759ea --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.inp @@ -0,0 +1,20 @@ +$ WAVEWATCH III Grid output post-processing (netcdf) +$--------------------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 4 + 0 1 2 + F + ww3. + 4 + 1 999 1 999 3 2 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.nml b/regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.nml new file mode 100644 index 0000000000..46aa758fac --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '19680606 000000' + FIELD%TIMESTRIDE = '3600.' + FIELD%TIMECOUNT = '99' + FIELD%TIMESPLIT = 4 + FIELD%LIST = 'DPT WLV HS DIR' + FIELD%PARTITION = '0 1 2' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IXN = 999 + FILE%IYN = 999 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_outf.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outf.inp new file mode 100644 index 0000000000..2b4c6bca80 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outf.inp @@ -0,0 +1,13 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 0 +$ + 1 999 1 999 1 1 diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_spec.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_spec.inp new file mode 100644 index 0000000000..b500e0ca4d --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_spec.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 120000 3600. 1 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 1 + 2 -1. 0. 33 F diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab50.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab50.inp new file mode 100644 index 0000000000..826bd422d5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab50.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 600. 9999 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 2 + 2 50 diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab51.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab51.inp new file mode 100644 index 0000000000..e54faed463 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_outp_tab51.inp @@ -0,0 +1,10 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 900. 49 +$ +$ 1 + 11 + -1 +$ + 2 + 2 51 diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_prep_icecon.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_prep_icecon.inp new file mode 100644 index 0000000000..26a94221f5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_prep_icecon.inp @@ -0,0 +1,38 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : IC1, IC2, IC3, IC4, IC5 => Ice parameters (5) +$ MDN => Mud densities +$ MTH => Mud thicknesses +$ MVS => Mud viscosities +$ ICE => Ice concentrations. +$ LEV => Water levels. +$ WND => Winds. +$ WNS => Winds (including air-sea temp. dif.) +$ CUR => Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ Header flag : If true, write header on "*.ww3" data file +$ + 'ICE' 'AI' T T +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 000000 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F6.2))' + 2345 '../input_IC2_nondisp/icecon.156x3.txt' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_shel.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_shel.inp new file mode 100644 index 0000000000..2be39573e7 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_shel.inp @@ -0,0 +1,69 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + T T Ice parameter 1 + F F Ice parameter 2 + F F Ice parameter 3 + F F Ice parameter 4 + T T Ice parameter 5 + F F Mud parameter 1 + F F Mud parameter 2 + F F Mud parameter 3 + F F Water levels + F F Currents + F F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 19680606 000000 + 19680606 120000 +$ + 1 +$ + 19680606 000000 900 19680606 120000 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT HS ICE DIR EF + 19680606 000000 900 19680606 120000 + 0.00 0. 'Point 1 ' + 1.00E3 0. 'Point 2 ' + 2.00E3 0. 'Point 3 ' + 3.00E3 0. 'Point 4 ' + 4.00E3 0. 'Point 5 ' + 5.00E3 0. 'Point 6 ' + 6.00E3 0. 'Point 7 ' + 7.00E3 0. 'Point 8 ' + 8.00E3 0. 'Point 9 ' + 9.00E3 0. 'Point 10 ' + 10.00E3 0. 'Point 11 ' + 11.00E3 0. 'Point 12 ' + 12.00E3 0. 'Point 13 ' + 13.00E3 0. 'Point 14 ' + 14.00E3 0. 'Point 15 ' + 15.00E3 0. 'Point 16 ' + 0. 0. 'STOPSTRING' + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ constant case: +$ Meylan et al. (2014) pg 5050 : a=2.12e-3 and b=4.59e-2 + 'IC1' 19680606 000000 0.2 + 'IC5' 19680606 000000 4.59E-2 + 'STP' +$ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M10/ww3_strt.inp b/regtests/ww3_tic1.1/input_IC4_M10/ww3_strt.inp new file mode 100644 index 0000000000..49747e41af --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10/ww3_strt.inp @@ -0,0 +1,17 @@ +$ WAVEWATCH III Initial conditions input file +$ ------------------------------------------- + 2 +$ 0.1 0.0001 225. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 315. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 240. 2 0. -5.E3 0. 5.E3 1.0 +$ fp sip thm ncos xm six ym siy hmax +$ 0.1 0.0001 270. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 270. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 300. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 135. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 45. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 120. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 60. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ +$ alpha fp thm gamma sigA sigB xm six ym siy + 0.0081 0.1 270.0 1.0 0.07 0.09 0. -5.E3 0. 5.E3 From 488e3c8e18bc5899625d2255d56440e671f96238 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 13 Dec 2024 20:34:27 +0000 Subject: [PATCH 059/136] Update IS_IN_UNGRID to handle if grid lon defintions are mismatched (#1325) --- model/src/w3triamd.F90 | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index 9fac503b6a..b7fb6aaecf 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -1716,7 +1716,7 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) !/ ------------------------------------------------------------------- / !local parameters - DOUBLE PRECISION :: x1, x2, x3 + DOUBLE PRECISION :: x1, x2, x3, XTINmod, xavg DOUBLE PRECISION :: y1, y2, y3 DOUBLE PRECISION :: s1, s2, s3, sg1, sg2, sg3 REAL*8 :: PT(3,2) @@ -1748,19 +1748,26 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) !coordinates of the 3rd vertex C x3 = PT(3,1) y3 = PT(3,2) - !with M = (XTIN,YTIN) the target point ... + !ensure XTIN is defined with same coordinates as element + xavg=(x1+x2+x3)/3 + IF (ABS(XTIN-xavg).GT.180) THEN + XTINmod=XTIN-SIGN(360.0d0,(XTIN-xavg)) + ELSE + XTINmod=XTIN + END IF + !with M = (XTINmod,YTIN) the target point ... !vector product of AB and AC sg3=(y3-y1)*(x2-x1)-(x3-x1)*(y2-y1) !vector product of AB and AM - s3=(YTIN-y1)*(x2-x1)-(XTIN-x1)*(y2-y1) + s3=(YTIN-y1)*(x2-x1)-(XTINmod-x1)*(y2-y1) !vector product of BC and BA sg1=(y1-y2)*(x3-x2)-(x1-x2)*(y3-y2) !vector product of BC and BM - s1=(YTIN-y2)*(x3-x2)-(XTIN-x2)*(y3-y2) + s1=(YTIN-y2)*(x3-x2)-(XTINmod-x2)*(y3-y2) !vector product of CA and CB sg2=(y2-y3)*(x1-x3)-(x2-x3)*(y1-y3) !vector product of CA and CM - s2=(YTIN-y3)*(x1-x3)-(XTIN-x3)*(y1-y3) + s2=(YTIN-y3)*(x1-x3)-(XTINmod-x3)*(y1-y3) IF ((s1*sg1.GE.0).AND.(s2*sg2.GE.0).AND.(s3*sg3.GE.0)) THEN itout=ITRI nbFound=nbFound+1 From e82df7827a0e3ca1d0e706bfd8b1bd84466dd20d Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 20 Dec 2024 16:55:48 +0000 Subject: [PATCH 060/136] Optional point weight file (pnt_wght.ww3.nc) for unstructured grid to speed up initialization (#1333) --- model/src/w3gridmd.F90 | 2 +- model/src/w3initmd.F90 | 7 +- model/src/w3iopomd.F90 | 295 +++++++++++++++++++++++++++--------- model/src/w3triamd.F90 | 2 +- model/src/wmiopomd.F90 | 4 +- regtests/bin/run_cmake_test | 10 ++ 6 files changed, 243 insertions(+), 77 deletions(-) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index ecf2726a0e..8bfc6521a7 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -845,7 +845,7 @@ MODULE W3GRIDMD #ifdef W3_ST4 INTEGER :: SWELLFPAR, SDSISO, SDSBRFDF, SINTABLE,& TAUWBUG - REAL :: SDSBCHOICE + REAL :: SDSBCHOICE REAL :: ZWND, ALPHA0, Z0MAX, BETAMAX, SINTHP,& ZALP, Z0RAT, TAUWSHELTER, SWELLF, & SWELLF2,SWELLF3,SWELLF4, SWELLF5, & diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 4badbcb1a3..fbefffc843 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -658,7 +658,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, STOP ENDIF #endif - ! ! 1.c Open files without unpacking MDS ,,, ! @@ -1240,7 +1239,11 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! ! 4.d Preprocessing for point output. ! - IF ( FLOUT(2) ) CALL W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) +#ifdef W3_MPI + IF ( FLOUT(2) ) CALL W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_WAVE ) +#else + IF ( FLOUT(2) ) CALL W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, 1 ) +#endif #ifdef W3_PDLIB CALL DEALLOCATE_PDLIB_GLOBAL(IMOD) #endif diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index bbdfda34c0..fec7586386 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -146,6 +146,10 @@ MODULE W3IOPOMD !> Dimension name for the netCDF point output file, for WW3TIME character(*), parameter, private :: DNAME_WW3TIME = 'WW3TIME' + !> Dimension name for the netCDF point weight file, WGHTLEN + !> This is 4 the dimension of weights + character(*), parameter, private :: DNAME_WGHTLEN = 'WGHTLEN' + !> Variable name for the netCDF point output file, for NK. character(*), parameter, private :: VNAME_NK = 'NK' @@ -158,6 +162,12 @@ MODULE W3IOPOMD !> Variable name for the netCDF point output file, for PTNME. character(*), parameter, private :: VNAME_PTNME = 'PTNME' + !> Variable name for the netCDF point weight file, for IPTINT + character(*), parameter, private :: VNAME_IPTINT = 'IPTINT' + + !> Variable name for the netCDF point weight file, for PTIFAC + character(*), parameter, private :: VNAME_PTIFAC = 'PTIFAC' + !> Variable name for the netCDF point output file, for TIME. character(*), parameter, private :: VNAME_TIME = 'TIME' @@ -226,7 +236,7 @@ MODULE W3IOPOMD !> !> @author H. L. Tolman @date 02-Sep-2012 !> - SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) + SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -329,7 +339,8 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GSRUMD + USE NETCDF + USE W3GSRUMD, ONLY: W3GRMP USE W3GDATMD, ONLY: NTH, NK, NSPEC, NX, NY, X0, Y0, SX, GSU,& RLGTYPE, CLGTYPE, UNGTYPE, GTYPE, FLAGLL, & ICLOSE,ICLOSE_NONE,ICLOSE_SMPL,ICLOSE_TRPL, & @@ -340,21 +351,25 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) USE W3GDATMD, ONLY: PoLat, PoLon, FLAGUNR USE W3SERVMD, ONLY: W3LLTOEQ #endif - USE W3ODATMD, ONLY: W3DMO2 + USE W3ODATMD, ONLY: W3DMO2, FNMPRE USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, NAPOUT, SCREEN, & NOPTS, PTLOC, PTNME, GRDID, IPTINT, PTIFAC USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3TRIAMD + USE W3TRIAMD, ONLY: IS_IN_UNGRID + USE W3GDATMD, ONLY: FILEXT ! IMPLICIT NONE +#ifdef W3_MPI + INCLUDE "mpif.h" +#endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: NPT, IMOD + INTEGER, INTENT(IN) :: NPT, IMOD, MPI_COMM_IOPP REAL, INTENT(INOUT) :: XPT(NPT), YPT(NPT) CHARACTER(LEN=40),INTENT(IN) :: PNAMES(NPT) !/ @@ -389,6 +404,16 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) !! Declare a few temporary variables for rotated grid. JGLi12Jun2012 REAL, ALLOCATABLE :: EquLon(:),EquLat(:),StdLon(:),StdLat(:),AnglPT(:) #endif + ! Variables for NetCDF weights file for points + character(len = 124) :: filename + logical :: pnt_wght_exists, pnt_wght_write + integer :: ncerr, fh + integer :: d_nopts, d_namelen, d_vsize, d_wghtlen + integer :: d_nopts_len, d_vsize_len,d_namelen_len,d_wghtlen_len + integer :: v_ptloc, v_ptnme, v_iptint, v_ptifac +#ifdef W3_MPI + integer :: IERR_MPI +#endif !/ !/ ------------------------------------------------------------------- / !/ @@ -423,86 +448,214 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) #endif ! - ! Removed by F.A. 2011/04/04 /T CALL W3GSUP( GSU, NDST ) + !If unstructured grid, check to see if a netcdf point weight file exists: + filename = 'pnt_wght.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + IF (GTYPE .NE. UNGTYPE) THEN + !skipping weights file for non-unstructured grids. + !likely could be used after proper testing if initialization time is long + pnt_wght_exists = .FALSE. + pnt_wght_write = .FALSE. + ELSE + !for unstructured grid, use saved weights file if exists: + INQUIRE(FILE=filename, EXIST=pnt_wght_exists) + pnt_wght_write = .NOT. pnt_wght_exists + ENDIF ! - ! Loop over output points + ! Loop over output points if saved weights do not exist ! - DO IPT=1, NPT - ! + IF (.NOT. pnt_wght_exists) THEN + DO IPT=1, NPT + ! #ifdef W3_T - WRITE (NDST,9010) IPT, XPT(IPT), YPT(IPT), PNAMES(IPT) + WRITE (NDST,9010) IPT, XPT(IPT), YPT(IPT), PNAMES(IPT) #endif - ! + ! #ifdef W3_RTD - !! Need to wrap rotated Elon values greater than X0. JGLi12Jun2012 - XPT(IPT) = MOD( EquLon(IPT)+360.0, 360.0 ) - IF( XPT(IPT) .LT. X0 ) XPT(IPT) = XPT(IPT) + 360.0 + !! Need to wrap rotated Elon values greater than X0. JGLi12Jun2012 + XPT(IPT) = MOD( EquLon(IPT)+360.0, 360.0 ) + IF( XPT(IPT) .LT. X0 ) XPT(IPT) = XPT(IPT) + 360.0 #endif - ! - ! Check if point within grid and compute interpolation weights - ! - IF (GTYPE .NE. UNGTYPE) THEN - INGRID = W3GRMP( GSU, XPT(IPT), YPT(IPT), IX, IY, RD ) - ELSE - CALL IS_IN_UNGRID(IMOD, DBLE(XPT(IPT)), DBLE(YPT(IPT)), itout, IX, IY, RD) - INGRID = (ITOUT.GT.0) - END IF - ! - IF ( .NOT.INGRID ) THEN - IF ( IAPROC .EQ. NAPERR ) THEN - IF ( FLAGLL ) THEN - WRITE (NDSE,1000) XPT(IPT), YPT(IPT), PNAMES(IPT) - ELSE - WRITE (NDSE,1001) XPT(IPT), YPT(IPT), PNAMES(IPT) + ! + ! Check if point within grid and compute interpolation weights + ! + IF (GTYPE .NE. UNGTYPE) THEN + INGRID = W3GRMP( GSU, XPT(IPT), YPT(IPT), IX, IY, RD ) + ELSE + CALL IS_IN_UNGRID(IMOD, DBLE(XPT(IPT)), DBLE(YPT(IPT)), itout, IX, IY, RD) + INGRID = (ITOUT.GT.0) + END IF + ! + IF ( .NOT.INGRID ) THEN + IF ( IAPROC .EQ. NAPERR ) THEN + IF ( FLAGLL ) THEN + WRITE (NDSE,1000) XPT(IPT), YPT(IPT), PNAMES(IPT) + ELSE + WRITE (NDSE,1001) XPT(IPT), YPT(IPT), PNAMES(IPT) + END IF END IF + CYCLE END IF - CYCLE - END IF - ! + ! #ifdef W3_T - DO K = 1,4 - WRITE (NDST,9012) IX(K), IY(K), RD(K) - END DO + DO K = 1,4 + WRITE (NDST,9012) IX(K), IY(K), RD(K) + END DO #endif - ! - ! Check if point not on land - ! - IF ( MAPSTA(IY(1),IX(1)) .EQ. 0 .AND. & - MAPSTA(IY(2),IX(2)) .EQ. 0 .AND. & - MAPSTA(IY(3),IX(3)) .EQ. 0 .AND. & - MAPSTA(IY(4),IX(4)) .EQ. 0 ) THEN - IF ( IAPROC .EQ. NAPERR ) THEN - IF ( FLAGLL ) THEN - WRITE (NDSE,1002) XPT(IPT), YPT(IPT), PNAMES(IPT) - ELSE - WRITE (NDSE,1003) XPT(IPT), YPT(IPT), PNAMES(IPT) + ! + ! Check if point not on land + ! + IF ( MAPSTA(IY(1),IX(1)) .EQ. 0 .AND. & + MAPSTA(IY(2),IX(2)) .EQ. 0 .AND. & + MAPSTA(IY(3),IX(3)) .EQ. 0 .AND. & + MAPSTA(IY(4),IX(4)) .EQ. 0 ) THEN + IF ( IAPROC .EQ. NAPERR ) THEN + IF ( FLAGLL ) THEN + WRITE (NDSE,1002) XPT(IPT), YPT(IPT), PNAMES(IPT) + ELSE + WRITE (NDSE,1003) XPT(IPT), YPT(IPT), PNAMES(IPT) + END IF END IF + CYCLE END IF - CYCLE - END IF - ! - ! Store interpolation data - ! - NOPTS = NOPTS + 1 - ! - PTLOC (1,NOPTS) = XPT(IPT) - PTLOC (2,NOPTS) = YPT(IPT) + ! + ! Store interpolation data + ! + NOPTS = NOPTS + 1 + ! + PTLOC (1,NOPTS) = XPT(IPT) + PTLOC (2,NOPTS) = YPT(IPT) #ifdef W3_RTD - !! Store the standard lon/lat in PTLOC for output purpose, assuming - !! they are not used for any inside calculation. JGLi12Jun2012 - PTLOC (1,NOPTS) = StdLon(IPT) - PTLOC (2,NOPTS) = StdLat(IPT) + !! Store the standard lon/lat in PTLOC for output purpose, assuming + !! they are not used for any inside calculation. JGLi12Jun2012 + PTLOC (1,NOPTS) = StdLon(IPT) + PTLOC (2,NOPTS) = StdLat(IPT) #endif - ! - DO K = 1,4 - IPTINT(1,K,NOPTS) = IX(K) - IPTINT(2,K,NOPTS) = IY(K) - PTIFAC(K,NOPTS) = RD(K) - END DO + ! + DO K = 1,4 + IPTINT(1,K,NOPTS) = IX(K) + IPTINT(2,K,NOPTS) = IY(K) + PTIFAC(K,NOPTS) = RD(K) + END DO - PTNME(NOPTS) = PNAMES(IPT) - ! - END DO ! End loop over output points (IPT). + PTNME(NOPTS) = PNAMES(IPT) + ! + END DO ! End loop over output points (IPT). + ELSE + ! Saved weight file exists, read weights from file + IF ( IAPROC .EQ. 1 ) THEN + ! Open the netCDF file. + ncerr = nf90_open(filename, NF90_NOWRITE, fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for NOPTS. + ncerr = nf90_inq_dimid(fh, DNAME_NOPTS, d_nopts) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_nopts, len = d_nopts_len) + if (nf90_err(ncerr) .ne. 0) return + NOPTS=d_nopts_len + + ! Read the dimension information for VSIZE. + ncerr = nf90_inq_dimid(fh, DNAME_VSIZE, d_vsize) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_vsize, len = d_vsize_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for NAMELEN. + ncerr = nf90_inq_dimid(fh, DNAME_NAMELEN, d_namelen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_namelen, len = d_namelen_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read the dimension information for WGHTLEN. + ncerr = nf90_inq_dimid(fh, DNAME_WGHTLEN, d_wghtlen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_inquire_dimension(fh, d_wghtlen, len = d_wghtlen_len) + if (nf90_err(ncerr) .ne. 0) return + + ! Read vars + ncerr = nf90_inq_varid(fh, VNAME_PTLOC, v_ptloc) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptloc, PTLOC, start = (/ 1, 1/), & + count = (/ d_vsize_len, d_nopts_len /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_inq_varid(fh, VNAME_PTNME, v_ptnme) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptnme, PTNME, start = (/ 1, 1/), & + count = (/ d_namelen_len, d_nopts_len /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_inq_varid(fh, VNAME_IPTINT, v_iptint) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_iptint, IPTINT, start = (/ 1, 1/), & + count = (/ d_vsize_len, d_wghtlen_len, d_nopts_len /)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_inq_varid(fh, VNAME_PTIFAC, v_ptifac) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_get_var(fh, v_ptifac, PTIFAC, start = (/ 1, 1/), & + count = (/ d_wghtlen_len, d_nopts_len /)) + if (nf90_err(ncerr) .ne. 0) return + END IF +#ifdef W3_MPI + ! Broadcast weight info to all MPI tasks: + CALL MPI_BCAST(NOPTS,1,MPI_INTEGER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTNME,40*NPT,MPI_CHARACTER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTLOC,2*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(IPTINT,2*4*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTIFAC,4*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_Barrier(MPI_COMM_IOPP,IERR_MPI) +#endif + ENDIF !end if point weight file exists + + !Create a weights file if there are output points: + IF ( pnt_wght_write .AND. (NOPTS > 0) ) THEN + IF ( IAPROC .EQ. 1 ) THEN + ! Create the netCDF file. + ncerr = nf90_create(filename, NF90_NETCDF4, fh) + if (nf90_err(ncerr) .ne. 0) return + + ! Define dimensions. + ncerr = nf90_def_dim(fh, DNAME_NOPTS, NOPTS, d_nopts) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_NAMELEN, 40, d_namelen) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_VSIZE, 2, d_vsize) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_dim(fh, DNAME_WGHTLEN, 4, d_wghtlen) + if (nf90_err(ncerr) .ne. 0) return + + ! Define vars with nopts as a dimension. Point location and name + ncerr = nf90_def_var(fh, VNAME_PTLOC, NF90_FLOAT, (/d_vsize, d_nopts/), v_ptloc) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_PTNME, NF90_CHAR, (/d_namelen, d_nopts/), v_ptnme) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_IPTINT, NF90_FLOAT, (/d_vsize, d_wghtlen, d_nopts/), v_iptint) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_def_var(fh, VNAME_PTIFAC, NF90_FLOAT, (/d_wghtlen, d_nopts/), v_ptifac) + if (nf90_err(ncerr) .ne. 0) return + + ! End of all variable definitions + ncerr = nf90_enddef(fh) + if (nf90_err(ncerr) .ne. 0) return + + !write variables to file + ncerr = nf90_put_var(fh, v_ptloc, PTLOC(:,1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_var(fh, v_ptnme, PTNME(1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + + ncerr = nf90_put_var(fh, v_iptint, IPTINT(:,:,1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + ncerr = nf90_put_var(fh, v_ptifac, PTIFAC(:,1:NOPTS)) + if (nf90_err(ncerr) .ne. 0) return + + ! Close the file. + ncerr = nf90_close(fh) + if (nf90_err(ncerr) .ne. 0) return + + END IF + ENDIF ! #ifdef W3_RTD DEALLOCATE( EquLon, EquLat, StdLon, StdLat, AnglPT ) @@ -1115,7 +1268,6 @@ SUBROUTINE W3IOPE ( A ) !/ END SUBROUTINE W3IOPE -#ifdef W3_BIN2NC !> Handle netCDF return code. !> !> @param errcode NetCDF error code. 0 for no error. @@ -1137,6 +1289,7 @@ integer function nf90_err_check(errcode, ILINE) return endif end function nf90_err_check +#ifdef W3_BIN2NC !> Read point output in netCDF format. !> diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index b7fb6aaecf..f2118ec246 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -1697,7 +1697,7 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD + USE W3GDATMD, ONLY: GRIDS USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index bce460483c..1737e04bbf 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -500,7 +500,7 @@ SUBROUTINE WMIOPP ( NPT, XPT, YPT, PNAMES ) #endif ! #ifdef W3_SHRD - CALL W3IOPP ( MDATAS(J)%NRUPTS, XP, YP, PN, J ) + CALL W3IOPP ( MDATAS(J)%NRUPTS, XP, YP, PN, J, 1) #endif ! ! 3.d.2 Distributed memory version @@ -535,7 +535,7 @@ SUBROUTINE WMIOPP ( NPT, XPT, YPT, PNAMES ) #endif ! #ifdef W3_MPI - CALL W3IOPP ( MDATAS(J)%NRUPTS, XP, YP, PN, J ) + CALL W3IOPP ( MDATAS(J)%NRUPTS, XP, YP, PN, J, MPI_COMM_MWAVE) #endif ! #ifdef W3_MPI diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index 07ade5a8ba..d7e05497b9 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -1358,6 +1358,16 @@ fi done fi +# copy pnt weight files from input to work directory + pntwghtfile=`\ls $path_i/pnt_wght.*.nc 2>/dev/null` + if [ ! -z "$pntwghtfile" ]; then + for pntwghtnc in $pntwghtfile + do + cp $pntwghtnc . + echo "copying $pntwghtnc to $path_w" + done + fi + if [ $multi -ge 1 ] then prog=ww3_multi From e409f8110402f173410aceb355bc31abfbea1f57 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Mon, 13 Jan 2025 19:57:30 -0500 Subject: [PATCH 061/136] Fix indentation in w3wave and w3iogomd (#1339) fix indentation in w3wave and additional indents --- model/src/w3iogomd.F90 | 591 ++++++++++++++++++----------------------- model/src/w3wavemd.F90 | 126 ++++----- 2 files changed, 328 insertions(+), 389 deletions(-) diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index de660ded47..7a9fca02ad 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -4663,295 +4663,248 @@ END SUBROUTINE CALC_WBT !> !> @author P. Janssen @date 29-Mar-2024 !> - SUBROUTINE SECONDHH(NKHF,FAC0,FAC1,FAC2,FAC3) -!---------------------------------------------------------------- - -!**** *SECONDHH* - COMPUTATION OF SECOND ORDER HARMONICS AND -! RELEVANT TABLES FOR THE ALTIMETER CORRECTIONS. - -! P.A.E.M. JANSSEN - -! PURPOSE. -! --------- - -! COMPUTE SECOND HARMONICS - -!** INTERFACE. -! ---------- - -! *CALL* *SECONDHH* - -! METHOD. -! ------- - -! SEE REFERENCE. - -! EXTERNALS. -! ---------- - -! VMIN_D -! VPLUS_D - -! REFERENCES. -! ----------- - -! V E ZAKHAROV(1967) - -!------------------------------------------------------------------- - -!------------------------------------------------------------------- -USE CONSTANTS, ONLY: GRAV, TPI -USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, TH, DTH, ECOS, ESIN - IMPLICIT NONE - ! REAL(KIND=4) :: VMIN_D,VPLUS_D - - - - INTEGER, INTENT(IN) :: NKHF - REAL(KIND=4), DIMENSION(NTH,NTH,NKHF,NKHF), INTENT(OUT) :: FAC0, FAC1, FAC2, FAC3 - REAL(KIND=4), PARAMETER :: FRATIO = 1.1 - - - INTEGER :: M, K1, M1, K2, M2 - - REAL(KIND=4), PARAMETER :: DEL1=1.0E-8 - REAL(KIND=4), PARAMETER :: ZCONST = 0.0281349 - - !REAL(KIND=4) :: VMIN_D, VPLUS_D - REAL(KIND=4) :: CO1 - REAL(KIND=4) :: XK1, XK1SQ, XK2, XK2SQ, XK3 - REAL(KIND=4) :: COSDIFF - REAL(KIND=4) :: X12, X13, X32, OM1, OM2, OM3, F1, F2, F3 - REAL(KIND=4) :: VM, VP - REAL(KIND=4) :: DELOM1, DELOM2 - REAL(KIND=4) :: DELOM321, DELOM312 - REAL(KIND=4) :: C22, S22 - - REAL(KIND=4), DIMENSION(NTH,NTH,NKHF,NKHF) :: B - REAL(KIND=4), DIMENSION(:), ALLOCATABLE:: FAK, SIGHF, DFIMHF - - - - -!----------------------------------------------------------------------- - - - - -!* 1. INITIALISE RELEVANT QUANTITIES. - - ALLOCATE(FAK(NKHF)) - ALLOCATE(SIGHF(NKHF)) - ALLOCATE(DFIMHF(NKHF)) - - SIGHF(1) = SIG(1) - DO M=2,NKHF - SIGHF(M) = XFR*SIGHF(M-1) - ENDDO - - DO M=1,NKHF - FAK(M) = (SIGHF(M))**2/GRAV - ENDDO - - CO1 = 0.5*(XFR-1.)*DTH - DFIMHF(1) = CO1*SIGHF(1) - DO M=2,NKHF-1 - DFIMHF(M)=CO1*(SIGHF(M)+SIGHF(M-1)) - ENDDO - DFIMHF(NKHF)=CO1*SIGHF(NKHF-1) + SUBROUTINE SECONDHH(NKHF,FAC0,FAC1,FAC2,FAC3) + !---------------------------------------------------------------- + !**** *SECONDHH* - COMPUTATION OF SECOND ORDER HARMONICS AND + ! RELEVANT TABLES FOR THE ALTIMETER CORRECTIONS. + ! P.A.E.M. JANSSEN + ! PURPOSE. + ! --------- + ! COMPUTE SECOND HARMONICS + !** INTERFACE. + ! ---------- + ! *CALL* *SECONDHH* + ! METHOD. + ! ------- + ! SEE REFERENCE. + ! EXTERNALS. + ! ---------- + ! VMIN_D + ! VPLUS_D + ! REFERENCES. + ! ----------- + ! V E ZAKHAROV(1967) + !------------------------------------------------------------------- + USE CONSTANTS, ONLY: GRAV, TPI + USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, TH, DTH, ECOS, ESIN + IMPLICIT NONE - DO M2=1,NKHF - XK2 = FAK(M2) - XK2SQ = FAK(M2)**2 - DO M1=1,NKHF - XK1 = FAK(M1) - XK1SQ = FAK(M1)**2 - DO K1=1,NTH - DO K2=1,NTH - COSDIFF = COS(TH(K1)-TH(K2)) - X12 = XK1*XK2*COSDIFF - XK3 = XK1SQ + XK2SQ +2.0*X12 +DEL1 - XK3 = SQRT(XK3) - X13 = XK1SQ+X12 - X32 = X12+XK2SQ - OM1 = SQRT(GRAV*XK1) - OM2 = SQRT(GRAV*XK2) - OM3 = SQRT(GRAV*XK3) - F1 = SQRT(XK1/(2.0*OM1)) - F2 = SQRT(XK2/(2.0*OM2)) - F3 = SQRT(XK3/(2.0*OM3)) - VM = TPI*VMIN_D(XK3,XK1,XK2,X13,X32,X12,OM3,OM1,OM2) - VP = TPI*VPLUS_D(-XK3,XK1,XK2,-X13,-X32,X12,OM3,OM1,OM2) - DELOM1 = OM3-OM1-OM2+DEL1 - DELOM2 = OM3+OM1+OM2+DEL1 - FAC0(K1,K2,M1,M2) = -F3/(F1*F2)*(VM/(DELOM1)+ & - & VP/(DELOM2)) - ENDDO + INTEGER, INTENT(IN) :: NKHF + REAL(KIND=4), DIMENSION(NTH,NTH,NKHF,NKHF), INTENT(OUT) :: FAC0, FAC1, FAC2, FAC3 + REAL(KIND=4), PARAMETER :: FRATIO = 1.1 + + INTEGER :: M, K1, M1, K2, M2 + + REAL(KIND=4), PARAMETER :: DEL1=1.0E-8 + REAL(KIND=4), PARAMETER :: ZCONST = 0.0281349 + + !REAL(KIND=4) :: VMIN_D, VPLUS_D + REAL(KIND=4) :: CO1 + REAL(KIND=4) :: XK1, XK1SQ, XK2, XK2SQ, XK3 + REAL(KIND=4) :: COSDIFF + REAL(KIND=4) :: X12, X13, X32, OM1, OM2, OM3, F1, F2, F3 + REAL(KIND=4) :: VM, VP + REAL(KIND=4) :: DELOM1, DELOM2 + REAL(KIND=4) :: DELOM321, DELOM312 + REAL(KIND=4) :: C22, S22 + + REAL(KIND=4), DIMENSION(NTH,NTH,NKHF,NKHF) :: B + REAL(KIND=4), DIMENSION(:), ALLOCATABLE:: FAK, SIGHF, DFIMHF + !----------------------------------------------------------------------- + !* 1. INITIALISE RELEVANT QUANTITIES. + + ALLOCATE(FAK(NKHF)) + ALLOCATE(SIGHF(NKHF)) + ALLOCATE(DFIMHF(NKHF)) + + SIGHF(1) = SIG(1) + DO M=2,NKHF + SIGHF(M) = XFR*SIGHF(M-1) + ENDDO + + DO M=1,NKHF + FAK(M) = (SIGHF(M))**2/GRAV + ENDDO + + CO1 = 0.5*(XFR-1.)*DTH + DFIMHF(1) = CO1*SIGHF(1) + DO M=2,NKHF-1 + DFIMHF(M)=CO1*(SIGHF(M)+SIGHF(M-1)) + ENDDO + DFIMHF(NKHF)=CO1*SIGHF(NKHF-1) + + DO M2=1,NKHF + XK2 = FAK(M2) + XK2SQ = FAK(M2)**2 + DO M1=1,NKHF + XK1 = FAK(M1) + XK1SQ = FAK(M1)**2 + DO K1=1,NTH + DO K2=1,NTH + COSDIFF = COS(TH(K1)-TH(K2)) + X12 = XK1*XK2*COSDIFF + XK3 = XK1SQ + XK2SQ +2.0*X12 +DEL1 + XK3 = SQRT(XK3) + X13 = XK1SQ+X12 + X32 = X12+XK2SQ + OM1 = SQRT(GRAV*XK1) + OM2 = SQRT(GRAV*XK2) + OM3 = SQRT(GRAV*XK3) + F1 = SQRT(XK1/(2.0*OM1)) + F2 = SQRT(XK2/(2.0*OM2)) + F3 = SQRT(XK3/(2.0*OM3)) + VM = TPI*VMIN_D(XK3,XK1,XK2,X13,X32,X12,OM3,OM1,OM2) + VP = TPI*VPLUS_D(-XK3,XK1,XK2,-X13,-X32,X12,OM3,OM1,OM2) + DELOM1 = OM3-OM1-OM2+DEL1 + DELOM2 = OM3+OM1+OM2+DEL1 + FAC0(K1,K2,M1,M2) = -F3/(F1*F2)*(VM/(DELOM1)+VP/(DELOM2)) ENDDO ENDDO ENDDO - - DO M2=1,NKHF - XK2 = FAK(M2) - XK2SQ = FAK(M2)**2 - DO M1=1,NKHF - XK1 = FAK(M1) - XK1SQ = FAK(M1)**2 - DO K1=1,NTH - DO K2=1,NTH - COSDIFF = COS(TH(K1)-TH(K2)) - X12 = XK1*XK2*COSDIFF - XK3 = XK1SQ + XK2SQ - 2.*X12 + DEL1 - XK3 = SQRT(XK3) - X13 = XK1SQ-X12 - X32 = X12-XK2SQ - OM1 = SQRT(GRAV*XK1) - OM2 = SQRT(GRAV*XK2) - OM3 = SQRT(GRAV*XK3)+DEL1 - F1 = SQRT(XK1/(2.0*OM1)) - F2 = SQRT(XK2/(2.0*OM2)) - F3 = SQRT(ABS(XK3)/(2.0*OM3)) - VM = TPI*VMIN_D(XK1,XK3,XK2,X13,X12,X32,OM1,OM3,OM2) - VP = TPI*VMIN_D(XK2,-XK3,XK1,-X32,X12,-X13,OM2,OM3,OM1) - DELOM321 = OM3+OM2-OM1+DEL1 - DELOM312 = OM3+OM1-OM2+DEL1 - B(K1,K2,M1,M2) = -F3/(F1*F2)*(VM/(DELOM321)+ & - & VP/(DELOM312)) - ENDDO + ENDDO + + DO M2=1,NKHF + XK2 = FAK(M2) + XK2SQ = FAK(M2)**2 + DO M1=1,NKHF + XK1 = FAK(M1) + XK1SQ = FAK(M1)**2 + DO K1=1,NTH + DO K2=1,NTH + COSDIFF = COS(TH(K1)-TH(K2)) + X12 = XK1*XK2*COSDIFF + XK3 = XK1SQ + XK2SQ - 2.*X12 + DEL1 + XK3 = SQRT(XK3) + X13 = XK1SQ-X12 + X32 = X12-XK2SQ + OM1 = SQRT(GRAV*XK1) + OM2 = SQRT(GRAV*XK2) + OM3 = SQRT(GRAV*XK3)+DEL1 + F1 = SQRT(XK1/(2.0*OM1)) + F2 = SQRT(XK2/(2.0*OM2)) + F3 = SQRT(ABS(XK3)/(2.0*OM3)) + VM = TPI*VMIN_D(XK1,XK3,XK2,X13,X12,X32,OM1,OM3,OM2) + VP = TPI*VMIN_D(XK2,-XK3,XK1,-X32,X12,-X13,OM2,OM3,OM1) + DELOM321 = OM3+OM2-OM1+DEL1 + DELOM312 = OM3+OM1-OM2+DEL1 + B(K1,K2,M1,M2) = -F3/(F1*F2)*(VM/(DELOM321)+VP/(DELOM312)) ENDDO ENDDO ENDDO + ENDDO - DO M2=1,NKHF - XK2SQ = FAK(M2)**2 - DO M1=1,NKHF - XK1SQ = FAK(M1)**2 - DO K2=1,NTH - DO K1=1,NTH - C22 = FAC0(K1,K2,M1,M2)+B(K1,K2,M1,M2) - S22 = B(K1,K2,M1,M2)-FAC0(K1,K2,M1,M2) - FAC1(K1,K2,M1,M2) = & - & (XK1SQ*ECOS(K1)**2 + XK2SQ*ECOS(K2)**2)*C22 & - & -FAK(M1)*FAK(M2)*ECOS(K1)*ECOS(K2)*S22 - FAC2(K1,K2,M1,M2) = & - & (XK1SQ*ESIN(K1)**2 + XK2SQ*ESIN(K2)**2)*C22 & - & -FAK(M1)*FAK(M2)*ESIN(K1)*ESIN(K2)*S22 - FAC3(K1,K2,M1,M2) = & - & (XK1SQ*ESIN(K1)*ECOS(K1) + & - & XK2SQ*ESIN(K2)*ECOS(K2))*C22 & - & -FAK(M1)*FAK(M2)*ECOS(K1)*ESIN(K2)*S22 - FAC0(K1,K2,M1,M2) = C22 - ENDDO + DO M2=1,NKHF + XK2SQ = FAK(M2)**2 + DO M1=1,NKHF + XK1SQ = FAK(M1)**2 + DO K2=1,NTH + DO K1=1,NTH + C22 = FAC0(K1,K2,M1,M2)+B(K1,K2,M1,M2) + S22 = B(K1,K2,M1,M2)-FAC0(K1,K2,M1,M2) + FAC1(K1,K2,M1,M2) = (XK1SQ*ECOS(K1)**2 + XK2SQ*ECOS(K2)**2)*C22 & + -FAK(M1)*FAK(M2)*ECOS(K1)*ECOS(K2)*S22 + FAC2(K1,K2,M1,M2) = (XK1SQ*ESIN(K1)**2 + XK2SQ*ESIN(K2)**2)*C22 & + -FAK(M1)*FAK(M2)*ESIN(K1)*ESIN(K2)*S22 + FAC3(K1,K2,M1,M2) = (XK1SQ*ESIN(K1)*ECOS(K1) + & + XK2SQ*ESIN(K2)*ECOS(K2))*C22 & + -FAK(M1)*FAK(M2)*ECOS(K1)*ESIN(K2)*S22 + FAC0(K1,K2,M1,M2) = C22 ENDDO ENDDO ENDDO + ENDDO + CONTAINS - CONTAINS - -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- - REAL(KIND=4) FUNCTION VMIN_D(XI,XJ,XK,XIJ,XIK,XJK,XOI,XOJ,XOK) + REAL(KIND=4) FUNCTION VMIN_D(XI,XJ,XK,XIJ,XIK,XJK,XOI,XOJ,XOK) -! PETER JANSSEN - -! PURPOSE. -! -------- - -! GIVES NONLINEAR TRANSFER COEFFICIENT FOR THREE -! WAVE INTERACTIONS OF DEEP-WATER WAVES IN THE -! IDEAL CASE OF NO CURRENT. (CF.ZAKHAROV) - -! INTERFACE. -! ---------- -! *VMIN_D(XI,XJ,XK)* -! *XI* - WAVE NUMBER -! *XJ* - WAVE NUMBER -! *XK* - WAVE NUMBER -! METHOD. -! ------- -! NONE - -! EXTERNALS. -! ---------- -! NONE. - - -!*** 1. DETERMINE NONLINEAR TRANSFER. -! -------------------------------- - IMPLICIT NONE - REAL, INTENT(IN) :: XI, XJ, XK, XIJ, XIK, XJK, XOI, XOJ, XOK - REAL :: RI, RJ, RK, OI, OJ, OK, SQIJK, SQIKJ, SQJKI - - RI=ABS(XI)+DEL1 - RJ=ABS(XJ)+DEL1 - RK=ABS(XK)+DEL1 - OI=XOI+DEL1 - OJ=XOJ+DEL1 - OK=XOK+DEL1 - SQIJK=SQRT(OI*OJ*RK/(OK*RI*RJ)) - SQIKJ=SQRT(OI*OK*RJ/(OJ*RI*RK)) - SQJKI=SQRT(OJ*OK*RI/(OI*RJ*RK)) - VMIN_D=ZCONST*( (XIJ-RI*RJ)*SQIJK + (XIK-RI*RK)*SQIKJ & - & + (XJK+RJ*RK)*SQJKI ) + ! PETER JANSSEN + ! PURPOSE. + ! -------- + ! GIVES NONLINEAR TRANSFER COEFFICIENT FOR THREE + ! WAVE INTERACTIONS OF DEEP-WATER WAVES IN THE + ! IDEAL CASE OF NO CURRENT. (CF.ZAKHAROV) + ! INTERFACE. + ! ---------- + ! *VMIN_D(XI,XJ,XK)* + ! *XI* - WAVE NUMBER + ! *XJ* - WAVE NUMBER + ! *XK* - WAVE NUMBER + ! METHOD. + ! ------- + ! NONE + ! EXTERNALS. + ! ---------- + ! NONE. + + + !*** 1. DETERMINE NONLINEAR TRANSFER. + ! -------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: XI, XJ, XK, XIJ, XIK, XJK, XOI, XOJ, XOK + REAL :: RI, RJ, RK, OI, OJ, OK, SQIJK, SQIKJ, SQJKI + + RI=ABS(XI)+DEL1 + RJ=ABS(XJ)+DEL1 + RK=ABS(XK)+DEL1 + OI=XOI+DEL1 + OJ=XOJ+DEL1 + OK=XOK+DEL1 + SQIJK=SQRT(OI*OJ*RK/(OK*RI*RJ)) + SQIKJ=SQRT(OI*OK*RJ/(OJ*RI*RK)) + SQJKI=SQRT(OJ*OK*RI/(OI*RJ*RK)) + VMIN_D=ZCONST*( (XIJ-RI*RJ)*SQIJK + (XIK-RI*RK)*SQIKJ+ (XJK+RJ*RK)*SQJKI ) END FUNCTION VMIN_D -!----------------------------------------------------------------------- + !----------------------------------------------------------------------- REAL(KIND=4) FUNCTION VPLUS_D(XI,XJ,XK,XIJ,XIK,XJK,XOI,XOJ,XOK) - -!*** *VPLUS_D* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR THREE -! WAVE INTERACTIONS OF DEEP-WATER WAVES. - -! PETER JANSSEN - -! PURPOSE. -! -------- - -! GIVES NONLINEAR TRANSFER COEFFICIENT FOR THREE -! WAVE INTERACTIONS OF GRAVITY-CAPILLARY WAVES IN THE -! IDEAL CASE OF NO CURRENT. (CF.ZAKHAROV) - -! INTERFACE. -! ---------- -! *VPLUS_D(XI,XJ,XK)* -! *XI* - WAVE NUMBER -! *XJ* - WAVE NUMBER -! *XK* - WAVE NUMBER -! METHOD. -! ------- -! NONE - -! EXTERNALS. -! ---------- -! NONE. - - - -!*** 1. DETERMINE NONLINEAR TRANSFER. -! -------------------------------- - - IMPLICIT NONE - REAL, INTENT(IN) :: XI, XJ, XK, XIJ, XIK, XJK, XOI, XOJ, XOK - REAL :: RI, RJ, RK, OI, OJ, OK, SQIJK, SQIKJ, SQJKI - - RI=ABS(XI)+DEL1 - RJ=ABS(XJ)+DEL1 - RK=ABS(XK)+DEL1 - OI=XOI+DEL1 - OJ=XOJ+DEL1 - OK=XOK+DEL1 - SQIJK=SQRT(OI*OJ*RK/(OK*RI*RJ)) - SQIKJ=SQRT(OI*OK*RJ/(OJ*RI*RK)) - SQJKI=SQRT(OJ*OK*RI/(OI*RJ*RK)) - VPLUS_D=ZCONST*( (XIJ+RI*RJ)*SQIJK + (XIK+RI*RK)*SQIKJ & - & + (XJK+RJ*RK)*SQJKI ) + !*** *VPLUS_D* DETERMINES THE NONLINEAR TRANSFER COEFFICIENT FOR THREE + ! WAVE INTERACTIONS OF DEEP-WATER WAVES. + ! PETER JANSSEN + ! PURPOSE. + ! -------- + ! GIVES NONLINEAR TRANSFER COEFFICIENT FOR THREE + ! WAVE INTERACTIONS OF GRAVITY-CAPILLARY WAVES IN THE + ! IDEAL CASE OF NO CURRENT. (CF.ZAKHAROV) + ! INTERFACE. + ! ---------- + ! *VPLUS_D(XI,XJ,XK)* + ! *XI* - WAVE NUMBER + ! *XJ* - WAVE NUMBER + ! *XK* - WAVE NUMBER + ! METHOD. + ! ------- + ! NONE + ! EXTERNALS. + ! ---------- + ! NONE. + + !*** 1. DETERMINE NONLINEAR TRANSFER. + ! -------------------------------- + + IMPLICIT NONE + REAL, INTENT(IN) :: XI, XJ, XK, XIJ, XIK, XJK, XOI, XOJ, XOK + REAL :: RI, RJ, RK, OI, OJ, OK, SQIJK, SQIKJ, SQJKI + + RI=ABS(XI)+DEL1 + RJ=ABS(XJ)+DEL1 + RK=ABS(XK)+DEL1 + OI=XOI+DEL1 + OJ=XOJ+DEL1 + OK=XOK+DEL1 + SQIJK=SQRT(OI*OJ*RK/(OK*RI*RJ)) + SQIKJ=SQRT(OI*OK*RJ/(OJ*RI*RK)) + SQJKI=SQRT(OJ*OK*RI/(OI*RJ*RK)) + VPLUS_D=ZCONST*( (XIJ+RI*RJ)*SQIJK + (XIK+RI*RK)*SQIKJ + (XJK+RJ*RK)*SQJKI ) END FUNCTION VPLUS_D -! ----------------------------------------------------------------- + ! ----------------------------------------------------------------- - END SUBROUTINE SECONDHH + END SUBROUTINE SECONDHH !/ ------------------------------------------------------------------- / !/ !> @@ -4971,52 +4924,40 @@ END SUBROUTINE SECONDHH !> !> @author P. Janssen @date 29-Mar-2024 !> - SUBROUTINE SKEWNESS(A) - -!-------------------------------------------------------------------- - -!*****SKEWNESS** COMPUTES PARAMETERS OF THE NEARLY-GAUSSIAN -! DISTRIBUTION OF OCEAN WAVES AT A FIXED GRID POINT. - -! P.JANSSEN JULY 1997 - -! PURPOSE -! ------- -! DETERMINES SKEWNESS PARAMETERS IN ORDER TO OBTAIN -! CORRECTION ON ALTIMETER WAVE HEIGHT. - -! INTERFACE -! --------- -! *CALL* *SKEWNESS(IU06,F1,NCOLL,XKAPPA1,DELH_ALT)* - - - -! METHOD -! ------ -! EVALUATE DEVIATIONS FROM GAUSSIANITY FOLLOWING THE WORK -! OF SROKOSZ AND LONGUET-HIGGINS. FOR SECOND ORDER -! CORRECTIONS TO SURFACE ELEVATION THE APPROACH OF -! ZAKHAROV HAS BEEN USED. - -! EXTERNALS -! --------- -! NONE - -! REFERENCES -! ---------- -! M.A. SROKOSZ, J.G.R.,91,995-1006(1986) -! V.E. ZAKHAROV, HAMILTONIAN APPROACH(1967) -!-------------------------------------------------------------------- - - - -!-------------------------------------------------------------------- -! *TH* REAL DIRECTIONS IN RADIANS. -USE CONSTANTS, ONLY: GRAV, TPI, TPIINV -USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, DTH, ECOS, ESIN, NSEAL -USE W3PARALL, ONLY: INIT_GET_ISEA -USE W3ADATMD, ONLY: CG, SKEW, EMBIA1, EMBIA2 - + SUBROUTINE SKEWNESS(A) + + !-------------------------------------------------------------------- + !*****SKEWNESS** COMPUTES PARAMETERS OF THE NEARLY-GAUSSIAN + ! DISTRIBUTION OF OCEAN WAVES AT A FIXED GRID POINT. + ! P.JANSSEN JULY 1997 + ! PURPOSE + ! ------- + ! DETERMINES SKEWNESS PARAMETERS IN ORDER TO OBTAIN + ! CORRECTION ON ALTIMETER WAVE HEIGHT. + ! INTERFACE + ! --------- + ! *CALL* *SKEWNESS(IU06,F1,NCOLL,XKAPPA1,DELH_ALT)* + ! METHOD + ! ------ + ! EVALUATE DEVIATIONS FROM GAUSSIANITY FOLLOWING THE WORK + ! OF SROKOSZ AND LONGUET-HIGGINS. FOR SECOND ORDER + ! CORRECTIONS TO SURFACE ELEVATION THE APPROACH OF + ! ZAKHAROV HAS BEEN USED. + ! EXTERNALS + ! --------- + ! NONE + ! REFERENCES + ! ---------- + ! M.A. SROKOSZ, J.G.R.,91,995-1006(1986) + ! V.E. ZAKHAROV, HAMILTONIAN APPROACH(1967) + !-------------------------------------------------------------------- + + !-------------------------------------------------------------------- + ! *TH* REAL DIRECTIONS IN RADIANS. + USE CONSTANTS, ONLY: GRAV, TPI, TPIINV + USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, DTH, ECOS, ESIN, NSEAL + USE W3PARALL, ONLY: INIT_GET_ISEA + USE W3ADATMD, ONLY: CG, SKEW, EMBIA1, EMBIA2 IMPLICIT NONE @@ -5035,7 +4976,7 @@ SUBROUTINE SKEWNESS(A) REAL(KIND=4), DIMENSION(0:3,0:2,0:2) :: XMU, XLAMBDA REAL(KIND=4), DIMENSION(:) , ALLOCATABLE:: SIGHF, DFIMHF, FAK -! ---------------------------------------------------------------------- + ! ---------------------------------------------------------------------- NKHF=NK+13 ! same offset as in ECWAM @@ -5049,14 +4990,13 @@ SUBROUTINE SKEWNESS(A) ALLOCATE(F2(NTH,NKHF)) ALLOCATE(SIGHF(NKHF), DFIMHF(NKHF), FAK(NKHF)) -! 1. COMPUTATION OF FREQUENCY-DIRECTION INCREMENT -! ----------------------------------------------- + ! 1. COMPUTATION OF FREQUENCY-DIRECTION INCREMENT + ! ----------------------------------------------- MSTART = 1 - #ifdef W3_OMPG - !$OMP PARALLEL DO PRIVATE(JSEA) + !$OMP PARALLEL DO PRIVATE(JSEA) #endif DO JSEA=1, NSEAL XMU(:,:,:) = 0.0 @@ -5064,8 +5004,8 @@ SUBROUTINE SKEWNESS(A) DO M=1,NK CONX = TPIINV / SIG(M) * CG(M,JSEA) F2(K,M)=A(K,M,JSEA)/ CONX - END DO END DO + END DO SIGHF(1) = SIG(1) DO M=2,NKHF @@ -5083,7 +5023,7 @@ SUBROUTINE SKEWNESS(A) FAK(M) = (SIGHF(M))**2/GRAV ENDDO -! Deals with the tail ... + ! Deals with the tail ... DO M=NK+1,NKHF FH=(SIGHF(NK)/SIGHF(M))**5 DO K=1,NTH @@ -5091,8 +5031,8 @@ SUBROUTINE SKEWNESS(A) ENDDO ENDDO -! 2. COMPUTATION OF THE SKEWNESS COEFFICIENTS -! -------------------------------------------- + ! 2. COMPUTATION OF THE SKEWNESS COEFFICIENTS + ! -------------------------------------------- DO M1=MSTART,NKHF DO M2=MSTART,NKHF @@ -5120,8 +5060,8 @@ SUBROUTINE SKEWNESS(A) ENDDO -! 3. COMPUTATION OF THE NORMALISED SKEWNESS COEFFICIENTS -! ------------------------------------------------------ + ! 3. COMPUTATION OF THE NORMALISED SKEWNESS COEFFICIENTS + ! ------------------------------------------------------ DO I=0,3 XPI = 0.5*FLOAT(I) @@ -5149,13 +5089,12 @@ SUBROUTINE SKEWNESS(A) END DO ! end of loop on JSEA ! #ifdef W3_OMPG - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO #endif DEALLOCATE(FAC0,FAC1,FAC2,FAC3) DEALLOCATE(F2,SIGHF,DFIMHF,FAK) - - END SUBROUTINE SKEWNESS + END SUBROUTINE SKEWNESS END MODULE W3IOGOMD diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 83d3be9e5c..19beb52256 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1492,79 +1492,79 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IF ((IOBP_LOC(JSEA).eq.1..or.IOBP_LOC(JSEA).eq. 3).and.IOBDP_LOC(JSEA).eq.1.and.IOBPA_LOC(JSEA).eq.0) THEN - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) - DELA=1. - DELX=1. - DELY=1. + IX = MAPSF(ISEA,1) + IY = MAPSF(ISEA,2) + DELA=1. + DELX=1. + DELY=1. #ifdef W3_REF1 - IF (GTYPE.EQ.RLGTYPE) THEN - DELX=SX*CLATS(ISEA)/FACX - DELY=SY/FACX - DELA=DELX*DELY - END IF - IF (GTYPE.EQ.CLGTYPE) THEN - ! Maybe what follows works also for RLGTYPE ... to be verified - DELX=HPFAC(IY,IX)/ FACX - DELY=HQFAC(IY,IX)/ FACX - DELA=DELX*DELY - END IF - REFLEC=REFLC(:,ISEA) - REFLEC(4)=BERG(ISEA)*REFLEC(4) - REFLED=REFLD(:,ISEA) + IF (GTYPE.EQ.RLGTYPE) THEN + DELX=SX*CLATS(ISEA)/FACX + DELY=SY/FACX + DELA=DELX*DELY + END IF + IF (GTYPE.EQ.CLGTYPE) THEN + ! Maybe what follows works also for RLGTYPE ... to be verified + DELX=HPFAC(IY,IX)/ FACX + DELY=HQFAC(IY,IX)/ FACX + DELA=DELX*DELY + END IF + REFLEC=REFLC(:,ISEA) + REFLEC(4)=BERG(ISEA)*REFLEC(4) + REFLED=REFLD(:,ISEA) #endif #ifdef W3_BT4 - D50=SED_D50(ISEA) - PSIC=SED_PSIC(ISEA) + D50=SED_D50(ISEA) + PSIC=SED_PSIC(ISEA) #endif - ! + ! #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) 'NODE_SRCE_IMP_PRE : IX=', IX, ' JSEA=', JSEA - END IF - WRITE(740+IAPROC,*) 'IT/IX/IY/IMOD=', IT, IX, IY, IMOD - WRITE(740+IAPROC,*) 'ISEA/JSEA=', ISEA, JSEA - WRITE(740+IAPROC,*) 'Before sum(VA)=', sum(VA(:,JSEA)) - FLUSH(740+IAPROC) -#endif - CALL W3SRCE(srce_imp_pre, IT, ISEA, JSEA, IX, IY, IMOD, & - VAold(:,JSEA), VA(:,JSEA), & - VSioDummy, VDioDummy, SHAVETOT(JSEA), & - ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & - CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & - U10D(ISEA), & + IF (IX .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) 'NODE_SRCE_IMP_PRE : IX=', IX, ' JSEA=', JSEA + END IF + WRITE(740+IAPROC,*) 'IT/IX/IY/IMOD=', IT, IX, IY, IMOD + WRITE(740+IAPROC,*) 'ISEA/JSEA=', ISEA, JSEA + WRITE(740+IAPROC,*) 'Before sum(VA)=', sum(VA(:,JSEA)) + FLUSH(740+IAPROC) +#endif + CALL W3SRCE(srce_imp_pre, IT, ISEA, JSEA, IX, IY, IMOD, & + VAold(:,JSEA), VA(:,JSEA), & + VSioDummy, VDioDummy, SHAVETOT(JSEA), & + ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & + CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & + U10D(ISEA), & #ifdef W3_FLX5 - TAUA(ISEA), TAUADIR(ISEA), & -#endif - AS(ISEA), UST(ISEA), & - USTDIR(ISEA), CX(ISEA), CY(ISEA), & - ICE(ISEA), ICEH(ISEA), ICEF(ISEA), & - ICEDMAX(ISEA), & - REFLEC, REFLED, DELX, DELY, DELA, & - TRNX(IY,IX), TRNY(IY,IX), BERG(ISEA), & - FPIS(ISEA), DTDYN(JSEA), & - FCUT(JSEA), DTGpre, TAUWX(JSEA), TAUWY(JSEA), & - TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & - TAUWIY(JSEA), TAUWNX(JSEA), & - TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & - TWS(JSEA), PHIOC(JSEA), TMP1, D50, PSIC, TMP2, & - PHIBBL(JSEA), TMP3, TMP4, PHICE(JSEA), & - TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & - RHOAIR(ISEA), ASF(ISEA)) - IF (.not. LSLOC) THEN - VSTOT(:,JSEA) = VSioDummy - VDTOT(:,JSEA) = VDioDummy - ENDIF + TAUA(ISEA), TAUADIR(ISEA), & +#endif + AS(ISEA), UST(ISEA), & + USTDIR(ISEA), CX(ISEA), CY(ISEA), & + ICE(ISEA), ICEH(ISEA), ICEF(ISEA), & + ICEDMAX(ISEA), & + REFLEC, REFLED, DELX, DELY, DELA, & + TRNX(IY,IX), TRNY(IY,IX), BERG(ISEA), & + FPIS(ISEA), DTDYN(JSEA), & + FCUT(JSEA), DTGpre, TAUWX(JSEA), TAUWY(JSEA), & + TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & + TAUWIY(JSEA), TAUWNX(JSEA), & + TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & + TWS(JSEA), PHIOC(JSEA), TMP1, D50, PSIC, TMP2, & + PHIBBL(JSEA), TMP3, TMP4, PHICE(JSEA), & + TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & + RHOAIR(ISEA), ASF(ISEA)) + IF (.not. LSLOC) THEN + VSTOT(:,JSEA) = VSioDummy + VDTOT(:,JSEA) = VDioDummy + ENDIF #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'After sum(VA)=', sum(VA(:,JSEA)) - WRITE(740+IAPROC,*) ' sum(VSTOT)=', sum(VSTOT(:,JSEA)) - WRITE(740+IAPROC,*) ' sum(VDTOT)=', sum(VDTOT(:,JSEA)) - WRITE(740+IAPROC,*) ' SHAVETOT=', SHAVETOT(JSEA) - FLUSH(740+IAPROC) + WRITE(740+IAPROC,*) 'After sum(VA)=', sum(VA(:,JSEA)) + WRITE(740+IAPROC,*) ' sum(VSTOT)=', sum(VSTOT(:,JSEA)) + WRITE(740+IAPROC,*) ' sum(VDTOT)=', sum(VDTOT(:,JSEA)) + WRITE(740+IAPROC,*) ' SHAVETOT=', SHAVETOT(JSEA) + FLUSH(740+IAPROC) #endif - ENDIF + ENDIF END DO ! JSEA END IF ! PDLIB #endif From 2681f7b2c2d3782e76fa1ba5de483ebeb6e68f32 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 7 Feb 2025 22:57:36 -0500 Subject: [PATCH 062/136] bug fix to have save point weight file be different name (#1357) --- model/src/w3iopomd.F90 | 32 ++++++++++++++++++++++++-------- model/src/w3odatmd.F90 | 5 +++++ 2 files changed, 29 insertions(+), 8 deletions(-) diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index fec7586386..b949dbb266 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -405,7 +405,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) REAL, ALLOCATABLE :: EquLon(:),EquLat(:),StdLon(:),StdLat(:),AnglPT(:) #endif ! Variables for NetCDF weights file for points - character(len = 124) :: filename + character(len = 124) :: filename, filenameout logical :: pnt_wght_exists, pnt_wght_write integer :: ncerr, fh integer :: d_nopts, d_namelen, d_vsize, d_wghtlen @@ -542,7 +542,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) END DO ! End loop over output points (IPT). ELSE ! Saved weight file exists, read weights from file - IF ( IAPROC .EQ. 1 ) THEN + IF ( IAPROC .EQ. 1 ) THEN ! Open the netCDF file. ncerr = nf90_open(filename, NF90_NOWRITE, fh) if (nf90_err(ncerr) .ne. 0) return @@ -596,14 +596,29 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) ncerr = nf90_get_var(fh, v_ptifac, PTIFAC, start = (/ 1, 1/), & count = (/ d_wghtlen_len, d_nopts_len /)) if (nf90_err(ncerr) .ne. 0) return + + ! Close the file. + ncerr = nf90_close(fh) + if (nf90_err(ncerr) .ne. 0) return + END IF + #ifdef W3_MPI - ! Broadcast weight info to all MPI tasks: + ! Broadcast weight info to all MPI tasks: + + !First broadcast NOPTS, used in the next calls: CALL MPI_BCAST(NOPTS,1,MPI_INTEGER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(PTNME,40*NPT,MPI_CHARACTER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(PTLOC,2*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(IPTINT,2*4*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(PTIFAC,4*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_Barrier(MPI_COMM_IOPP,IERR_MPI) + + CALL MPI_BCAST(PTLOC,2*NPT,MPI_REAL,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTIFAC,4*NPT,MPI_REAL,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(IPTINT(:,:,1:NOPTS),2*4*NOPTS,MPI_INTEGER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + + !Send point names individually + DO IPT=1, NOPTS + CALL MPI_BCAST(PTNME(IPT),40,MPI_CHARACTER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + ENDDO + CALL MPI_Barrier(MPI_COMM_IOPP,IERR_MPI) #endif ENDIF !end if point weight file exists @@ -612,7 +627,8 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) IF ( pnt_wght_write .AND. (NOPTS > 0) ) THEN IF ( IAPROC .EQ. 1 ) THEN ! Create the netCDF file. - ncerr = nf90_create(filename, NF90_NETCDF4, fh) + filenameout = 'out.pnt_wght.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + ncerr = nf90_create(filenameout, NF90_NETCDF4, fh) if (nf90_err(ncerr) .ne. 0) return ! Define dimensions. diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 3a667ebbfa..227ef58404 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -1096,6 +1096,11 @@ SUBROUTINE W3DMO2 ( IMOD, NDSE, NDST, NPT ) CHECK_ALLOC_STATUS ( ISTAT ) ! OUTPTS(IMOD)%OUT2%O2INIT = .TRUE. + !Initialize: + OUTPTS(IMOD)%OUT2%IPTINT=0 + OUTPTS(IMOD)%OUT2%PTNME='' + OUTPTS(IMOD)%OUT2%PTLOC=0. + OUTPTS(IMOD)%OUT2%PTIFAC=0. ! #ifdef W3_T WRITE (NDST,9001) From de282b43767772c33a590d1375c4f915da488522 Mon Sep 17 00:00:00 2001 From: Juan Manuel Castillo Sanchez <48921434+ukmo-juan-castillo@users.noreply.github.com> Date: Mon, 10 Feb 2025 16:21:40 +0000 Subject: [PATCH 063/136] Rewrite the cpl_oasis_grid subroutine for better performance and to use OASIS and SCRIP standards. (#1354) --- model/src/w3oacpmd.F90 | 64 ++++++++++++++++++------------------------ 1 file changed, 28 insertions(+), 36 deletions(-) diff --git a/model/src/w3oacpmd.F90 b/model/src/w3oacpmd.F90 index 72e48e4e10..f6a7745931 100644 --- a/model/src/w3oacpmd.F90 +++ b/model/src/w3oacpmd.F90 @@ -162,13 +162,16 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) !/ | Last update : April-2016 | !/ +-----------------------------------+ !/ - !/ Jul-2013 : Origination. ( version 4.18 ) - !/ April-2016 : Add comments (J. Pianezze) ( version 5.07 ) - !/ Sept-2016 : Correct bug MPI (J. Pianezze) ( version 5.12 ) + !/ Jul-2013 : Origination. ( version 4.18 ) + !/ April-2016 : Add comments (J. Pianezze) ( version 5.07 ) + !/ Sept-2016 : Correct bug MPI (J. Pianezze) ( version 5.12 ) + !/ Jan-2025 : Use scrip format (J.M. Castillo) ( version x.xx ) !/ ! 1. Purpose : ! - ! Grid data file definition + ! Grid data file definition in the scrip format. + ! In this format, grid corners are specified in counterclockwise + ! order, being the first corner the one at the bottom left. ! ! 2. Method : ! 3. Parameters : @@ -250,41 +253,30 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) NYS=1 NYN=NY ! - ! lat/lon ALLOCATE ( LON(NNODES,1), LAT(NNODES,1) ) - I = 0 - DO IY = NYS, NYN - DO IX = NXW, NXE - I = I+1 - LON(I,1)=XGRD(IY,IX)*FACTOR - LAT(I,1)=YGRD(IY,IX)*FACTOR - END DO - END DO - ! - ! areas, corners ALLOCATE ( AREA(NNODES,1), CORLON(NNODES,1,4), CORLAT(NNODES,1,4) ) - I = 0 - DO IY = NYS, NYN - DO IX = NXW, NXE - I = I+1 - CORLON(I,1,1)=LON(I,1)+HPFAC(IY,IX)/2.*FACTOR - CORLON(I,1,2)=LON(I,1)-HPFAC(IY,IX)/2.*FACTOR - CORLON(I,1,3)=LON(I,1)-HPFAC(IY,IX)/2.*FACTOR - CORLON(I,1,4)=LON(I,1)+HPFAC(IY,IX)/2.*FACTOR - CORLAT(I,1,1)=LAT(I,1)+HQFAC(IY,IX)/2.*FACTOR - CORLAT(I,1,2)=LAT(I,1)+HQFAC(IY,IX)/2.*FACTOR - CORLAT(I,1,3)=LAT(I,1)-HQFAC(IY,IX)/2.*FACTOR - CORLAT(I,1,4)=LAT(I,1)-HQFAC(IY,IX)/2.*FACTOR - AREA(I,1)=HPFAC(IY,IX)*HQFAC(IY,IX) - END DO - END DO - ! - ! Model grid mask ALLOCATE ( MASK(NNODES,1) ) + ! I = 0 DO IY = NYS, NYN DO IX = NXW, NXE I = I+1 + ! lat/lon + LON(I,1) = XGRD(IY,IX)*FACTOR + LAT(I,1) = YGRD(IY,IX)*FACTOR + ! + ! areas, corners + CORLON(I,1,1) = LON(I,1)-HPFAC(IY,IX)/2.*FACTOR + CORLON(I,1,2) = LON(I,1)+HPFAC(IY,IX)/2.*FACTOR + CORLON(I,1,3) = CORLON(I,1,2) + CORLON(I,1,4) = CORLON(I,1,1) + CORLAT(I,1,1) = LAT(I,1)-HQFAC(IY,IX)/2.*FACTOR + CORLAT(I,1,2) = CORLAT(I,1,1) + CORLAT(I,1,3) = LAT(I,1)+HQFAC(IY,IX)/2.*FACTOR + CORLAT(I,1,4) = CORLAT(I,1,3) + AREA(I,1) = HPFAC(IY,IX)*HQFAC(IY,IX) + ! + ! Model grid mask ! Get the mask : 0 - sea / 1 - open boundary cells (the land is already excluded) IF ((MAPSTA(IY,IX) .EQ. 1)) THEN MASK(I,1) = 0 @@ -317,13 +309,13 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) CORLON(I,1,3) = CORLON(I,1,2) CORLON(I,1,4) = CORLON(I,1,1) CORLAT(I,1,1) = Y0 + IJKCel(2,I)*DLAT - CORLAT(I,1,2)=CORLAT(I,1,1) + CORLAT(I,1,2) = CORLAT(I,1,1) CORLAT(I,1,3) = Y0 + (IJKCel(2,I) + IJKCel(4,I))*DLAT - CORLAT(I,1,4)=CORLAT(I,1,3) + CORLAT(I,1,4) = CORLAT(I,1,3) ! areas AREA(I,1) = 0.25 * IJKCEL(3,I)*DLON * IJKCEL(4,I)*DLAT - ! Model grid mask - MASK(I,1) = 1 + ! Model grid mask: 0 - sea / 1 - open boundary cells (the land is already excluded) + MASK(I,1) = 0 ENDDO #endif ! From 2178a7bf0afecbf7d133451c428631df1e82b959 Mon Sep 17 00:00:00 2001 From: Juan Manuel Castillo Sanchez <48921434+ukmo-juan-castillo@users.noreply.github.com> Date: Wed, 12 Feb 2025 18:51:21 +0000 Subject: [PATCH 064/136] Change the orange to points partition OASIS decomposition (#1361) --- model/src/w3oacpmd.F90 | 43 ++++++++++++++---------------------------- 1 file changed, 14 insertions(+), 29 deletions(-) diff --git a/model/src/w3oacpmd.F90 b/model/src/w3oacpmd.F90 index f6a7745931..19f1421f16 100644 --- a/model/src/w3oacpmd.F90 +++ b/model/src/w3oacpmd.F90 @@ -368,6 +368,7 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) !/ (R. Baraille & J. Pianezze) !/ April-2016 : Add comments (J. Pianezze) ( version 5.07 ) !/ 08-Jun-2018 : use INIT_GET_ISEA ( version 6.04 ) + !/ Feb-2025 : OASIS points partition (J.M. Castillo) ( version X.XX ) !/ ! 1. Purpose : ! @@ -419,58 +420,41 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IB_I,I + INTEGER :: IB_I INTEGER :: IL_PART_ID ! PartitionID INTEGER, ALLOCATABLE, DIMENSION(:) :: ILA_PARAL ! Description of the local partition in the global index space INTEGER, DIMENSION(4) :: ILA_SHAPE ! Vector giving the min & max index for each dim of the fields INTEGER, DIMENSION(2) :: ILA_VAR_NODIMS ! rank of fields & number of bundles (1 with OASIS3-MCT) INTEGER :: ISEA, JSEA, IX, IY - INTEGER :: NHXW, NHXE, NHYS, NHYN ! size of the halo at the western, eastern, southern, northern boundaries - LOGICAL :: LL_MPI_FILE ! to check if there an mpi.txt file for domain decompasition !/ !/ ------------------------------------------------------------------- / !/ Executable part !/ ! + ALLOCATE(ILA_PARAL(2+NSEAL)) + ! + ! * Define the partition : OASIS POINTS partition + ILA_PARAL(1) = 4 + ! + ! * total number of segments of the global domain + ILA_PARAL(2) = NSEAL + ! IF (GTYPE .EQ. RLGTYPE .OR. GTYPE .EQ. CLGTYPE) THEN ! ! 1.1. regular and curvilinear grids ! ---------------------------------- - NHXW = 1 ; NHXE = NX ; NHYS = 1 ; NHYN = NY - NHXW = NHXW - 1 - NHXE = NX - NHXE - NHYS = NHYS - 1 - NHYN = NY - NHYN - ! - ALLOCATE(ILA_PARAL(2+NSEAL*2)) - ! - ! * Define the partition : OASIS ORANGE partition - ILA_PARAL(1) = 3 - ! - ! * total number of segments of the global domain - ILA_PARAL(2) = NSEAL - ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA,JSEA) IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) - ILA_PARAL(JSEA*2+1) = (IY - NHYN -1)*(NX - NHXE - NHXW) + (IX - NHXW - 1) - ILA_PARAL(JSEA*2+2) = 1 + ILA_PARAL(JSEA+2) = (IY - 1)*NX + IX END DO #ifdef W3_SMC ELSE IF( GTYPE .EQ. SMCTYPE ) THEN ! ! 1.2. SMC grids ! ---------------------------------- - ALLOCATE(ILA_PARAL(2+NSEAL)) - ! - ! * Define the partition : OASIS POINTS partition - ILA_PARAL(1) = 4 - ! - ! * total number of segments of the global domain - ILA_PARAL(2) = NSEAL - ! DO JSEA=1, NSEAL ILA_PARAL(JSEA+2) = IAPROC + (JSEA-1)*NAPROC ENDDO @@ -484,8 +468,7 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) STOP ! DO JSEA=1,NSEAL - ILA_PARAL(JSEA*2+1) = (IAPROC-1) + (JSEA-1)*NAPROC - ILA_PARAL(JSEA*2+2) = 1 + ILA_PARAL(JSEA+2) = IAPROC + (JSEA-1)*NAPROC END DO ! ENDIF @@ -497,6 +480,8 @@ SUBROUTINE CPL_OASIS_DEFINE(NDSO,RCV_STR,SND_STR) CALL OASIS_ABORT(IL_COMPID, 'CPL_OASIS_DEFINE', 'Problem during oasis_def_partition') ENDIF ! + DEALLOCATE(ILA_PARAL) + ! ! 3. Coupling fields declaration ! ---------------------------------- ILA_SHAPE(:) = (/1, NSEAL, 1, 1 /) From ce6b8b64215169a2eb2f68956d479ee0b0503d76 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Thu, 13 Feb 2025 09:33:52 -0500 Subject: [PATCH 065/136] Initialize SATINDICES=1 instead of 0 (#1368) --- model/src/w3gdatmd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index e73957128b..28af7329e5 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -2095,7 +2095,7 @@ SUBROUTINE W3DIMS ( IMOD, MK, MTH, NDSE, NDST ) MPARS(IMOD)%SRCPS%CUMULW(MSPEC,MSPEC), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) - MPARS(IMOD)%SRCPS%SATINDICES(:,:)=0. + MPARS(IMOD)%SRCPS%SATINDICES(:,:)=1. MPARS(IMOD)%SRCPS%SATWEIGHTS(:,:)=0. MPARS(IMOD)%SRCPS%CUMULW(:,:)=0. #endif From a27375f9fa98ad77afaae9d1ecf20c854567a582 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 14 Feb 2025 11:27:13 -0500 Subject: [PATCH 066/136] Gulf of America (#1376) --- smc_docs/SMCG_TKs/G50SMCSRGD.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/smc_docs/SMCG_TKs/G50SMCSRGD.f90 b/smc_docs/SMCG_TKs/G50SMCSRGD.f90 index 8f1b0f325e..7373fd5d92 100644 --- a/smc_docs/SMCG_TKs/G50SMCSRGD.f90 +++ b/smc_docs/SMCG_TKs/G50SMCSRGD.f90 @@ -28,7 +28,7 @@ !! J G Li 14 Oct 2010 !! New AngleD program for SMC grid only. !! J G Li 21 Apr 2010 -!! Test Gulf of Mexico area for high coastal waves. +!! Test Gulf of America area for high coastal waves. !! J G Li 4 May 2010 !! Adapted for SMC50 grid global + Arctic test. !! J G Li 26 Oct 2011 @@ -1178,7 +1178,7 @@ SUBROUTINE SPECUUVV CNST2 = 1.0/(0.5 + 5.0/DLat) CNST1 = CNST2*DLon/DLat -! Gulf of Mexico patch to test coastal high waves. JGLi 04May2011 +! Gulf of America patch to test coastal high waves. JGLi 04May2011 ii=NINT(270.0/DLon) jj=NINT( 25.0/DLat) @@ -1194,7 +1194,7 @@ SUBROUTINE SPECUUVV C(i)=SWH0 ENDIF -!! A round patch in Gulf of Mexico same as Arctic one +!! A round patch in Gulf of America same as Arctic one CNST5 = Real( ICE(1,i) - ii )*CNST1*CCLat(kk) CNST6 = Real( kk - jj )*CNST2 CNST4 = CNST5*CNST5 + CNST6*CNST6 From aaff4577ae64c41fe5215301a7099419afad8afd Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 14 Feb 2025 13:48:40 -0800 Subject: [PATCH 067/136] User-defined path feature development (#1369) --- model/nml/ww3_shel.nml | 21 +++ model/src/w3iogomd.F90 | 32 +++-- model/src/w3iopomd.F90 | 51 +++++-- model/src/w3iorsmd.F90 | 19 ++- model/src/w3nmlshelmd.F90 | 281 +++++++++++++++++++++++++++++++++----- model/src/w3odatmd.F90 | 6 + model/src/ww3_outf.F90 | 2 +- model/src/ww3_shel.F90 | 16 ++- 8 files changed, 360 insertions(+), 68 deletions(-) diff --git a/model/nml/ww3_shel.nml b/model/nml/ww3_shel.nml index b6ae8cfef2..b91fff57a7 100644 --- a/model/nml/ww3_shel.nml +++ b/model/nml/ww3_shel.nml @@ -316,6 +316,27 @@ +! -------------------------------------------------------------------- ! +! Define user-defined output paths via OUTPUT_PATH_NML namelist +! +! * user-defined paths include: raw output out_grd, out_pnt, and restart +! * default path for these are set as './' +! * NOTE: using user-defined path may cause post-processing fail +! user-defined directroy must exist before execution +! +! * namelist must be terminated with / +! * definitions & defaults: +! PATH%GRD_OUT = './' +! PATH%PNT_OUT = './' +! PATH%RST_OUT = './' +! -------------------------------------------------------------------- ! +&OUTPUT_PATH_NML + PATH%GRD_OUT = './' +/ + + + + ! -------------------------------------------------------------------- ! ! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist ! diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 7a9fca02ad..72412bbd3f 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -2533,7 +2533,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & - FNMPRE, NOSWLL, NOEXTR + FNMPRE, FNMGRD, NOSWLL, NOEXTR !/ USE W3SERVMD, ONLY: EXTCDE USE W3ODATMD, only : IAPROC @@ -2576,6 +2576,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & #endif CHARACTER(LEN=30) :: IDTST, TNAME CHARACTER(LEN=10) :: VERTST + + ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE + CHARACTER(LEN=256) :: FNMPRE_LOCAL + !/ !/ ------------------------------------------------------------------- / !/ @@ -2624,22 +2628,28 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! open file ---------------------------------------------------------- * ! ( IPASS = 1 ) ! + IF (LEN_TRIM(FNMGRD) .EQ. 0) THEN + FNMPRE_LOCAL = FNMPRE + ELSE + FNMPRE_LOCAL = FNMGRD + END IF + IF ( IPASS.EQ.1 .AND. OFILES(1) .EQ. 0) THEN I = LEN_TRIM(FILEXT) - J = LEN_TRIM(FNMPRE) + J = LEN_TRIM(FNMPRE_LOCAL) ! #ifdef W3_T - WRITE (NDST,9001) FNMPRE(:J)//'out_grd.'//FILEXT(:I) + WRITE (NDST,9001) FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I) #endif IF ( WRITE ) THEN - OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & + OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I), & form ='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) #ifdef W3_ASCII - OPEN (NDSOA,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I)//'.txt', & + OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I)//'.txt', & form ='FORMATTED',ERR=800,IOSTAT=IERR) #endif ELSE - OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & + OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') END IF ! @@ -2709,22 +2719,22 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! IF ( IPASS.GE.1 .AND. OFILES(1) .EQ. 1) THEN I = LEN_TRIM(FILEXT) - J = LEN_TRIM(FNMPRE) + J = LEN_TRIM(FNMPRE_LOCAL) ! ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) #ifdef W3_T - WRITE (NDST,9001) FNMPRE(:J)//TIMETAG//'.out_grd.'//FILEXT(:I) + WRITE (NDST,9001) FNMPRE_LOCAL(:J)//TIMETAG//'.out_grd.'//FILEXT(:I) #endif IF ( WRITE ) THEN - OPEN (NDSOG,FILE=FNMPRE(:J)//TIMETAG//'.out_grd.' & + OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_grd.' & //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) #ifdef W3_ASCII - OPEN (NDSOA,FILE=FNMPRE(:J)//TIMETAG//'.out_grd.' & + OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_grd.' & //FILEXT(:I)//'.txt',form='FORMATTED',ERR=800,IOSTAT=IERR) #endif ELSE - OPEN (NDSOG,FILE=FNMPRE(:J)//'out_grd.'//FILEXT(:I), & + OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') END IF ! diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index b949dbb266..277d8dbd95 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -1324,7 +1324,7 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) USE W3GDATMD, ONLY: NTH, NK, NSPEC, FILEXT USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & IL, IW, II, PTLOC, PTIFAC, DPO, WAO, WDO, & - ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, FNMPNT, & GRDID, ICEO, ICEHO, ICEFO, W3DMO2 USE W3SERVMD, ONLY: EXTCDE #ifdef W3_FLX5 @@ -1598,7 +1598,7 @@ SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & PTLOC, PTIFAC, DPO, WAO, WDO, & - ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, FNMPNT, & GRDID, ICEO, ICEHO, ICEFO USE W3TIMEMD, ONLY: CALTYPE, T2D, U2D, TSUB #ifdef W3_FLX5 @@ -1918,7 +1918,7 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) USE W3ODATMD, ONLY: W3SETO USE W3GDATMD, ONLY: FILEXT USE W3WDATMD, ONLY: TIME - USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, FNMPRE + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, FNMPRE, FNMPNT USE W3ODATMD, ONLY: OFILES USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S @@ -1937,6 +1937,9 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) character(len = 124) :: filename integer :: ncerr + ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE + CHARACTER(LEN=256) :: FNMPRE_LOCAL + #ifdef W3_S CALL STRACE (IENT, 'W3IOPON') #endif @@ -1965,12 +1968,19 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) END IF ! Determine filename. + IF (LEN_TRIM(FNMPNT) .EQ. 0) THEN + FNMPRE_LOCAL = FNMPRE + ELSE + FNMPRE_LOCAL = FNMPNT + END IF + ! + IF ( OFILES(2) .EQ. 1 ) THEN ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) - filename = FNMPRE(:LEN_TRIM(FNMPRE))//TIMETAG//'.out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + filename = FNMPRE_LOCAL(:LEN_TRIM(FNMPRE_LOCAL))//TIMETAG//'.out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' ELSE - filename = FNMPRE(:LEN_TRIM(FNMPRE))//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + filename = FNMPRE_LOCAL(:LEN_TRIM(FNMPRE_LOCAL))//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' END IF ! Do a read or a write of the point file. @@ -2158,7 +2168,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & IL, IW, II, PTLOC, PTIFAC, DPO, WAO, WDO, & - ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, FNMPNT, & GRDID, ICEO, ICEHO, ICEFO #ifdef W3_FLX5 USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO @@ -2201,6 +2211,10 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & CHARACTER(LEN=10) :: VERTST !/ CHARACTER(LEN=15) :: TIMETAG + + ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE + CHARACTER(LEN=256) :: FNMPRE_LOCAL + !/ !/ ------------------------------------------------------------------- / !/ @@ -2239,23 +2253,30 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! ! open file ---------------------------------------------------------- * ! + IF (LEN_TRIM(FNMPNT) .EQ. 0) THEN + FNMPRE_LOCAL = FNMPRE + ELSE + FNMPRE_LOCAL = FNMPNT + END IF + ! + IF ( IPASS.EQ.1 .AND. OFILES(2) .EQ. 0 ) THEN I = LEN_TRIM(FILEXT) - J = LEN_TRIM(FNMPRE) + J = LEN_TRIM(FNMPRE_LOCAL) #ifdef W3_T - WRITE (NDST,9001) FNMPRE(:J)//'out_pnt.'//FILEXT(:I) + WRITE (NDST,9001) FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I) #endif IF ( WRITE ) THEN - OPEN (NDSOP,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I), & + OPEN (NDSOP,FILE=FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) #ifdef W3_ASCII - OPEN (NDSOA,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I)//'.txt', & + OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I)//'.txt', & form='FORMATTED', ERR=800,IOSTAT=IERR) #endif ELSE - OPEN (NDSOP,FILE=FNMPRE(:J)//'out_pnt.'//FILEXT(:I), & + OPEN (NDSOP,FILE=FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I), & form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') END IF ! @@ -2336,20 +2357,20 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & IF ( IPASS.GE.1 .AND. OFILES(2) .EQ. 1) THEN ! I = LEN_TRIM(FILEXT) - J = LEN_TRIM(FNMPRE) + J = LEN_TRIM(FNMPRE_LOCAL) ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) ! #ifdef W3_T - WRITE (NDST,9001) FNMPRE(:J)//TIMETAG//'.out_pnt.'// & + WRITE (NDST,9001) FNMPRE_LOCAL(:J)//TIMETAG//'.out_pnt.'// & FILEXT(:I) #endif IF ( WRITE ) THEN - OPEN (NDSOP,FILE=FNMPRE(:J)//TIMETAG//'.out_pnt.' & + OPEN (NDSOP,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_pnt.' & //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) #ifdef W3_ASCII - OPEN (NDSOA,FILE=FNMPRE(:J)//TIMETAG//'.out_pnt.' & + OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_pnt.' & //FILEXT(:I)//'.txt',form='FORMATTED', ERR=800,IOSTAT=IERR) #endif END IF diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 5253a66ab8..11d49a2c1d 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -308,7 +308,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3IDATMD, ONLY: WXNwrst, WYNwrst #endif USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPROC, NAPERR, NAPRST, & - IFILE => IFILE4, FNMPRE, NTPROC, IOSTYP, & + IFILE => IFILE4, FNMPRE, FNMRST, NTPROC, IOSTYP, & FLOGRR, NOGRP, NGRPP, SCREEN #ifdef W3_MPI USE W3ODATMD, ONLY: NRQRS, NBLKRS, RSBLKS, IRQRS, IRQRSS, & @@ -380,6 +380,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) CHARACTER(LEN=26) :: IDTST CHARACTER(LEN=30) :: TNAME CHARACTER(LEN=15) :: TIMETAG + + ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE + CHARACTER(LEN=256) :: FNMPRE_LOCAL + !/ !/ ------------------------------------------------------------------- / !/ @@ -457,8 +461,15 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ! open file ---------------------------------------------------------- * ! + IF (LEN_TRIM(FNMRST) .EQ. 0) THEN + FNMPRE_LOCAL = FNMPRE + ELSE + FNMPRE_LOCAL = FNMRST + END IF + ! + I = LEN_TRIM(FILEXT) - J = LEN_TRIM(FNMPRE) + J = LEN_TRIM(FNMPRE_LOCAL) ! !CHECKPOINT RESTART FILE ITMP=0 @@ -495,10 +506,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF ( WRITE ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & - OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & + OPEN (NDSR,FILE=FNMPRE_LOCAL(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR) ELSE - OPEN (NDSR,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & + OPEN (NDSR,FILE=FNMPRE_LOCAL(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & ACCESS='STREAM',ERR=800,IOSTAT=IERR, & STATUS='OLD',ACTION='READ') END IF diff --git a/model/src/w3nmlshelmd.F90 b/model/src/w3nmlshelmd.F90 index ac53104b26..26cefe1349 100644 --- a/model/src/w3nmlshelmd.F90 +++ b/model/src/w3nmlshelmd.F90 @@ -129,6 +129,12 @@ MODULE W3NMLSHELMD TYPE(NML_OUTPUT_TIME_T) :: COUPLING END TYPE NML_OUTPUT_DATE_T + ! NEW TYPE FOR USER DEFINED PATH + TYPE NML_OUTPUT_PATH_T + CHARACTER(LEN=256) :: GRD_OUT + CHARACTER(LEN=256) :: PNT_OUT + CHARACTER(LEN=256) :: RST_OUT + END TYPE NML_OUTPUT_PATH_T ! homogeneous input structure TYPE NML_HOMOG_COUNT_T @@ -169,7 +175,7 @@ MODULE W3NMLSHELMD !/ ------------------------------------------------------------------- / SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & - NML_INPUT, NML_OUTPUT_TYPE, NML_OUTPUT_DATE, & + NML_INPUT, NML_OUTPUT_TYPE, NML_OUTPUT_DATE, NML_OUTPUT_PATH, & NML_HOMOG_COUNT, NML_HOMOG_INPUT, IERR) !/ !/ +-----------------------------------+ @@ -263,6 +269,7 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & TYPE(NML_INPUT_T), INTENT(INOUT) :: NML_INPUT TYPE(NML_OUTPUT_TYPE_T), INTENT(INOUT) :: NML_OUTPUT_TYPE TYPE(NML_OUTPUT_DATE_T), INTENT(INOUT) :: NML_OUTPUT_DATE + TYPE(NML_OUTPUT_PATH_T), INTENT(INOUT) :: NML_OUTPUT_PATH ! USER DEFINED PATH TYPE(NML_HOMOG_COUNT_T), INTENT(INOUT) :: NML_HOMOG_COUNT TYPE(NML_HOMOG_INPUT_T), ALLOCATABLE, INTENT(INOUT) :: NML_HOMOG_INPUT(:) INTEGER, INTENT(OUT) :: IERR @@ -318,7 +325,11 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & ! read output date namelist CALL READ_OUTPUT_DATE_NML (NDSI, NML_OUTPUT_DATE) IF ( IMPROC .EQ. NMPLOG ) CALL REPORT_OUTPUT_DATE_NML (NML_OUTPUT_DATE) - + + ! READ OUTPUT USER DEFINED PATH NAMELIST + CALL READ_OUTPUT_PATH_NML (NDSI, NML_OUTPUT_PATH) + IF ( IMPROC .EQ. NMPLOG ) CALL REPORT_OUTPUT_PATH_NML (NML_OUTPUT_PATH) + ! read homogeneous namelist CALL READ_HOMOGENEOUS_NML (NDSI, NML_HOMOG_COUNT, NML_HOMOG_INPUT) IF ( IMPROC .EQ. NMPLOG ) CALL REPORT_HOMOGENEOUS_NML (NML_HOMOG_COUNT, NML_HOMOG_INPUT) @@ -838,6 +849,117 @@ END SUBROUTINE READ_OUTPUT_DATE_NML + !/ ------------------------------------------------------------------- / + + SUBROUTINE READ_OUTPUT_PATH_NML (NDSI, NML_OUTPUT_PATH) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | M. Chen | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 13-Jan-2025 | + !/ +-----------------------------------+ + !/ + !/ + ! 1. Purpose : + ! + ! + ! 2. Method : + ! + ! See source term routines. + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! NDSI Int. + ! NML_OUTPUT_PATH Type. + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD SUBROUTINE tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! W3NMLSHEL Subr. N/A Namelist configuration routine. + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! + ! None. + ! + ! 7. Remarks : + ! + ! 8. Structure : + ! + ! See source code. + ! + ! 9. Switches : + ! + ! !/MPI Uses MPI communications + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + + USE WMMDATMD, ONLY: MDSE + USE W3SERVMD, ONLY: EXTCDE +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif + + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NDSI + TYPE(NML_OUTPUT_PATH_T), INTENT(INOUT) :: NML_OUTPUT_PATH + + ! LOCALS + INTEGER :: IERR + TYPE(NML_OUTPUT_PATH_T) :: PATH + NAMELIST /OUTPUT_PATH_NML/ PATH +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif + + IERR = 0 +#ifdef W3_S + CALL STRACE (IENT, 'READ_OUTPUT_PATH_NML') +#endif + + ! SET DEFAULT VALUES FOR OUTPUT USER DEFINED PATH + PATH%GRD_OUT = './' + PATH%PNT_OUT = './' + PATH%RST_OUT = './' + + ! READ OUTPUT USER DEFINED PATH NAMELIST + REWIND (NDSI) + READ (NDSI, nml=OUTPUT_PATH_NML, iostat=IERR, iomsg=MSG) + IF (IERR.GT.0) THEN + WRITE (MDSE,'(A,/A)') & + 'ERROR: READ_OUTPUT_PATH_NML: namelist read error', & + 'ERROR: '//TRIM(MSG) + CALL EXTCDE (8) + END IF + + ! SAVE NAMELIST + NML_OUTPUT_PATH = PATH + + END SUBROUTINE READ_OUTPUT_PATH_NML + + !/ ------------------------------------------------------------------- / + + + + + + !/ ------------------------------------------------------------------- / SUBROUTINE READ_HOMOGENEOUS_NML (NDSI, NML_HOMOG_COUNT, NML_HOMOG_INPUT) @@ -1184,9 +1306,9 @@ SUBROUTINE REPORT_INPUT_NML (NML_INPUT) WRITE (NDSN,10) TRIM(MSG),'FORCING % MUD_DENSITY = ', NML_INPUT%FORCING%MUD_DENSITY WRITE (NDSN,10) TRIM(MSG),'FORCING % MUD_THICKNESS = ', NML_INPUT%FORCING%MUD_THICKNESS WRITE (NDSN,10) TRIM(MSG),'FORCING % MUD_VISCOSITY = ', NML_INPUT%FORCING%MUD_VISCOSITY - WRITE (NDSN,10) TRIM(MSG),'ASSIM % MEAN = ', NML_INPUT%ASSIM%MEAN - WRITE (NDSN,10) TRIM(MSG),'ASSIM % SPEC1D = ', NML_INPUT%ASSIM%SPEC1D - WRITE (NDSN,10) TRIM(MSG),'ASSIM % SPEC2D = ', NML_INPUT%ASSIM%SPEC2D + WRITE (NDSN,10) TRIM(MSG),'ASSIM % MEAN = ', NML_INPUT%ASSIM%MEAN + WRITE (NDSN,10) TRIM(MSG),'ASSIM % SPEC1D = ', NML_INPUT%ASSIM%SPEC1D + WRITE (NDSN,10) TRIM(MSG),'ASSIM % SPEC2D = ', NML_INPUT%ASSIM%SPEC2D 10 FORMAT (A,2X,A,A) @@ -1279,9 +1401,9 @@ SUBROUTINE REPORT_OUTPUT_TYPE_NML (NML_OUTPUT_TYPE) WRITE (MSG,'(A)') 'OUTPUT TYPE % ' WRITE (NDSN,'(A)') - WRITE (NDSN,10) TRIM(MSG),'FIELD % LIST = ', TRIM(NML_OUTPUT_TYPE%FIELD%LIST) - WRITE (NDSN,10) TRIM(MSG),'POINT % FILE = ', TRIM(NML_OUTPUT_TYPE%POINT%FILE) - WRITE (NDSN,13) TRIM(MSG),'TRACK % FORMAT = ', NML_OUTPUT_TYPE%TRACK%FORMAT + WRITE (NDSN,10) TRIM(MSG),'FIELD % LIST = ', TRIM(NML_OUTPUT_TYPE%FIELD%LIST) + WRITE (NDSN,10) TRIM(MSG),'POINT % FILE = ', TRIM(NML_OUTPUT_TYPE%POINT%FILE) + WRITE (NDSN,13) TRIM(MSG),'TRACK % FORMAT = ', NML_OUTPUT_TYPE%TRACK%FORMAT WRITE (NDSN,11) TRIM(MSG),'PARTITION % X0 = ', NML_OUTPUT_TYPE%PARTITION%X0 WRITE (NDSN,11) TRIM(MSG),'PARTITION % XN = ', NML_OUTPUT_TYPE%PARTITION%XN WRITE (NDSN,11) TRIM(MSG),'PARTITION % NX = ', NML_OUTPUT_TYPE%PARTITION%NX @@ -1290,11 +1412,11 @@ SUBROUTINE REPORT_OUTPUT_TYPE_NML (NML_OUTPUT_TYPE) WRITE (NDSN,11) TRIM(MSG),'PARTITION % NY = ', NML_OUTPUT_TYPE%PARTITION%NY WRITE (NDSN,13) TRIM(MSG),'PARTITION % FORMAT = ', NML_OUTPUT_TYPE%PARTITION%FORMAT #ifdef W3_COU - WRITE (NDSN,10) TRIM(MSG),'COUPLING % SENT = ', TRIM(NML_OUTPUT_TYPE%COUPLING%SENT) - WRITE (NDSN,10) TRIM(MSG),'COUPLING % RECEIVED = ', TRIM(NML_OUTPUT_TYPE%COUPLING%RECEIVED) - WRITE (NDSN,13) TRIM(MSG),'COUPLING % COUPLET0 = ', NML_OUTPUT_TYPE%COUPLING%COUPLET0 + WRITE (NDSN,10) TRIM(MSG),'COUPLING % SENT = ', TRIM(NML_OUTPUT_TYPE%COUPLING%SENT) + WRITE (NDSN,10) TRIM(MSG),'COUPLING % RECEIVED = ', TRIM(NML_OUTPUT_TYPE%COUPLING%RECEIVED) + WRITE (NDSN,13) TRIM(MSG),'COUPLING % COUPLET0 = ', NML_OUTPUT_TYPE%COUPLING%COUPLET0 #endif - WRITE (NDSN,10) TRIM(MSG),'RESTART % EXTRA = ', TRIM(NML_OUTPUT_TYPE%RESTART%EXTRA) + WRITE (NDSN,10) TRIM(MSG),'RESTART % EXTRA = ', TRIM(NML_OUTPUT_TYPE%RESTART%EXTRA) 10 FORMAT (A,2X,A,A) 11 FORMAT (A,2X,A,I8) @@ -1387,31 +1509,31 @@ SUBROUTINE REPORT_OUTPUT_DATE_NML (NML_OUTPUT_DATE) WRITE (MSG,'(A)') 'OUTPUT DATE MODEL GRID % ' WRITE (NDSN,'(A)') - WRITE (NDSN,10) TRIM(MSG),'FIELD % START = ', TRIM(NML_OUTPUT_DATE%FIELD%START) - WRITE (NDSN,10) TRIM(MSG),'FIELD % STRIDE = ', TRIM(NML_OUTPUT_DATE%FIELD%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'FIELD % STOP = ', TRIM(NML_OUTPUT_DATE%FIELD%STOP) - WRITE (NDSN,10) TRIM(MSG),'POINT % START = ', TRIM(NML_OUTPUT_DATE%POINT%START) - WRITE (NDSN,10) TRIM(MSG),'POINT % STRIDE = ', TRIM(NML_OUTPUT_DATE%POINT%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'POINT % STOP = ', TRIM(NML_OUTPUT_DATE%POINT%STOP) - WRITE (NDSN,10) TRIM(MSG),'TRACK % START = ', TRIM(NML_OUTPUT_DATE%TRACK%START) - WRITE (NDSN,10) TRIM(MSG),'TRACK % STRIDE = ', TRIM(NML_OUTPUT_DATE%TRACK%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'TRACK % STOP = ', TRIM(NML_OUTPUT_DATE%TRACK%STOP) - WRITE (NDSN,10) TRIM(MSG),'RESTART % START = ', TRIM(NML_OUTPUT_DATE%RESTART%START) - WRITE (NDSN,10) TRIM(MSG),'RESTART % STRIDE = ', TRIM(NML_OUTPUT_DATE%RESTART%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'RESTART % STOP = ', TRIM(NML_OUTPUT_DATE%RESTART%STOP) - WRITE (NDSN,10) TRIM(MSG),'RESTART2 % START = ', TRIM(NML_OUTPUT_DATE%RESTART2%START) - WRITE (NDSN,10) TRIM(MSG),'RESTART2 % STRIDE = ', TRIM(NML_OUTPUT_DATE%RESTART2%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'RESTART2 % STOP = ', TRIM(NML_OUTPUT_DATE%RESTART2%STOP) - WRITE (NDSN,10) TRIM(MSG),'BOUNDARY % START = ', TRIM(NML_OUTPUT_DATE%BOUNDARY%START) - WRITE (NDSN,10) TRIM(MSG),'BOUNDARY % STRIDE = ', TRIM(NML_OUTPUT_DATE%BOUNDARY%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'BOUNDARY % STOP = ', TRIM(NML_OUTPUT_DATE%BOUNDARY%STOP) + WRITE (NDSN,10) TRIM(MSG),'FIELD % START = ', TRIM(NML_OUTPUT_DATE%FIELD%START) + WRITE (NDSN,10) TRIM(MSG),'FIELD % STRIDE = ', TRIM(NML_OUTPUT_DATE%FIELD%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'FIELD % STOP = ', TRIM(NML_OUTPUT_DATE%FIELD%STOP) + WRITE (NDSN,10) TRIM(MSG),'POINT % START = ', TRIM(NML_OUTPUT_DATE%POINT%START) + WRITE (NDSN,10) TRIM(MSG),'POINT % STRIDE = ', TRIM(NML_OUTPUT_DATE%POINT%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'POINT % STOP = ', TRIM(NML_OUTPUT_DATE%POINT%STOP) + WRITE (NDSN,10) TRIM(MSG),'TRACK % START = ', TRIM(NML_OUTPUT_DATE%TRACK%START) + WRITE (NDSN,10) TRIM(MSG),'TRACK % STRIDE = ', TRIM(NML_OUTPUT_DATE%TRACK%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'TRACK % STOP = ', TRIM(NML_OUTPUT_DATE%TRACK%STOP) + WRITE (NDSN,10) TRIM(MSG),'RESTART % START = ', TRIM(NML_OUTPUT_DATE%RESTART%START) + WRITE (NDSN,10) TRIM(MSG),'RESTART % STRIDE = ', TRIM(NML_OUTPUT_DATE%RESTART%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'RESTART % STOP = ', TRIM(NML_OUTPUT_DATE%RESTART%STOP) + WRITE (NDSN,10) TRIM(MSG),'RESTART2 % START = ', TRIM(NML_OUTPUT_DATE%RESTART2%START) + WRITE (NDSN,10) TRIM(MSG),'RESTART2 % STRIDE = ', TRIM(NML_OUTPUT_DATE%RESTART2%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'RESTART2 % STOP = ', TRIM(NML_OUTPUT_DATE%RESTART2%STOP) + WRITE (NDSN,10) TRIM(MSG),'BOUNDARY % START = ', TRIM(NML_OUTPUT_DATE%BOUNDARY%START) + WRITE (NDSN,10) TRIM(MSG),'BOUNDARY % STRIDE = ', TRIM(NML_OUTPUT_DATE%BOUNDARY%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'BOUNDARY % STOP = ', TRIM(NML_OUTPUT_DATE%BOUNDARY%STOP) WRITE (NDSN,10) TRIM(MSG),'PARTITION % START = ', TRIM(NML_OUTPUT_DATE%PARTITION%START) WRITE (NDSN,10) TRIM(MSG),'PARTITION % STRIDE = ', TRIM(NML_OUTPUT_DATE%PARTITION%STRIDE) WRITE (NDSN,10) TRIM(MSG),'PARTITION % STOP = ', TRIM(NML_OUTPUT_DATE%PARTITION%STOP) #ifdef W3_COU - WRITE (NDSN,10) TRIM(MSG),'COUPLING % START = ', TRIM(NML_OUTPUT_DATE%COUPLING%START) - WRITE (NDSN,10) TRIM(MSG),'COUPLING % STRIDE = ', TRIM(NML_OUTPUT_DATE%COUPLING%STRIDE) - WRITE (NDSN,10) TRIM(MSG),'COUPLING % STOP = ', TRIM(NML_OUTPUT_DATE%COUPLING%STOP) + WRITE (NDSN,10) TRIM(MSG),'COUPLING % START = ', TRIM(NML_OUTPUT_DATE%COUPLING%START) + WRITE (NDSN,10) TRIM(MSG),'COUPLING % STRIDE = ', TRIM(NML_OUTPUT_DATE%COUPLING%STRIDE) + WRITE (NDSN,10) TRIM(MSG),'COUPLING % STOP = ', TRIM(NML_OUTPUT_DATE%COUPLING%STOP) #endif @@ -1426,6 +1548,99 @@ END SUBROUTINE REPORT_OUTPUT_DATE_NML + !/ ------------------------------------------------------------------- / + + SUBROUTINE REPORT_OUTPUT_PATH_NML (NML_OUTPUT_PATH) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | M. Chen | + !/ | | + !/ | FORTRAN 90 | + !/ | Last update : 13-Jan-2025 | + !/ +-----------------------------------+ + !/ + !/ + ! 1. Purpose : + ! + ! + ! 2. Method : + ! + ! See source term routines. + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! NML_OUTPUT_PATH Type. + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! STRACE Subr. W3SERVMD SUBROUTINE tracing. + ! ---------------------------------------------------------------- + ! + ! 5. Called by : + ! + ! Name Type Module Description + ! ---------------------------------------------------------------- + ! W3NMLSHEL Subr. N/A Namelist configuration routine. + ! ---------------------------------------------------------------- + ! + ! 6. Error messages : + ! + ! None. + ! + ! 7. Remarks : + ! + ! 8. Structure : + ! + ! See source code. + ! + ! 9. Switches : + ! + ! !/MPI Uses MPI communications + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + +#ifdef W3_S + USE W3SERVMD, ONLY: STRACE +#endif + + IMPLICIT NONE + + TYPE(NML_OUTPUT_PATH_T), INTENT(IN) :: NML_OUTPUT_PATH + + ! LOCALS +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif + +#ifdef W3_S + CALL STRACE (IENT, 'REPORT_OUTPUT_PATH_NML') +#endif + + WRITE (MSG,'(A)') 'OUTPUT PATH % ' + WRITE (NDSN,'(A)') + WRITE (NDSN,10) TRIM(MSG),'GRD_OUT = ', TRIM(NML_OUTPUT_PATH%GRD_OUT) + WRITE (NDSN,10) TRIM(MSG),'PNT_OUT = ', TRIM(NML_OUTPUT_PATH%PNT_OUT) + WRITE (NDSN,10) TRIM(MSG),'RST_OUT = ', TRIM(NML_OUTPUT_PATH%RST_OUT) + +10 FORMAT (A,2X,A,A) + + END SUBROUTINE REPORT_OUTPUT_PATH_NML + + !/ ------------------------------------------------------------------- / + + + + + + !/ ------------------------------------------------------------------- / SUBROUTINE REPORT_HOMOGENEOUS_NML (NML_HOMOG_COUNT, NML_HOMOG_INPUT) diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 227ef58404..9c9b43e8d9 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -328,6 +328,12 @@ MODULE W3ODATMD INTEGER, PARAMETER :: NOEXTR= 2 CHARACTER(LEN=20) :: IDOUT(NOGRP,NGRPP) CHARACTER(LEN=80) :: FNMPRE = './' + + ! SET GLOBAL PATH FOR USER DEFINED OUTPUT, DEFAULT CURRENT PATH + CHARACTER(LEN=256) :: FNMGRD = './' + CHARACTER(LEN=256) :: FNMPNT = './' + CHARACTER(LEN=256) :: FNMRST = './' + !Moved UNDEF to constants and included above !REAL :: UNDEF = -999.9 LOGICAL :: UNIPTS = .FALSE., UPPROC = .FALSE. diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index 590518037a..02f5efa85c 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -170,7 +170,7 @@ PROGRAM W3OUTF HCMAXE, HMAXD, HCMAXD, MSSD, MSCD, WBT, & WNMEAN, TAUA, TAUADIR USE W3ODATMD, ONLY: NDSO, NDSE, NDST, NOGRP, NGRPP, IDOUT, & - UNDEF, FLOGRD, FNMPRE, NOSWLL, NOGE + UNDEF, FLOGRD, FNMPRE, FNMGRD, FNMPNT, FNMRST, NOSWLL, NOGE ! IMPLICIT NONE !/ diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index 4bb888b489..fcba340ab4 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -269,7 +269,7 @@ PROGRAM W3SHEL #endif USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3ODATMD, ONLY: NAPROC, IAPROC, NAPOUT, NAPERR, NOGRP, & - NGRPP, IDOUT, FNMPRE, IOSTYP, NOTYPE + NGRPP, IDOUT, FNMPRE, FNMGRD, FNMPNT, FNMRST, IOSTYP, NOTYPE USE W3ODATMD, ONLY: FLOGRR, FLOGR, OFILES !/ USE W3FLDSMD @@ -326,6 +326,7 @@ PROGRAM W3SHEL TYPE(NML_INPUT_T) :: NML_INPUT TYPE(NML_OUTPUT_TYPE_T) :: NML_OUTPUT_TYPE TYPE(NML_OUTPUT_DATE_T) :: NML_OUTPUT_DATE + TYPE(NML_OUTPUT_PATH_T) :: NML_OUTPUT_PATH TYPE(NML_HOMOG_COUNT_T) :: NML_HOMOG_COUNT TYPE(NML_HOMOG_INPUT_T), ALLOCATABLE :: NML_HOMOG_INPUT(:) ! @@ -398,6 +399,9 @@ PROGRAM W3SHEL #endif character(len=10) :: jchar integer :: memunit + + LOGICAL :: DIR_EXISTS + INTEGER :: DIR_STATUS ! !/ !/ ------------------------------------------------------------------- / @@ -695,8 +699,8 @@ PROGRAM W3SHEL IF (FLGNML) THEN ! Read namelist CALL W3NMLSHEL (MPI_COMM, NDSI, TRIM(FNMPRE)//'ww3_shel.nml', & - NML_DOMAIN, NML_INPUT, NML_OUTPUT_TYPE, & - NML_OUTPUT_DATE, NML_HOMOG_COUNT, & + NML_DOMAIN, NML_INPUT, NML_OUTPUT_TYPE, & + NML_OUTPUT_DATE, NML_OUTPUT_PATH, NML_HOMOG_COUNT, & NML_HOMOG_INPUT, IERR) ! 2.1 forcing flags @@ -1192,6 +1196,10 @@ PROGRAM W3SHEL ! END IF ! FLHOM + ! USER DEFINED OUTPUT PATH FROM NAMELIST + FNMGRD = NML_OUTPUT_PATH%GRD_OUT + FNMPNT = NML_OUTPUT_PATH%PNT_OUT + FNMRST = NML_OUTPUT_PATH%RST_OUT END IF ! FLGNML @@ -1986,7 +1994,7 @@ PROGRAM W3SHEL #ifdef W3_OASIS , .TRUE., .FALSE., MPI_COMM, TIMEN & #endif - ) + ) ! GOTO 2222 ! From a8819a30e6ecd83bb76c0cfec8a1a168ea794969 Mon Sep 17 00:00:00 2001 From: adarmenov <47391100+adarmenov@users.noreply.github.com> Date: Tue, 4 Mar 2025 12:29:17 -0500 Subject: [PATCH 068/136] Increase the sizes of OUTFF and OFILES (#1379) --- model/src/w3odatmd.F90 | 2 +- model/src/wminitmd.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 9c9b43e8d9..845e025676 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -442,7 +442,7 @@ MODULE W3ODATMD INTEGER :: TOSNL5(2) #endif INTEGER :: TOFRST(2), TONEXT(2,8), TOLAST(2,8), & - TBPI0(2), TBPIN(2), NDS(15), OFILES(7) + TBPI0(2), TBPIN(2), NDS(15), OFILES(8) REAL :: DTOUT(8) LOGICAL :: FLOUT(8) TYPE(OTYPE1) :: OUT1 diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 768b6d91eb..42ab47e3c6 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -747,7 +747,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & - FLG2(NOGRP,NRGRD),OUTFF(7,0:NRGRD)) + FLG2(NOGRP,NRGRD),OUTFF(8,0:NRGRD)) ! MDS = -1 MDSF = -1 From de828acca67a8934290257d40afd37e7abeb3f36 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Wed, 5 Mar 2025 08:35:06 -0500 Subject: [PATCH 069/136] Write log files to indicate output files have been fully written (#1378) --- model/src/w3iogomd.F90 | 18 +++++++++++++++--- model/src/w3iopomd.F90 | 35 ++++++++++++++++++++++++++++------- model/src/w3iorsmd.F90 | 4 ++-- model/src/w3nmlshelmd.F90 | 8 ++++---- model/src/ww3_shel.F90 | 2 +- 5 files changed, 50 insertions(+), 17 deletions(-) diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 72412bbd3f..cceafe4fa9 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -2579,7 +2579,8 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE CHARACTER(LEN=256) :: FNMPRE_LOCAL - + ! + INTEGER :: NDSOGLOG !/ !/ ------------------------------------------------------------------- / !/ @@ -2630,8 +2631,8 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! IF (LEN_TRIM(FNMGRD) .EQ. 0) THEN FNMPRE_LOCAL = FNMPRE - ELSE - FNMPRE_LOCAL = FNMGRD + ELSE + FNMPRE_LOCAL = FNMGRD END IF IF ( IPASS.EQ.1 .AND. OFILES(1) .EQ. 0) THEN @@ -4066,6 +4067,17 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & CALL W3SETA ( IGRD, NDSE, NDST ) #endif ! + ! ADD INDICATOR LOG AFTER THE GRIDDED OUTPUT HAS BEEN FULLY WRITTEN + IF ( WRITE .AND. (OFILES(1).EQ.1) ) THEN + NDSOGLOG = NDSOG + OPEN (NDSOGLOG,FILE=FNMPRE_LOCAL(:J)//'log.'//TIMETAG//'.out_grd.'//FILEXT(:I)//'.txt', & + form ='FORMATTED',ERR=800,IOSTAT=IERR) + WRITE (NDSOGLOG,*) 'The '//TRIM(TIMETAG)//'.out_grd.'//TRIM(FILEXT(:I))// & + ' file has been successfully written!' + CALL FLUSH (NDSOGLOG) + CLOSE (NDSOGLOG) + ENDIF + RETURN ! ! Escape locations read errors diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 277d8dbd95..0e1f3c39c9 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -1592,7 +1592,7 @@ END SUBROUTINE W3IOPON_READ !> !> @author Edward Hartnett @date 1-Nov-2023 !> - SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) + SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr, NDSOP, fname, path) USE NETCDF USE W3GDATMD, ONLY: NTH, NK, NSPEC USE W3WDATMD, ONLY: TIME @@ -1612,6 +1612,11 @@ SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) integer, intent(in) :: timestep_only ! 1 if only timestep should be written. character(*), intent(in) :: filename integer, intent(inout) :: ncerr + ! + INTEGER, INTENT(IN), OPTIONAL :: NDSOP + CHARACTER(LEN=124), INTENT(IN), OPTIONAL :: fname + CHARACTER(LEN=256), INTENT(IN), OPTIONAL :: path + ! integer :: ndim, nvar, fmt, itime, fh integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time @@ -1627,6 +1632,10 @@ SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) integer :: curdate(8), refdate(8),ierr double precision :: outjulday + + ! INDICATOR LOG + INTEGER :: NDSOPLOG + !If first pass, or if you are writting a file for every time-step: IF ( IPASS.EQ.1 .OR. timestep_only.EQ.1 ) THEN ! Create the netCDF file. @@ -1887,6 +1896,17 @@ SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr) ncerr = nf90_close(fh) if (nf90_err(ncerr) .ne. 0) return + ! WRITE INDICATOR LOG AT THE END OF NETCDF OUTPUT + ! RE-USE NDSOP FOR NDSOPLOG + IF (timestep_only .EQ. 1) THEN + NDSOPLOG = NDSOP + OPEN(NDSOPLOG,FILE=path(:LEN_TRIM(path))//'log.'//TRIM(fname)//'.txt', & + form ='FORMATTED') + WRITE (NDSOPLOG,*) 'The '//TRIM(fname)//' file has been successfully written!' + CALL FLUSH (NDSOPLOG) + CLOSE (NDSOPLOG) + ENDIF + END SUBROUTINE W3IOPON_WRITE !> Read or write the netCDF point output file, @@ -1934,12 +1954,12 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) CHARACTER(LEN=15) :: TIMETAG INTEGER :: IGRD - character(len = 124) :: filename + character(len = 256) :: filename integer :: ncerr ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE CHARACTER(LEN=256) :: FNMPRE_LOCAL - + CHARACTER(LEN=124) :: FNAME #ifdef W3_S CALL STRACE (IENT, 'W3IOPON') #endif @@ -1970,8 +1990,8 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) ! Determine filename. IF (LEN_TRIM(FNMPNT) .EQ. 0) THEN FNMPRE_LOCAL = FNMPRE - ELSE - FNMPRE_LOCAL = FNMPNT + ELSE + FNMPRE_LOCAL = FNMPNT END IF ! @@ -1979,6 +1999,7 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix WRITE(TIMETAG,"(i8.8,'.'i6.6)")TIME(1),TIME(2) filename = FNMPRE_LOCAL(:LEN_TRIM(FNMPRE_LOCAL))//TIMETAG//'.out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + FNAME = TIMETAG//'.out_pnt.'//FILEXT(:LEN_TRIM(FILEXT)) ELSE filename = FNMPRE_LOCAL(:LEN_TRIM(FNMPRE_LOCAL))//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' END IF @@ -1987,7 +2008,7 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) IF (INXOUT .EQ. 'READ') THEN CALL W3IOPON_READ(IOTST, IMOD, filename, ncerr) ELSE - CALL W3IOPON_WRITE(OFILES(2), filename, ncerr) + CALL W3IOPON_WRITE(OFILES(2), filename, ncerr, NDSOP=NDSOP, fname=FNAME, path=FNMPRE_LOCAL) ENDIF if (nf90_err(ncerr) .ne. 0) then WRITE(NDSE,*) ' *** WAVEWATCH III ERROR IN W3IOPO :' @@ -2214,7 +2235,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! DEFINED A LOCAL FNMPRE TO AVOID CHANGE THE GLOBAL VALUE CHARACTER(LEN=256) :: FNMPRE_LOCAL - + !/ !/ ------------------------------------------------------------------- / !/ diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 11d49a2c1d..b04e28534f 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -463,8 +463,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! IF (LEN_TRIM(FNMRST) .EQ. 0) THEN FNMPRE_LOCAL = FNMPRE - ELSE - FNMPRE_LOCAL = FNMRST + ELSE + FNMPRE_LOCAL = FNMRST END IF ! diff --git a/model/src/w3nmlshelmd.F90 b/model/src/w3nmlshelmd.F90 index 26cefe1349..7715a2bd29 100644 --- a/model/src/w3nmlshelmd.F90 +++ b/model/src/w3nmlshelmd.F90 @@ -326,10 +326,10 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & CALL READ_OUTPUT_DATE_NML (NDSI, NML_OUTPUT_DATE) IF ( IMPROC .EQ. NMPLOG ) CALL REPORT_OUTPUT_DATE_NML (NML_OUTPUT_DATE) - ! READ OUTPUT USER DEFINED PATH NAMELIST + ! READ OUTPUT USER DEFINED PATH NAMELIST CALL READ_OUTPUT_PATH_NML (NDSI, NML_OUTPUT_PATH) IF ( IMPROC .EQ. NMPLOG ) CALL REPORT_OUTPUT_PATH_NML (NML_OUTPUT_PATH) - + ! read homogeneous namelist CALL READ_HOMOGENEOUS_NML (NDSI, NML_HOMOG_COUNT, NML_HOMOG_INPUT) IF ( IMPROC .EQ. NMPLOG ) CALL REPORT_HOMOGENEOUS_NML (NML_HOMOG_COUNT, NML_HOMOG_INPUT) @@ -946,7 +946,7 @@ SUBROUTINE READ_OUTPUT_PATH_NML (NDSI, NML_OUTPUT_PATH) 'ERROR: READ_OUTPUT_PATH_NML: namelist read error', & 'ERROR: '//TRIM(MSG) CALL EXTCDE (8) - END IF + END IF ! SAVE NAMELIST NML_OUTPUT_PATH = PATH @@ -1632,7 +1632,7 @@ SUBROUTINE REPORT_OUTPUT_PATH_NML (NML_OUTPUT_PATH) 10 FORMAT (A,2X,A,A) - END SUBROUTINE REPORT_OUTPUT_PATH_NML + END SUBROUTINE REPORT_OUTPUT_PATH_NML !/ ------------------------------------------------------------------- / diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index fcba340ab4..298863fc7d 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -401,7 +401,7 @@ PROGRAM W3SHEL integer :: memunit LOGICAL :: DIR_EXISTS - INTEGER :: DIR_STATUS + INTEGER :: DIR_STATUS ! !/ !/ ------------------------------------------------------------------- / From af3c7e1295ec41fb1c1c6f94182e9bd1e3b7fbc1 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 10 Mar 2025 08:38:53 -0400 Subject: [PATCH 070/136] improve user-defined directory feature so / is not required at the end of the path (#1388) Improving PR #1369 to address issue #1221 --- model/nml/ww3_shel.nml | 2 ++ model/src/ww3_shel.F90 | 18 +++++++++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/model/nml/ww3_shel.nml b/model/nml/ww3_shel.nml index b91fff57a7..9468606c27 100644 --- a/model/nml/ww3_shel.nml +++ b/model/nml/ww3_shel.nml @@ -332,6 +332,8 @@ ! -------------------------------------------------------------------- ! &OUTPUT_PATH_NML PATH%GRD_OUT = './' + PATH%PNT_OUT = './' + PATH%RST_OUT = './' / diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index 298863fc7d..995e6363ab 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -1197,9 +1197,21 @@ PROGRAM W3SHEL END IF ! FLHOM ! USER DEFINED OUTPUT PATH FROM NAMELIST - FNMGRD = NML_OUTPUT_PATH%GRD_OUT - FNMPNT = NML_OUTPUT_PATH%PNT_OUT - FNMRST = NML_OUTPUT_PATH%RST_OUT + ! '/' IS NOT REQUIRED AT THE END OF USER-DEFINED DIRECTORY + FNMGRD = TRIM(NML_OUTPUT_PATH%GRD_OUT) + IF (FNMGRD(LEN_TRIM(FNMGRD):LEN_TRIM(FNMGRD)) /= '/') THEN + FNMGRD = TRIM(FNMGRD) // '/' + END IF + + FNMPNT = TRIM(NML_OUTPUT_PATH%PNT_OUT) + IF (FNMPNT(LEN_TRIM(FNMPNT):LEN_TRIM(FNMPNT)) /= '/') THEN + FNMPNT = TRIM(FNMPNT) // '/' + END IF + + FNMRST = TRIM(NML_OUTPUT_PATH%RST_OUT) + IF (FNMRST(LEN_TRIM(FNMRST):LEN_TRIM(FNMRST)) /= '/') THEN + FNMRST = TRIM(FNMRST) // '/' + END IF END IF ! FLGNML From 005d3aa474e1f059db548432bda20a40e7ecdb88 Mon Sep 17 00:00:00 2001 From: AliS-Noaa <118747646+AliS-Noaa@users.noreply.github.com> Date: Fri, 14 Mar 2025 13:18:17 -0400 Subject: [PATCH 071/136] Optimized ww3_outp for the netcdf point output (#1365) --- model/inp/ww3_outp.inp | 5 +- model/src/w3bullmd.F90 | 30 +- model/src/w3iopomd.F90 | 91 +++-- model/src/ww3_outp.F90 | 353 +++++++++++++----- regtests/ww3_ufs1.1/input_unstr/switch_PDLIB | 2 +- regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml | 24 -- .../{ww3_ounp.inp => ww3_outp_bull.inp} | 67 ++-- .../ww3_ufs1.1/input_unstr/ww3_outp_spec.inp | 112 ++++++ .../ww3_ufs1.1/input_unstr/ww3_outp_tab.inp | 112 ++++++ regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp | 2 +- 10 files changed, 595 insertions(+), 203 deletions(-) delete mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml rename regtests/ww3_ufs1.1/input_unstr/{ww3_ounp.inp => ww3_outp_bull.inp} (77%) create mode 100755 regtests/ww3_ufs1.1/input_unstr/ww3_outp_spec.inp create mode 100755 regtests/ww3_ufs1.1/input_unstr/ww3_outp_tab.inp diff --git a/model/inp/ww3_outp.inp b/model/inp/ww3_outp.inp index 7c30a96599..d91284880d 100644 --- a/model/inp/ww3_outp.inp +++ b/model/inp/ww3_outp.inp @@ -2,9 +2,10 @@ $ -------------------------------------------------------------------- $ $ WAVEWATCH III Point output post-processing $ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), -$ and number of output times. +$ and number of output times, optional per-time-step (1) or single (0) +$ point output, optional point output prefix $ - 19680606 060000 3600. 7 + 19680606 060000 3600. 7 1 gfswave $ $ Points requested --------------------------------------------------- $ $ Define points for which output is to be generated. diff --git a/model/src/w3bullmd.F90 b/model/src/w3bullmd.F90 index af749549a1..c85b620c42 100644 --- a/model/src/w3bullmd.F90 +++ b/model/src/w3bullmd.F90 @@ -269,23 +269,29 @@ SUBROUTINE W3BULL & CSVBLINE = BLANK2 ! IPG1 = 0 - IF (IOUT .EQ. 1) THEN - DO IP=1, NPTAB - HST(IP,1) = -99.9 - TPT(IP,1) = -99.9 - DMT(IP,1) = -99.9 - ENDDO - DO IP=1, NPMAX - IYY(IP) = .FALSE. - IPI(IP)=1 - ILEN(IP)=0 - ENDDO - ENDIF + DO IP=1, NPTAB + HST(IP,1) = -99.9 + TPT(IP,1) = -99.9 + DMT(IP,1) = -99.9 + ENDDO + DO IP=1, NPMAX + IYY(IP) = .FALSE. + IPI(IP)=1 + ILEN(IP)=0 + ENDDO ! ! 3. Get overall wave height ---------------------------------------- * ! HSTOT = XPART(1,0) TP = XPART(2,0) + + ! Ensure all values are initialized before using them + DO IP=1, NPMAX + HSP(IP) = 0.00 + TPP(IP) = -999.99 + DMP(IP) = -999.99 + END DO + DO IP=1, NPART HSP(IP) = XPART(1,IP) TPP(IP) = XPART(2,IP) diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 0e1f3c39c9..7d1b05ec0d 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -1317,7 +1317,7 @@ end function nf90_err_check !> !> @author Edward Hartnett @date 1-Nov-2023 !> - SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) + SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr, TOUT ) USE NetCDF USE W3ODATMD, ONLY: W3DMO2 USE W3WDATMD, ONLY: TIME @@ -1337,10 +1337,13 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) INTEGER, INTENT(OUT) :: IOTST INTEGER, INTENT(IN), OPTIONAL :: IMOD_IN - character(*), intent(in) :: filename + character(*), intent(out) :: filename integer, intent(inout) :: ncerr + INTEGER, INTENT(IN), OPTIONAL :: TOUT(2) + CHARACTER(LEN=15) :: TIMETAG + LOGICAL :: per_time_step INTEGER :: IGRD,MK,MTH - integer :: fh + integer :: fh, itime integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time, d_ww3time integer :: d_nopts_len, d_nspec_len, d_vsize_len, d_namelen_len, d_grdidlen_len, d_time_len, d_ww3time_len integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time @@ -1365,6 +1368,15 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) IGRD = 1 END IF + ! Determine if we are reading a per-time-step file + per_time_step = PRESENT(TOUT) + IF (per_time_step) THEN + WRITE(TIMETAG, '(I8.8, ".", I6.6)') TOUT(1), TOUT(2) + filename = TRIM(FNMPRE) // TRIM(TIMETAG) // '.out_pnt.' // TRIM(FILEXT) // '.nc' + ELSE + filename = FNMPRE(:LEN_TRIM(FNMPRE))//'out_pnt.'//FILEXT(:LEN_TRIM(FILEXT))//'.nc' + END IF + ! Open the netCDF file. ncerr = nf90_open(filename, NF90_NOWRITE, fh) if (nf90_err(ncerr) .ne. 0) return @@ -1424,11 +1436,16 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inquire_dimension(fh, d_time, len = d_time_len) if (nf90_err(ncerr) .ne. 0) return + + !Determine the start for the time dimension + IF ( per_time_step ) THEN + itime=1 + ELSE + itime=IPASS + END IF - IF ( IPASS .LE. d_time_len ) THEN - - IF ( IPASS.EQ.1 ) THEN - + IF ( itime .LE. d_time_len ) THEN + IF ( itime.EQ.1 ) THEN ! Read scalar variables. ncerr = nf90_inq_varid(fh, VNAME_NK, v_nk) if (nf90_err(ncerr) .ne. 0) return @@ -1440,33 +1457,32 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) if (nf90_err(ncerr) .ne. 0) return !read in written variables NK, NTH as MK and MTH - !and ensure they match + !and ensure they match IF (NK.NE.MK .OR. NTH.NE.MTH) THEN WRITE (NDSE,904) MK, MTH, NK, NTH CALL EXTCDE ( 12 ) END IF - ! Allocate variables: + ! Allocate variables: IF ( .NOT. O2INIT ) & - CALL W3DMO2 ( IGRD, NDSE, NDST, NOPTS ) + CALL W3DMO2 ( IGRD, NDSE, NDST, NOPTS ) ! Read vars with nopts as a dimension. ncerr = nf90_inq_varid(fh, VNAME_PTLOC, v_ptloc) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_get_var(fh, v_ptloc, PTLOC, start = (/ 1, 1/), & - count = (/ d_vsize_len, d_nopts_len /)) + count = (/ d_vsize_len, d_nopts_len /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_PTNME, v_ptnme) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_get_var(fh, v_ptnme, PTNME) if (nf90_err(ncerr) .ne. 0) return - END IF - - !Variables read based on time (IPASS): - + END IF + + !Variables read based on time (itime): ncerr = nf90_inq_varid(fh, VNAME_WW3TIME, v_ww3time) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_ww3time, TIME, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_ww3time, TIME, start = (/ 1, itime/), & count = (/ d_vsize_len, 1 /)) if (nf90_err(ncerr) .ne. 0) return @@ -1479,89 +1495,88 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr) ncerr = nf90_inq_varid(fh, VNAME_DPO, v_dpo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_dpo, DPO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_dpo, DPO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_WAO, v_wao) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_wao, WAO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_wao, WAO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_WDO, v_wdo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_wdo, WDO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_wdo, WDO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return #ifdef W3_FLX5 ncerr = nf90_inq_varid(fh, VNAME_TAUAO, v_tauao) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_tauao, TAUAO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_tauao, TAUAO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_TAUDO, v_taudo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_taudo, TAUDO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_taudo, TAUDO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_DAIRO, v_dairo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_dairo, DAIRO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_dairo, DAIRO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return #endif #ifdef W3_SETUP ncerr = nf90_inq_varid(fh, ZET_SETO, v_zet_seto) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_zet_seto, ZET_SETO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_zet_seto, ZET_SETO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return #endif ncerr = nf90_inq_varid(fh, VNAME_ASO, v_aso) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_aso, ASO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_aso, ASO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_CAO, v_cao) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_cao, CAO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_cao, CAO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_CDO, v_cdo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_cdo, CDO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_cdo, CDO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_ICEO, v_iceo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_iceo, ICEO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_iceo, ICEO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_ICEHO, v_iceho) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_iceho, ICEHO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_iceho, ICEHO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_ICEFO, v_icefo) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_icefo, ICEFO, start = (/ 1, IPASS/), & + ncerr = nf90_get_var(fh, v_icefo, ICEFO, start = (/ 1, itime/), & count = (/ NOPTS, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_GRDID, v_grdid) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_grdid, GRDID, start = (/ 1, 1, IPASS/), & + ncerr = nf90_get_var(fh, v_grdid, GRDID, start = (/ 1, 1, itime/), & count = (/ 13, nopts, 1 /)) if (nf90_err(ncerr) .ne. 0) return ncerr = nf90_inq_varid(fh, VNAME_SPCO, v_spco) if (nf90_err(ncerr) .ne. 0) return - ncerr = nf90_get_var(fh, v_spco, SPCO, start = (/ 1, 1, IPASS/), & + ncerr = nf90_get_var(fh, v_spco, SPCO, start = (/ 1, 1, itime/), & count = (/nspec, nopts, 1 /)) if (nf90_err(ncerr) .ne. 0) return - ELSE ! Set flag to indicate IPASS > d_time_len ! and are at the end of the IOTST = -1 - END IF + END IF ! Close the file. ncerr = nf90_close(fh) @@ -1932,7 +1947,7 @@ END SUBROUTINE W3IOPON_WRITE !> @param[in] IMOD Model number for W3GDAT etc. !> !> @author Edward Hartnett @date 1-Nov-2023 - SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) + SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD, TOUT ) USE W3GDATMD, ONLY: W3SETG USE W3WDATMD, ONLY: W3SETW USE W3ODATMD, ONLY: W3SETO @@ -1950,8 +1965,8 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) CHARACTER, INTENT(IN) :: INXOUT*(*) INTEGER, INTENT(IN) :: NDSOP INTEGER, INTENT(OUT) :: IOTST + INTEGER, INTENT(IN), OPTIONAL :: TOUT(2) INTEGER, INTENT(IN), OPTIONAL :: IMOD - CHARACTER(LEN=15) :: TIMETAG INTEGER :: IGRD character(len = 256) :: filename @@ -2006,7 +2021,11 @@ SUBROUTINE W3IOPON ( INXOUT, NDSOP, IOTST, IMOD) ! Do a read or a write of the point file. IF (INXOUT .EQ. 'READ') THEN - CALL W3IOPON_READ(IOTST, IMOD, filename, ncerr) + IF (PRESENT(TOUT)) THEN + CALL W3IOPON_READ(IOTST, IMOD, filename, ncerr, TOUT) + ELSE + CALL W3IOPON_READ(IOTST, IMOD, filename, ncerr) + END IF ELSE CALL W3IOPON_WRITE(OFILES(2), filename, ncerr, NDSOP=NDSOP, fname=FNAME, path=FNMPRE_LOCAL) ENDIF diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index d793783ca0..167fdceea0 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -266,9 +266,15 @@ PROGRAM W3OUTP LOGICAL :: FLFORM, FLSRCE(7) LOGICAL, ALLOCATABLE :: FLREQ(:) CHARACTER :: COMSTR*1, IDTIME*23, IDDDAY*11, & - TABNME*9, TFNAME*16 + TABNME*9, TFNAME*64 CHARACTER(LEN=25) :: IDSRCE(7) CHARACTER :: HSTR*6, HTYPE*3 + CHARACTER(LEN=256) :: LINEIN + CHARACTER(LEN=32) :: WORDS(6) + CHARACTER(LEN=32) :: prefix + INTEGER :: dynpnt + LOGICAL :: PROCESS_POINT_ONLY + INTEGER :: ACTIVE_POINT, J_START, J_END !/ !/ ------------------------------------------------------------------- / !/ @@ -280,6 +286,10 @@ PROGRAM W3OUTP 'Wave-ice interactions ' , & 'Sum of selected sources ' / FLSRCE = .FALSE. + + ! Default values + prefix = "" ! Default to empty for point output prefix + dynpnt = 0 ! Default value for point output nameing ! #ifdef W3_NCO ! CALL W3TAGB('WAVESPEC',1998,0007,0050,'NP21 ') @@ -361,31 +371,66 @@ PROGRAM W3OUTP ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read general data and first fields from file + ! Output time, time step, number of steps, optional dynpnt and prefix ! + CALL NEXTLN ( COMSTR , NDSI , NDSE ) + WORDS = '' + READ (NDSI, '(A)', IOSTAT=IERR, END=801, ERR=802) LINEIN + READ(LINEIN,*,IOSTAT=IERR) WORDS + READ(WORDS(1), *, IOSTAT=IERR) TOUT(1) ! Date (yyyymmdd) + READ(WORDS(2), *, IOSTAT=IERR) TOUT(2) ! Time (hhmmss) + READ(WORDS(3), *, IOSTAT=IERR) DTREQ + READ(WORDS(4), *, IOSTAT=IERR) NOUT + IF (WORDS(5) /= '') READ(WORDS(5), *, IOSTAT=IERR) dynpnt + IF (WORDS(6) /= '') prefix = TRIM(WORDS(6)) + + DTREQ = MAX ( 0. , DTREQ ) + IF ( DTREQ.EQ.0 ) NOUT = 1 + NOUT = MAX ( 1 , NOUT ) + + prefix = TRIM(ADJUSTL(prefix)) + ! Ensure prefix ends with a dot + IF (LEN_TRIM(prefix) > 0) THEN + prefix = TRIM(prefix) // '.' + END IF + ! + + IF (dynpnt == 0) THEN #if W3_BIN2NC - CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) #else - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPO ( 'READ', NDSOP, IOTEST ) #endif ! - WRITE (NDSO,930) - DO I=1, NOPTS - IF ( FLAGLL ) THEN - WRITE (NDSO,931) PTNME(I), M2KM*PTLOC(1,I), M2KM*PTLOC(2,I) - ELSE - WRITE (NDSO,932) PTNME(I), M2KM*PTLOC(1,I), M2KM*PTLOC(2,I) - END IF - END DO + WRITE (NDSO,930) + DO I=1, NOPTS + IF ( FLAGLL ) THEN + WRITE (NDSO,931) PTNME(I), M2KM*PTLOC(1,I), M2KM*PTLOC(2,I) + ELSE + WRITE (NDSO,932) PTNME(I), M2KM*PTLOC(1,I), M2KM*PTLOC(2,I) + END IF + END DO + END IF ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 4. Read requests from input file. - ! Output times ! - CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT - DTREQ = MAX ( 0. , DTREQ ) - IF ( DTREQ.EQ.0 ) NOUT = 1 - NOUT = MAX ( 1 , NOUT ) + IF (dynpnt == 1) THEN +#if W3_BIN2NC + CALL W3IOPON ( 'READ', NDSOP, IOTEST, 1, TOUT ) + WRITE (NDSO,930) + DO I=1, NOPTS + IF ( FLAGLL ) THEN + WRITE (NDSO,931) PTNME(I), M2KM*PTLOC(1,I), M2KM*PTLOC(2,I) + ELSE + WRITE (NDSO,932) PTNME(I), M2KM*PTLOC(1,I), M2KM*PTLOC(2,I) + END IF + END DO +#else + WRITE (NDSE,1013) dynpnt + CALL EXTCDE ( 45 ) +#endif + END IF ! CALL STME21 ( TOUT , IDTIME ) WRITE (NDSO,940) IDTIME @@ -460,20 +505,23 @@ PROGRAM W3OUTP CLOSE(NDBO) #endif ! - WRITE (NDSO,942) ITYPE, 'Checking contents of file' - DO - CALL STME21 ( TIME , IDTIME ) - WRITE (NDSO,948) IDTIME + IF (dynpnt == 0) THEN + WRITE (NDSO,942) ITYPE, 'Checking contents of file' + DO + CALL STME21 ( TIME , IDTIME ) + WRITE (NDSO,948) IDTIME #ifdef W3_BIN2NC - CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) #else - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPO ( 'READ', NDSOP, IOTEST ) #endif - IF ( IOTEST .EQ. -1 ) THEN - WRITE (NDSO,949) - GOTO 888 - END IF - END DO + IF ( IOTEST .EQ. -1 ) THEN + WRITE (NDSO,949) + GOTO 888 + END IF + END DO + END IF + ! ! ... ITYPE = 1 ! @@ -510,33 +558,60 @@ PROGRAM W3OUTP OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,ERR=803,IOSTAT=IERR) WRITE (NDSO,1947) TABNME ELSE IF ( OTYPE .EQ. 3 ) THEN - TFNAME = 'ww3.--------.spc' - WRITE (TFNAME(5:12),'(I6.6,I2.2)') & - MOD(TOUT(1),1000000), TOUT(2)/10000 - WRITE (NDSO,943) 'Transfer file' - IF ( FLFORM ) THEN - WRITE (NDSO,1943) TFNAME, 'UNFORMATTED' - J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & - IOSTAT=IERR,form='UNFORMATTED', convert=file_endian) - WRITE (NDSTAB) 'WAVEWATCH III SPECTRA', & - NK, NTH, NREQ, GNAME - WRITE (NDSTAB) (SIG(IK)*TPIINV,IK=1,NK) - ! - ! conversion of directions from trignonmetric to nautical (still uses directions TO ) - ! - WRITE (NDSTAB) (MOD(2.5*PI-TH(ITH),TPI),ITH=1,NTH) - + IF (dynpnt .EQ. 1) THEN + WRITE (NDSO,943) 'Transfer file for each point' + DO IJ = 1, NOPTS + IF (FLREQ(IJ)) THEN + TFNAME = TRIM(prefix)//TRIM(PTNME(IJ))//'.spec' + WRITE (NDSO,1943) TRIM(TFNAME), 'Transfer File' + J = LEN_TRIM(FNMPRE) + IF (FLFORM) THEN + OPEN (NDSTAB, FILE=TRIM(TFNAME), ERR=804, & + IOSTAT=IERR, FORM='UNFORMATTED') + WRITE (NDSTAB) 'WAVEWATCH III SPECTRA', & + NK, NTH, 1, GNAME + WRITE (NDSTAB) (SIG(IK)*TPIINV, IK = 1, NK) + WRITE (NDSTAB) (MOD(2.5*PI-TH(ITH), TPI), ITH = 1, NTH) + ELSE + OPEN (NDSTAB, FILE=TRIM(TFNAME), ERR=804, & + IOSTAT=IERR, FORM='FORMATTED') + WRITE (NDSTAB,1944) 'WAVEWATCH III SPECTRA', & + NK, NTH, 1, GNAME + WRITE (NDSTAB,1945) (SIG(IK)*TPIINV, IK = 1, NK) + WRITE (NDSTAB,1946) (MOD(2.5*PI-TH(ITH), TPI), ITH= 1, NTH) + END IF + CLOSE(NDSTAB) + END IF + END DO ELSE - WRITE (NDSO,1943) TFNAME, 'FORMATTED' - J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & - IOSTAT=IERR,FORM='FORMATTED') - WRITE (NDSTAB,1944) 'WAVEWATCH III SPECTRA', & - NK, NTH, NREQ, GNAME - WRITE (NDSTAB,1945) (SIG(IK)*TPIINV,IK=1,NK) - WRITE (NDSTAB,1946) & - (MOD(2.5*PI-TH(ITH),TPI),ITH=1,NTH) + ! Default behavior when dynpnt = 0 + TFNAME = 'ww3.--------.spc' + WRITE (TFNAME(5:12),'(I6.6,I2.2)') & + MOD(TOUT(1),1000000), TOUT(2)/10000 + WRITE (NDSO,943) 'Transfer file' + IF ( FLFORM ) THEN + WRITE (NDSO,1943) TRIM(TFNAME), 'UNFORMATTED' + J = LEN_TRIM(FNMPRE) + OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & + IOSTAT=IERR,form='UNFORMATTED', convert=file_endian) + WRITE (NDSTAB) 'WAVEWATCH III SPECTRA', & + NK, NTH, NREQ, GNAME + WRITE (NDSTAB) (SIG(IK)*TPIINV,IK=1,NK) + ! + ! conversion of directions from trignonmetric to nautical (still uses directions TO ) + ! + WRITE (NDSTAB) (MOD(2.5*PI-TH(ITH),TPI),ITH=1,NTH) + ELSE + WRITE (NDSO,1943) TRIM(TFNAME), 'FORMATTED' + J = LEN_TRIM(FNMPRE) + OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & + IOSTAT=IERR,FORM='FORMATTED') + WRITE (NDSTAB,1944) 'WAVEWATCH III SPECTRA', & + NK, NTH, NREQ, GNAME + WRITE (NDSTAB,1945) (SIG(IK)*TPIINV,IK=1,NK) + WRITE (NDSTAB,1946) & + (MOD(2.5*PI-TH(ITH),TPI),ITH=1,NTH) + END IF END IF ELSE WRITE (NDSE,1011) OTYPE @@ -691,43 +766,78 @@ PROGRAM W3OUTP OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,ERR=803,IOSTAT=IERR) WRITE (NDSO,1947) TABNME - ELSEIF ( OTYPE .GE. 2 ) THEN + ELSE IF ( OTYPE .GE. 2 ) THEN IF (OTYPE .EQ. 2 .OR. OTYPE .EQ. 4 ) THEN - WRITE (NDSO,943) 'Bulletins, ASCII format' - J = LEN_TRIM(FNMPRE) - DO IJ = 1,NOPTS - IF ( COUNT(FLREQ) .GT. 1 ) THEN - ! ... This version only allows single point output for bulletins - WRITE (NDSE,1012) OTYPE - CALL EXTCDE ( 45 ) - ENDIF - IF (FLREQ(IJ)) THEN - NDSBUL = NDSTAB + (IJ - 1) - OPEN(NDSBUL,FILE=TRIM(PTNME(IJ))//'.bull',ERR=803,IOSTAT=IERR) - WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.bull' + IF (dynpnt .EQ. 1) THEN + WRITE (NDSO,943) 'Bulletins, ASCII format' + J = LEN_TRIM(FNMPRE) + DO IJ = 1,NOPTS + IF (FLREQ(IJ)) THEN + NDSBUL = NDSTAB + (IJ - 1) + OPEN(NDSBUL,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//'.bull',ERR=803,IOSTAT=IERR) + WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.bull' #ifdef W3_NCO - NDSCBUL = NDSTAB + (IJ - 1) + NOPTS - OPEN(NDSCBUL,FILE=TRIM(PTNME(IJ))//'.cbull',ERR=803,IOSTAT=IERR) - WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.cbull' + NDSCBUL = NDSTAB + (IJ - 1) + NOPTS + OPEN(NDSCBUL,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//'.cbull',ERR=803,IOSTAT=IERR) + WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.cbull' #endif - ENDIF - ENDDO + ENDIF + ENDDO + ELSE + WRITE (NDSO,943) 'Bulletins, ASCII format' + J = LEN_TRIM(FNMPRE) + DO IJ = 1,NOPTS + IF ( COUNT(FLREQ) .GT. 1 ) THEN + ! ... This version only allows single point output for bulletins + WRITE (NDSE,1012) OTYPE + CALL EXTCDE ( 45 ) + END IF + IF (FLREQ(IJ)) THEN + NDSBUL = NDSTAB + (IJ - 1) + OPEN(NDSBUL,FILE=TRIM(PTNME(IJ))//'.bull',ERR=803,IOSTAT=IERR) + WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.bull' +#ifdef W3_NCO + NDSCBUL = NDSTAB + (IJ - 1) + NOPTS + OPEN(NDSCBUL,FILE=TRIM(PTNME(IJ))//'.cbull',ERR=803,IOSTAT=IERR) + WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.cbull' +#endif + END IF + END DO + END IF ENDIF IF ( OTYPE .EQ. 3 .OR. OTYPE .EQ. 4 ) THEN - WRITE (NDSO,943) 'Bulletins, CSV format' - J = LEN_TRIM(FNMPRE) - DO IJ = 1,NOPTS - IF (FLREQ(IJ)) THEN - ICSV = 0 - IF ( NDSBUL .GT. 0 ) ICSV = NDSBUL + IF (dynpnt .EQ. 1) THEN + WRITE (NDSO,943) 'Bulletins, CSV format' + J = LEN_TRIM(FNMPRE) + DO IJ = 1,NOPTS + IF (FLREQ(IJ)) THEN + ICSV = 0 + NDSBUL = NDSTAB + (IJ - 1) +#ifdef W3_NCO + NDSCBUL = NDSTAB + (IJ - 1) + NOPTS +#endif + NDSCSV = NDSTAB + (IJ - 1) + 2*NOPTS + OPEN(NDSCSV,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//& + '.csv',ERR=803,IOSTAT=IERR) + WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.csv' + ENDIF + ENDDO + ELSE + WRITE (NDSO,943) 'Bulletins, CSV format' + J = LEN_TRIM(FNMPRE) + DO IJ = 1,NOPTS + IF (FLREQ(IJ)) THEN + ICSV = 0 + IF ( NDSBUL .GT. 0 ) ICSV = NDSBUL #ifdef W3_NCO - IF ( NDSCBUL .GT. 0 ) ICSV = NDSCBUL + IF ( NDSCBUL .GT. 0 ) ICSV = NDSCBUL #endif - NDSCSV = NDSTAB + (IJ - 1) + ICSV - OPEN(NDSCSV,FILE=TRIM(PTNME(IJ))//'.csv',ERR=803,IOSTAT=IERR) - WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.csv' - ENDIF - ENDDO + NDSCSV = NDSTAB + (IJ - 1) + ICSV + OPEN(NDSCSV,FILE=TRIM(PTNME(IJ))//'.csv',ERR=803,IOSTAT=IERR) + WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.csv' + END IF + END DO + END IF ENDIF ELSE WRITE (NDSE,1011) OTYPE @@ -762,6 +872,11 @@ PROGRAM W3OUTP !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 5. Time management. ! + IF (dynpnt .EQ. 1) THEN + PROCESS_POINT_ONLY = .FALSE. + ACTIVE_POINT = -1 + END IF + IOUT = 0 ! ! remark: it would be better to write these warnings only if source term @@ -789,7 +904,11 @@ PROGRAM W3OUTP DTEST = DSEC21 ( TIME , TOUT ) IF ( DTEST .GT. 0. ) THEN #ifdef W3_BIN2NC - CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + IF (dynpnt .EQ. 1) THEN + CALL W3IOPON ( 'READ', NDSOP, IOTEST, 1, TOUT ) + ELSE + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + END IF #else CALL W3IOPO ( 'READ', NDSOP, IOTEST ) #endif @@ -809,10 +928,35 @@ PROGRAM W3OUTP IF ( ( ITYPE.EQ.1 .AND. OTYPE.EQ.1 ) .OR. & ( ITYPE.EQ.3 .AND. OTYPE.EQ.1 ) & ) WRITE (NDSO,960) IDTIME - CALL W3EXPO + + IF (ITYPE .EQ. 1 .AND. OTYPE .EQ. 3 .AND. dynpnt .EQ. 1) THEN + DO IJ = 1, NOPTS + IF (FLREQ(IJ)) THEN + TFNAME = TRIM(prefix)//TRIM(PTNME(IJ))//'.spec' + J = LEN_TRIM(FNMPRE) + IF (FLFORM) THEN + OPEN(NDSTAB, FILE=TRIM(TFNAME), STATUS='OLD', & + IOSTAT=IERR, FORM='UNFORMATTED', ACCESS='APPEND') + ELSE + OPEN(NDSTAB, FILE=TRIM(TFNAME), STATUS='OLD', & + IOSTAT=IERR, FORM='FORMATTED', ACCESS='APPEND') + END IF + + PROCESS_POINT_ONLY = .TRUE. + ACTIVE_POINT = IJ + CALL W3EXPO + PROCESS_POINT_ONLY = .FALSE. + CLOSE(NDSTAB) + END IF + END DO + ELSE + CALL W3EXPO + END IF + CALL TICK21 ( TOUT , DTREQ ) IF ( IOUT .GE. NOUT ) EXIT END DO + ! ! ... ITYPE=4 & OTYPES=[2,4] requires adding lines at bottom of ! bulletin output for compatibility with version 2.22 @@ -828,6 +972,12 @@ PROGRAM W3OUTP WRITE(NDSCBUL,961) WRITE(NDSCBUL,962) #endif + CLOSE(NDSBUL) +#ifdef W3_NCO + CLOSE(NDSCBUL) +#endif + NDSCSV = NDSTAB + (IJ - 1) + 2*NOPTS + CLOSE(NDSCSV) ENDIF ENDDO ENDIF @@ -995,6 +1145,10 @@ PROGRAM W3OUTP 1012 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & ' MULTIPLE OUTPUT POINTS DEFINED, ITYPE =',I4,/ & ' ONLY SINGLE POINT ALLOWED IN THIS VERSION'/) + ! +1013 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & + ' PER TIME STEP OUTPUT IS DEFINED, dynpnt =',I4,/ & + ' ONLY SINGLE OUTPUT ALLOWED IN THIS VERSION'/) #ifdef W3_IC1 3960 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ & ' Ice source terms !/IC1 skipped'/ & @@ -1478,7 +1632,15 @@ SUBROUTINE W3EXPO !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! Loop over output points. ! - DO J=1, NOPTS + IF (dynpnt .EQ. 1 .AND. PROCESS_POINT_ONLY) THEN + J_START = ACTIVE_POINT + J_END = ACTIVE_POINT + ELSE + J_START = 1 + J_END = NOPTS + END IF + + DO J=J_START, J_END IF ( FLREQ(J) ) THEN ! #ifdef W3_T @@ -2584,12 +2746,20 @@ SUBROUTINE W3EXPO ENDIF IF ( OTYPE .EQ. 3 .OR. OTYPE .EQ. 4 ) THEN ICSV = 0 - IF ( NDSBUL .GT. 0 ) ICSV = NDSBUL + IF (dynpnt .EQ. 1) THEN + NDSCSV = NDSTAB + (J - 1) + 2*NOPTS + WRITE (NDSCSV,'(A664)') CSVBLINE #ifdef W3_NCO - IF ( NDSCBUL .GT. 0 ) ICSV = NDSCBUL + IF ( NDSCBUL .GT. 0 ) ICSV = NDSCBUL +#endif + ELSE + IF ( NDSBUL .GT. 0 ) ICSV = NDSBUL +#ifdef W3_NCO + IF ( NDSCBUL .GT. 0 ) ICSV = NDSCBUL #endif - NDSCSV = NDSTAB + (J - 1) + ICSV - WRITE (NDSCSV,'(A664)') CSVBLINE + NDSCSV = NDSTAB + (J - 1) + ICSV + WRITE (NDSCSV,'(A664)') CSVBLINE + END IF ENDIF END IF ! @@ -2865,3 +3035,4 @@ END SUBROUTINE W3EXPO !/ End of W3OUTP ----------------------------------------------------- / !/ END PROGRAM W3OUTP + diff --git a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB index 0927be62de..90d19f1c3a 100644 --- a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB +++ b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB @@ -1 +1 @@ -PDLIB SCOTCH NOGRB DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD1 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 BIN2NC +NCO PDLIB SCOTCH NOGRB DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD1 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 BIN2NC diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml deleted file mode 100644 index 4abd0cd4cf..0000000000 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.nml +++ /dev/null @@ -1,24 +0,0 @@ -! -------------------------------------------------------------------- ! -! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! -! -------------------------------------------------------------------- ! - - -! -------------------------------------------------------------------- ! -! Define the forcing fields to preprocess via FORCING_NML namelist -! -------------------------------------------------------------------- ! -&FORCING_NML -/ - -! -------------------------------------------------------------------- ! -! Define the content of the input file via FILE_NML namelist -! -------------------------------------------------------------------- ! -&FILE_NML - FILE%FILENAME = 2 - FILE%LONGITUDE = '-1' - FILE%LATITUDE = '' - FILE%VAR(1) = 'ww3.' -/ - -! -------------------------------------------------------------------- ! -! WAVEWATCH III - end of namelist ! -! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_outp_bull.inp similarity index 77% rename from regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp rename to regtests/ww3_ufs1.1/input_unstr/ww3_outp_bull.inp index 73375cfadc..f8e5c6ace4 100755 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_ounp.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_outp_bull.inp @@ -1,59 +1,44 @@ $ -------------------------------------------------------------------- $ -$ WAVEWATCH III NETCDF Point output post-processing $ +$ WAVEWATCH III Point output post-processing $ $--------------------------------------------------------------------- $ $ First output time (yyyymmdd hhmmss), increment of output (s), -$ and number of output times. +$ and number of output times, optional per-time-step (1) or single (0) +$ point output, optional point output prefix $ - 20210401 000000 3600. 100 + 20210401 000000 3600. 25 1 gfswave $ $ Points requested --------------------------------------------------- $ -$ -$ Define points index for which output is to be generated. -$ If no one defined, all points are selected -$ One index number per line, negative number identifies end of list. +$ Define points for which output is to be generated. $ $ mandatory end of list -1 $ -$--------------------------------------------------------------------- $ -$ file prefix -$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] -$ netCDF version [3,4] -$ points in same file [T] or not [F] -$ and max number of points to be processed in one pass -$ output type ITYPE [0,1,2,3] -$ flag for global attributes WW3 [0] or variable version [1-2-3-4] -$ flag for dimensions order time,station [T] or station,time [F] -$ - ww3. - 2 - 4 - T 1 - 2 - 0 - T +$ Output type ITYPE [0,1,2,3] $ + 4 $ -------------------------------------------------------------------- $ $ ITYPE = 0, inventory of file. $ No additional input, the above time range is ignored. $ $ -------------------------------------------------------------------- $ -$ ITYPE = 1, netCDF Spectra. +$ ITYPE = 1, Spectra. $ - Sub-type OTYPE : 1 : Print plots. $ 2 : Table of 1-D spectra $ 3 : Transfer file. $ 4 : Spectral partitioning. $ - Scaling factors for 1-D and 2-D spectra Negative factor $ disables, output, factor = 0. gives normalized spectrum. -$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. $ -$ 3 1 0 4 +$ 3 1. 0. 33 F $ $ The transfer file contains records with the following contents. $ $ - File ID in quotes, number of frequencies, directions and points. $ grid name in quotes (for unformatted file C*21,3I,C*30). -$ - Bin frequencies in Hz for all bins. +$ - Bin frequenies in Hz for all bins. $ - Bin directions in radians for all bins (Oceanographic conv.). $ -+ $ - Time in yyyymmdd hhmmss format | loop @@ -63,18 +48,26 @@ $ direction, current speed and direction | over | $ - E(f,theta) | points | times $ -+ -+ $ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ $ -------------------------------------------------------------------- $ -$ ITYPE = 2, netCDF Tables of (mean) parameter +$ ITYPE = 2, Tables of (mean) parameter $ - Sub-type OTYPE : 1 : Depth, current, wind $ 2 : Mean wave pars. $ 3 : Nondimensional pars. (U*) $ 4 : Nondimensional pars. (U10) $ 5 : 'Validation table' -$ 6 : WMO standard output - 2 +$ - Unit number for file, also used in file name. +$ +$ 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. $ $ -------------------------------------------------------------------- $ -$ ITYPE = 3, netCDF Source terms +$ ITYPE = 3, Source terms $ - Sub-type OTYPE : 1 : Print plots. $ 2 : Table of 1-D S(f). $ 3 : Table of 1-D inverse time scales @@ -83,15 +76,18 @@ $ 4 : Transfer file $ - Scaling factors for 1-D and 2-D source terms. Negative $ factor disables print plots, factor = 0. gives normalized $ print plots. +$ - Unit number for transfer file, also used in table file +$ name. $ - Flags for spectrum, input, interactions, dissipation, -$ bottom, ice and total source term. +$ bottom and total source term. $ - scale ISCALE for OTYPE=2,3 $ 0 : Dimensional. $ 1 : Nondimensional in terms of U10 $ 2 : Nondimensional in terms of U* $ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. $ -$ 4 0 0 T T T T T T T 0 +$ 1 0. 0. 50 T T T T T T 0 F $ $ The transfer file contains records with the following contents. $ @@ -109,10 +105,9 @@ $ - Sin(f,theta) if requested | | $ - Snl(f,theta) if requested | | $ - Sds(f,theta) if requested | | $ - Sbt(f,theta) if requested | | -$ - Sice(f,theta) if requested | | $ - Stot(f,theta) if requested | | $ -+ -+ -$ + 4 20210401 000000 1 'UTC' $ -------------------------------------------------------------------- $ $ End of input file $ $ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_outp_spec.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_outp_spec.inp new file mode 100755 index 0000000000..9448e175cd --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_outp_spec.inp @@ -0,0 +1,112 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times, optional per-time-step (1) or single (0) +$ point output, optional point output prefix +$ + 20210401 000000 3600. 25 1 gfswave +$ +$ Points requested --------------------------------------------------- $ +$ Define points for which output is to be generated. +$ +$ mandatory end of list + -1 +$ +$ Output type ITYPE [0,1,2,3] +$ + 1 +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. +$ + 3 1. 0. 33 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ - Unit number for file, also used in file name. +$ +$ 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. +$ +$ 1 0. 0. 50 T T T T T T 0 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_outp_tab.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_outp_tab.inp new file mode 100755 index 0000000000..c41a71c974 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_outp_tab.inp @@ -0,0 +1,112 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times, optional per-time-step (1) or single (0) +$ point output, optional point output prefix +$ + 20210401 000000 3600. 25 1 gfswave +$ +$ Points requested --------------------------------------------------- $ +$ Define points for which output is to be generated. +$ +$ mandatory end of list + -1 +$ +$ Output type ITYPE [0,1,2,3] +$ + 2 +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. +$ +$ 3 1. 0. 33 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ - Unit number for file, also used in file name. +$ + 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. +$ +$ 1 0. 0. 50 T T T T T T 0 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp index 82293f7c6d..c33d0a4d1c 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp @@ -31,7 +31,7 @@ CHA EF UST WND HS FP DP PHS PTP PDIR CUR ICE $ $ Point output $ - 20210401 000000 3600 20210402 000000 + 20210401 000000 3600 20210402 000000 1 -85.078 -19.425 '32012 ' -1 DAT WHOI 360 4534 -90.000 -55.000 '34002 ' 6.2 DAT OCOBSI 360 4800 -72.522 34.502 '41001 ' 4 DAT NDBC 360 4556 From e0ceda9069eb63a793297989bd90a826e3e75057 Mon Sep 17 00:00:00 2001 From: Biao Zhao Date: Mon, 17 Mar 2025 14:19:52 +0100 Subject: [PATCH 072/136] Update w3srcemd.F90 to correct bug related to TR1 (#1384) To calculate the increment of spectrum, we should use the source term VSTR rather than VDTR --- model/src/w3srcemd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index eeb2a95a1a..f160c2ea4d 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -1698,7 +1698,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_TR1 DO IS=IS1, NSPECH - eInc1 = VDTR(IS) * DT / MAX ( 1. , (1.-HDT*VDTR(IS))) + eInc1 = VSTR(IS) * DT / MAX ( 1. , (1.-HDT*VDTR(IS))) SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc1 ) END DO #endif From 528cfedbbaded7dd4e47fb216fe03a50e30d035f Mon Sep 17 00:00:00 2001 From: pvc1989 <21127966+pvc1989@users.noreply.github.com> Date: Tue, 18 Mar 2025 00:47:03 +0800 Subject: [PATCH 073/136] Fix a typo which breaks the build of the manual. (#1396) Typo in output.tex file is fixed to resolve build issue. --- manual/eqs/output.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/manual/eqs/output.tex b/manual/eqs/output.tex index 8deb484e10..ef9e38c664 100644 --- a/manual/eqs/output.tex +++ b/manual/eqs/output.tex @@ -311,7 +311,7 @@ \subsection{~Output parameters} \label{sub:outpars} 0.5 \left[ A(k,\theta)+ A(k,\theta+\pi)\right]^2 \frac{\sigma^2}{k C_g} \:\rd \theta \: \rd \sigma \: \label{eq:qkk} \end{equation} \item \textbf{SKW} Skewness of surface elevation sampled at zero slope. This is the $\lambda_1$ parameter defined in \cite{Barrick&Lipa1985} or $\lambda_{3,0,0}$ in \cite{Srokosz1986}. It is computed from the second order correction to the surface elevation, using ECWAM code by P. Janssen. -\item \textbf{EMB} this is $-\gamma/8 = -(\lambda_{1,2,0}+\lambda_{1,0,2}-2 \lambda{0,1,1} \lambda{1,1,1})/8 (1-\lambda_{0,1,1]^2)$, such that the mean sea level of points with zero slope +\item \textbf{EMB} this is $-\gamma/8 = -(\lambda_{1,2,0}+\lambda_{1,0,2}-2 \lambda{0,1,1} \lambda{1,1,1})/8 (1-\lambda_{0,1,1}^2)$, such that the mean sea level of points with zero slope is EMB$\times H_s$. \item \textbf{EMC} this is hte additional tracker bias coefficient equal to $-\lambda_{3,0,0}/24$, which is specific to the choice of retracker, see the $J_z$ function in \cite{DeCarlo&Ardhuin2024}. \end{list} From b9ab69bf85a78fed62a4ad1053ef829a5bfe91fe Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Wed, 19 Mar 2025 21:57:04 +0100 Subject: [PATCH 074/136] correct the attributes on p2l output variable (#1395) --- model/src/w3ounfmetamd.F90 | 4 ++-- model/src/w3profsmd.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/model/src/w3ounfmetamd.F90 b/model/src/w3ounfmetamd.F90 index 87e606e569..0d1312aa0e 100644 --- a/model/src/w3ounfmetamd.F90 +++ b/model/src/w3ounfmetamd.F90 @@ -3639,14 +3639,14 @@ SUBROUTINE DEFAULT_META() ! IFI=6, IFJ=9, P2L META => GROUP(6)%FIELD(9)%META ! Information for spectral microseismic generation data (2nd file) - META(1)%FSC = 0.0004 META(1)%VARNM='p2l' META(1)%VARNL='base ten logarithm of power spectral density of equivalent surface pressure' !META(1)%VARNS='base_ten_logarithm_of_power_spectral_density_of_equivalent_surface_pressure' META(1)%VARNS='' META(1)%VARNG='base_ten_logarithm_of_power_spectral_density_of_equivalent_surface_pressure' - IF (NCVARTYPE.EQ.2) THEN + IF (NCVARTYPE.LE.3) THEN META(1)%UNITS='log10(Pa2 m2 s+1E-12)' + META(1)%FSC = 0.0004 META(1)%VMIN = -12. META(1)%VMAX = 12. ELSE diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 3d50812d08..5fff60867f 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -677,7 +677,7 @@ SUBROUTINE W3XYPFSN2 ( ISP, C, LCALC, RD10, RD20, DT, AC) U(IP) = MAX(0.d0,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA(IP)))*DBLE(IOBPD(ITH,IP)) #ifdef W3_REF1 - WRITE(10111,*) REFPARS(3), IOBPD(ITH,IP), IOBPA(IP), U(IP), AC(IP) + ! WRITE(10111,*) REFPARS(3), IOBPD(ITH,IP), IOBPA(IP), U(IP), AC(IP) IF (REFPARS(3).LT.0.5.AND.IOBPD(ITH,IP).EQ.0.AND.IOBPA(IP).EQ.0) THEN U(IP) = AC(IP) ! restores reflected boundary values ENDIF From 6c8491ae4efbfe7ae6fd2560f15af0f09e570098 Mon Sep 17 00:00:00 2001 From: David Honegger Date: Tue, 25 Mar 2025 10:18:07 -0700 Subject: [PATCH 075/136] Calculate ww3_bounc Angular distances with haversines and utilize verbose=2 output (#1392) * Add a new Angular Distance distance calculation (in degrees) routine in w3servmd and use this method in ww3_bounc to more robustly calculate spherical distances between geographic locations. This commit also adds VERBOSE=2 diagnostic output. VERBOSE=2 was previously unused. * Corrected variable description --------- Co-authored-by: Ty Hesser --- model/src/w3servmd.F90 | 95 +++++++++++++++++++++++++++++++++++++++++ model/src/ww3_bounc.F90 | 18 ++++++-- 2 files changed, 110 insertions(+), 3 deletions(-) diff --git a/model/src/w3servmd.F90 b/model/src/w3servmd.F90 index 600e6e5728..44d986f7d9 100644 --- a/model/src/w3servmd.F90 +++ b/model/src/w3servmd.F90 @@ -18,6 +18,7 @@ MODULE W3SERVMD !/ 01-Mar-2016 : Added W3THRTN and W3XYRTN for post ( version 6.02 ) !/ processing rotated grid data !/ 15-Jan-2021 : Added UV_TO_MAG_DIR routine ( version 7.12 ) + !/ 02-Jan-2025 : Added DIST_HAVERSINE routine ( version 7.xx ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -511,6 +512,100 @@ REAL FUNCTION EJ5P ( F, ALFA, FP, YLN, SIGA, SIGB ) !/ End of NEXTLN ----------------------------------------------------- / !/ END FUNCTION EJ5P + !/ ------------------------------------------------------------------- / + + REAL FUNCTION DIST_HAVERSINE ( LON1, LAT1, LON2, LAT2 ) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III USACE/ERDC | + !/ | D. A. Honegger | + !/ | FORTRAN 90 | + !/ | Last update : 02-Jan-2025 | + !/ +-----------------------------------+ + !/ + !/ 02-Jan-2025 : Creation ( version 7.xx ) + !/ + ! 1. Purpose : + ! + ! Computes the haversine distance between two points on a sphere + ! + ! 2. Method + ! + ! Haversine Formula: R.W. Sinnott, "Virtues of the Haversine", + ! Sky and Telescope, vol. 68, no. 2, 1984, p. 159 + ! + ! 3. Parameters : + ! + ! Parameter list + ! + ! ---------------------------------------------------------------- + ! LON1 Real I Longitude of 1st point + ! LAT1 Real I Latitude of 1st point + ! LON2 Real I Longitude of 2nd point + ! LAT2 Real I Latitude of 2nd point + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! None. + ! + ! 5. Called by : + ! + ! WW3_BOUNC + ! + ! 6. Error messages : + ! + ! 7. Remarks : + ! + ! This function uses the haversine formula, which is robust to + ! rounding errors when calculating short distances + ! (less than 1 km). + ! + ! 8. Structure : + ! + ! See source code. + ! + ! 9. Switches : + ! + ! None. + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + USE CONSTANTS + ! DERA: Degrees to Radians (PI/180) + ! RADE: Radians to Degrees (180/PI) + !/ + !/ ------------------------------------------------------------------- / + !/ Parameter list + !/ + REAL, INTENT(IN) :: LON1, LAT1, LON2, LAT2 + !/ + !/ ------------------------------------------------------------------- / + !/ Local parameters + !/ + REAL :: DLON, DLAT, A, C + !/ + !/ ------------------------------------------------------------------- / + !/ + + ! Compute differences in latitude and longitude + DLAT = (LAT2 - LAT1) * DERA + DLON = (LON2 - LON1) * DERA + + ! Compute the haversine of the central angle + A = SIN(DLAT / 2.0)**2 + COS(LAT1 * DERA) * COS(LAT2 * DERA) * SIN(DLON / 2.0)**2 + + ! Compute the angular distance (c), ensuring no precision issues + C = 2.0 * ATAN2(SQRT(A), SQRT(MAX(0.0, 1.0 - A))) + + ! Compute the spherical distance + DIST_HAVERSINE = RADE * C + + RETURN + END FUNCTION DIST_HAVERSINE + !/ ------------------------------------------------------------------- / + !/ ------------------------------------------------------------------- / REAL FUNCTION DIST_SPHERE ( lo1,la1,lo2,la2 ) !/ diff --git a/model/src/ww3_bounc.F90 b/model/src/ww3_bounc.F90 index 549f027d5b..77ac0432cb 100644 --- a/model/src/ww3_bounc.F90 +++ b/model/src/ww3_bounc.F90 @@ -25,8 +25,9 @@ PROGRAM W3BOUNC !/ | WAVEWATCH III NOAA/NCEP | !/ | F. Ardhuin | !/ | M. Accensi | + !/ | D. A. Honegger | !/ | FORTRAN 90 | - !/ | Last update : 21-Jul-2020 | + !/ | Last update : 02-Jan-2025 | !/ +-----------------------------------+ !/ !/ 24-May-2013 : Adaptation from ww3_bound.ftn ( version 4.08 ) @@ -38,6 +39,8 @@ PROGRAM W3BOUNC !/ 15-May-2018 : Add namelist feature ( version 6.05 ) !/ 04-May-2020 : Update spectral conversion ( version 7.11 ) !/ 21-Jul-2020 : Support rotated pole grid ( version 7.11 ) + !/ 02-Jan-2025 : Change geographic distance method ( version 7.xx ) + !/ 02-Jan-2025 : Add verbose=2 display output ( version 7.xx ) !/ !/ !/ Copyright 2012-2013 National Weather Service (NWS), @@ -138,7 +141,7 @@ PROGRAM W3BOUNC USE W3IOBCMD, ONLY: VERBPTBC, IDSTRBC USE W3IOGRMD, ONLY: W3IOGR USE W3TIMEMD - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, DIST_SPHERE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, DIST_HAVERSINE #ifdef W3_RTD USE W3SERVMD, ONLY: W3EQTOLL #endif @@ -534,6 +537,9 @@ PROGRAM W3BOUNC CALL CHECK_ERR(IRET) END IF + ! Display the location of the ingested NetCDF file + IF (VERBOSE.GE.2) WRITE(NDSO,*) 'FILEID:',IP,'LON:',LONS(IP),'LAT:',LATS(IP) + ! freq and dir variables IRET=NF90_INQ_VARID(NCID(IP),"frequency",VARID(4)) CALL CHECK_ERR(IRET) @@ -649,7 +655,7 @@ PROGRAM W3BOUNC DO IP=1,NBO2 ! Searches for the nearest 2 points where spectra are available IF (FLAGLL) THEN - DIST=DIST_SPHERE ( LONS(IP),LATS(IP),XBPO(IP1),YBPO(IP1) ) + DIST=DIST_HAVERSINE( LONS(IP),LATS(IP),XBPO(IP1),YBPO(IP1) ) ELSE DIST=SQRT((LONS(IP)-XBPO(IP1))**2+(LATS(IP)-YBPO(IP1))**2) END IF @@ -671,6 +677,12 @@ PROGRAM W3BOUNC END IF END IF END IF + ! Display iteration to find distance minima + IF (VERBOSE.GE.2) WRITE(NDSO,*) & + 'BOUNDID:',IP1,'FILEID:',IP, & + 'DX:',LONS(IP)-XBPO(IP1),'DY:',LATS(IP)-YBPO(IP1), & + 'DIST:',DIST,'DMIN:',DMIN,'DMIN2:',DMIN2 + END DO ! IP1=1,NBO2 IF (VERBOSE.GE.1) WRITE(NDSO,*) 'DIST:',DMIN,DMIN2,IP1,IPBPO(IP1,1),IPBPO(IP1,2), & LONS(IPBPO(IP1,1)),LONS(IPBPO(IP1,2)),XBPO(IP1), & From c0b0160bdcf193fab197b2fa0d207736d50309aa Mon Sep 17 00:00:00 2001 From: Erin E Thomas <60432101+erinethomas@users.noreply.github.com> Date: Wed, 26 Mar 2025 14:13:18 -0600 Subject: [PATCH 076/136] Updated Numerical Solution for Wave Attenuation in sea ice (#1294) * This PR adds a write statement in ww3_grid.out and therefore will result in changes in all ww3_grid.out files in regtests. *add IC4_NUMERICS namelist to w3gdatmd.F90 * add IC4_NUMERICS namelist to w3gridmd.F90 * make ICNUMERICS namelist setting (to be put under MISC namelist) - Ic numerics fix should be applicable to ALL IC settings. * IC_NUMERICS Fix for All sea ice source terms * remove lines that modify timestep in sea ice * remove pointer on line 704 w3gdatmd.F90 --- model/src/w3gdatmd.F90 | 4 + model/src/w3gridmd.F90 | 11 +- model/src/w3srcemd.F90 | 235 ++++++++++++++++++++++++++--------------- 3 files changed, 162 insertions(+), 88 deletions(-) diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 28af7329e5..328bf93d24 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -240,6 +240,7 @@ MODULE W3GDATMD ! for individual grid points. ! IICEDISP Log. Public Flag for use of the ice covered dispertion relation. ! IICESMOOTH Log. Public Flag to smooth the ice covered dispertion relation in broken ice. + ! IC_NUMERICS Log. Public Turn on/off IC numerics fix ! ! ! GNAME C*30 Public Grid name. @@ -700,6 +701,7 @@ MODULE W3GDATMD LOGICAL :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,& IICESMOOTH + LOGICAL :: IC_NUMERICS LOGICAL :: FLAGLL LOGICAL :: CMPRTRCK LOGICAL, POINTER :: FLAGST(:) @@ -1216,6 +1218,7 @@ MODULE W3GDATMD LOGICAL, POINTER :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,& IICESMOOTH + LOGICAL, POINTER :: IC_NUMERICS LOGICAL, POINTER :: FLAGLL LOGICAL, POINTER :: CMPRTRCK LOGICAL, POINTER :: FLAGST(:) @@ -2385,6 +2388,7 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) FLSOU => GRIDS(IMOD)%FLSOU IICEDISP => GRIDS(IMOD)%IICEDISP IICESMOOTH => GRIDS(IMOD)%IICESMOOTH + IC_NUMERICS => GRIDS(IMOD)%IC_NUMERICS ! GNAME => GRIDS(IMOD)%GNAME FILEXT => GRIDS(IMOD)%FILEXT diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 8bfc6521a7..c094bd218f 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -809,6 +809,7 @@ MODULE W3GRIDMD ! REAL(8) :: GSHIFT ! see notes in WMGHGH LOGICAL :: FLC, ICEDISP, TRCKCMPR + LOGICAL :: ICNUMERICS INTEGER :: PTM ! Partitioning method REAL :: PTFC ! Part. cut off freq (for method 5) REAL :: AIRCMIN, AIRGB @@ -1113,7 +1114,7 @@ MODULE W3GRIDMD STDX, STDY, STDT, ICEHMIN, ICEHINIT, ICEDISP, & ICESLN, ICEWIND, ICESNL, ICESDS, ICEHFAC, & ICEHDISP, ICEDDISP, ICEFDISP, CALTYPE, & - TRCKCMPR, PTM, PTFC, BTBET + TRCKCMPR, PTM, PTFC, BTBET, ICNUMERICS NAMELIST /OUTS/ P2SF, I1P2SF, I2P2SF, & US3D, I1US3D, I2US3D, & USSP, IUSSP, STK_WN, & @@ -2765,6 +2766,7 @@ SUBROUTINE W3GRID() STDY = -1. STDT = -1. ICEDISP = .FALSE. + ICNUMERICS=.FALSE. CALTYPE = 'standard' ! Variables for 3D array output E3D=0 @@ -3035,6 +3037,7 @@ SUBROUTINE W3GRID() IICEHDISP = ICEHDISP IICEDDISP = ICEDDISP IICEFDISP = ICEFDISP + IC_NUMERICS=ICNUMERICS PMOVE = MAX ( 0. , PMOVE ) PFMOVE = PMOVE ! @@ -3424,7 +3427,7 @@ SUBROUTINE W3GRID() ICEHINIT, ICEDISP, ICEHDISP, & ICESLN, ICEWIND, ICESNL, ICESDS, & ICEDDISP,ICEFDISP, CALTYPE, TRCKCMPR, & - BTBETA + BTBETA,ICNUMERICS ELSE WRITE (NDSO,2966) CICE0, CICEN, LICE, PMOVE, XSEED, FLAGTR, & XP, XR, XFILT, IHMAX, HSPMIN, WSMULT, & @@ -3434,7 +3437,7 @@ SUBROUTINE W3GRID() ICEHINIT, ICEDISP, ICEHDISP, & ICESLN, ICEWIND, ICESNL, ICESDS, & ICEDDISP, ICEFDISP, CALTYPE, TRCKCMPR,& - BTBETA + BTBETA,ICNUMERICS END IF ! #ifdef W3_FLD1 @@ -6833,7 +6836,7 @@ SUBROUTINE W3GRID() ', ICESNL = ',F6.2,', ICESDS = ',F5.2,','/ & ' ICEDDISP = ',F5.2,', ICEFDISP = ',F5.2, & ', CALTYPE = ',A8,' , TRCKCMPR = ', L3,','/ & - ' BTBET = ', F6.2, ' /') + ' BTBET = ', F6.2, ', ICNUMERICS =',L3,' /') ! 2976 FORMAT ( ' &OUTS P2SF =',I2,', I1P2SF =',I2,', I2P2SF =',I3,','/& ' US3D =',I2,', I1US3D =',I3,', I2US3D =',I3,','/& diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index f160c2ea4d..beb3e13d5b 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -500,6 +500,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & XFC, XFLT, XREL, XFT, FXFM, FXPM, DDEN, & FTE, FTF, FHMAX, ECOS, ESIN, IICEDISP, & ICESCALES, IICESMOOTH + USE W3GDATMD, ONLY: IC_NUMERICS USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: NDSE, NDST, IAPROC USE W3IDATMD, ONLY: INFLAGS2 @@ -1324,8 +1325,35 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! UNRESOLVED OBSTACLES CALL UOST_SRCTRMCOMPUTE(IX, IY, SPEC, CG1, DT, & U10ABS, U10DIR, VSUO, VDUO) +#endif + ! Sea Ice Source Terms if IC_NUMERICS namelist flag = True + IF (IC_NUMERICS) THEN +#ifdef W3_IC1 + IF (ICE .GT. 0) CALL W3SIC1 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IS2 + IF (ICE .GT. 0) CALL W3SIS2 ( SPEC, DEPTH, ICE, ICEH, ICEF, ICEDMAX, IX, IY, & + VSIR, VDIR, VDIR2, WN1, CG1, WN_R, CG_ICE, R ) +#endif +#ifdef W3_IC2 + IF (ICE .GT. 0) CALL W3SIC2 ( SPEC, DEPTH, ICEH, ICEF, CG1, WN1,& + IX, IY, VSIC, VDIC, WN_R, CG_ICE, ALPHA_LIU, R) +#endif +#ifdef W3_IC3 + IF (ICE .GT. 0) CALL W3SIC3 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IC4 + IF (ICE .GT. 0) CALL W3SIC4 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IC5 + IF (ICE .GT. 0) CALL W3SIC5 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) #endif ! +#ifdef W3_IS1 + IF (ICE .GT. 0) CALL W3SIS1 ( SPEC, ICE, VSIR ) +#endif + ENDIF + ! ! 2.g Dump training data if necessary ! #ifdef W3_NNT @@ -1384,6 +1412,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & VDIN(1:NSPECH) = ICESCALEIN * VDIN(1:NSPECH) VSDS(1:NSPECH) = ICESCALEDS * VSDS(1:NSPECH) VDDS(1:NSPECH) = ICESCALEDS * VDDS(1:NSPECH) + IF(IC_NUMERICS) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + VSIC(1:NSPECH) = ICE * VSIC(1:NSPECH) ! (see Rogers et al 2016) + VDIC(1:NSPECH) = ICE * VDIC(1:NSPECH) +#endif + ENDIF END IF #ifdef W3_PDLIB @@ -1423,6 +1457,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_UOST VS(IS) = VS(IS) + VSUO(IS) #endif + IF ( IC_NUMERICS .AND. ICE.GT.0. ) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + VS(IS) = VS(IS) + VSIC(IS) +#endif + ENDIF VD(IS) = VDIN(IS) + VDNL(IS) & + VDDS(IS) + VDBT(IS) #ifdef W3_ST6 @@ -1437,6 +1476,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_UOST VD(IS) = VD(IS) + VDUO(IS) #endif + IF ( IC_NUMERICS .AND. ICE.GT.0. ) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + VD(IS) = VD(IS) + VDIC(IS) +#endif + ENDIF DAMAX = MIN ( DAM(IS) , MAX ( XREL*SPECINIT(IS) , AFILT ) ) AFAC = 1. / MAX( 1.E-10 , ABS(VS(IS)/DAMAX) ) #ifdef W3_NL5 @@ -1748,6 +1792,14 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & / MAX ( 1. , (1.-HDT*VDBT(IS))) ! semi-implict integration scheme PHINL = PHINL + VSNL(IS)* DT * FACTOR & / MAX ( 1. , (1.-HDT*VDNL(IS))) ! semi-implict integration scheme + IF ( IC_NUMERICS .AND. ICE.GT.0 ) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + PHICE = PHICE + VSIC(IS) * DT * FACTOR & + / MAX ( 1. , (1.-HDT*VDIC(IS))) ! semi-implicit integration + TAUICE(:) = TAUICE(:) - FACTOR2*COSI(:)*VSIC(IS) * DT & + / MAX ( 1. , (1.-HDT*VDIC(IS))) +#endif + ENDIF IF (VSIN(IS).GT.0.) WHITECAP(3) = WHITECAP(3) + SPEC(IS) * FACTOR HSTOT = HSTOT + SPEC(IS) * FACTOR END DO @@ -2009,6 +2061,13 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! TAUOX=(GRAV*MWXFINISH+TAUWIX-TAUBBL(1))/DTG TAUOY=(GRAV*MWYFINISH+TAUWIY-TAUBBL(2))/DTG + IF (IC_NUMERICS) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + TAUICE(:)=TAUICE(:)/DTG + TAUOX = TAUOX - TAUICE(1) + TAUOY = TAUOY - TAUICE(2) +#endif + ENDIF TAUWIX=TAUWIX/DTG TAUWIY=TAUWIY/DTG TAUWNX=TAUWNX/DTG @@ -2023,6 +2082,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & PHIAW =DWAT*GRAV*PHIAW /DTG PHINL =DWAT*GRAV*PHINL /DTG PHIBBL=DWAT*GRAV*PHIBBL/DTG + IF (IC_NUMERICS) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + PHICE =-1.*DWAT*GRAV*PHICE/DTG +#endif + ENDIF ! ! 10.1 Adds ice scattering and dissipation: implicit integration---------------- * ! INFLAGS2(4) is true if ice concentration was ever read during @@ -2035,133 +2099,136 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif IF ( INFLAGS2(4).AND.ICE.GT.0 ) THEN - - IF (IICEDISP) THEN - ICECOEF2 = 1E-6 - CALL LIU_FORWARD_DISPERSION (ICEH,ICECOEF2,DEPTH, & - SIG,WN_R,CG_ICE,ALPHA_LIU) + IF (.NOT. IC_NUMERICS ) THEN + IF (IICEDISP) THEN + ICECOEF2 = 1E-6 + CALL LIU_FORWARD_DISPERSION (ICEH,ICECOEF2,DEPTH, & + SIG,WN_R,CG_ICE,ALPHA_LIU) ! - IF (IICESMOOTH) THEN + IF (IICESMOOTH) THEN #ifdef W3_IS2 - DO IK=1,NK - SMOOTH_ICEDISP=0. - IF (IS2PARS(14)*(TPI/WN_R(IK)).LT.ICEF) THEN ! IF ICE IS NOT TOO MUCH BROKEN - SMOOTH_ICEDISP=TANH((ICEF-IS2PARS(14)*(TPI/WN_R(IK)))/(ICEF*IS2PARS(13))) - END IF - WN_R(IK)=WN1(IK)*(1-SMOOTH_ICEDISP)+WN_R(IK)*(SMOOTH_ICEDISP) - END DO + DO IK=1,NK + SMOOTH_ICEDISP=0. + IF (IS2PARS(14)*(TPI/WN_R(IK)).LT.ICEF) THEN ! IF ICE IS NOT TOO MUCH BROKEN + SMOOTH_ICEDISP=TANH((ICEF-IS2PARS(14)*(TPI/WN_R(IK)))/(ICEF*IS2PARS(13))) + END IF + WN_R(IK)=WN1(IK)*(1-SMOOTH_ICEDISP)+WN_R(IK)*(SMOOTH_ICEDISP) + END DO #endif + END IF + ELSE + WN_R=WN1 + CG_ICE=CG1 END IF - ELSE - WN_R=WN1 - CG_ICE=CG1 - END IF ! - R(:)=1 ! In case IC2 is defined but not IS2 + 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, & + 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,& + CALL W3SIC2 ( SPEC, DEPTH, ICEH, ICEF, CG1, WN1,& IX, IY, VSIC, VDIC, WN_R, CG_ICE, ALPHA_LIU, R) #endif #ifdef W3_IC3 - CALL W3SIC3 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) + CALL W3SIC3 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) #endif #ifdef W3_IC4 - CALL W3SIC4 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) + CALL W3SIC4 ( SPEC,DEPTH, CG1, & + IX, IY, VSIC, VDIC ) #endif #ifdef W3_IC5 - CALL W3SIC5 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) + CALL W3SIC5 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) #endif ! #ifdef W3_IS1 - CALL W3SIS1 ( SPEC, ICE, VSIR ) + CALL W3SIS1 ( SPEC, ICE, VSIR ) #endif - SPEC2 = SPEC - ! - TAUICE(:) = 0. - PHICE = 0. - DO IK=1,NK - IS = 1+(IK-1)*NTH + + SPEC2 = SPEC ! - ! First part of ice term integration: dissipation part - ! - ATT=1. + TAUICE(:) = 0. + PHICE = 0. + DO IK=1,NK + IS = 1+(IK-1)*NTH + ! + ! First part of ice term integration: dissipation part + ! + ATT=1. #ifdef W3_IC1 - ATT=EXP(ICE*VDIC(IS)*DTG) + ATT=EXP(ICE*VDIC(IS)*DTG) #endif #ifdef W3_IC2 - ATT=EXP(ICE*VDIC(IS)*DTG) + ATT=EXP(ICE*VDIC(IS)*DTG) #endif #ifdef W3_IC3 - ATT=EXP(ICE*VDIC(IS)*DTG) + ATT=EXP(ICE*VDIC(IS)*DTG) #endif #ifdef W3_IC4 - ATT=EXP(ICE*VDIC(IS)*DTG) + ATT=EXP(ICE*VDIC(IS)*DTG) #endif #ifdef W3_IC5 - ATT=EXP(ICE*VDIC(IS)*DTG) + ATT=EXP(ICE*VDIC(IS)*DTG) #endif #ifdef W3_IS1 - ATT=ATT*EXP(ICE*VDIR(IS)*DTG) + ATT=ATT*EXP(ICE*VDIR(IS)*DTG) #endif #ifdef W3_IS2 - ATT=ATT*EXP(ICE*VDIR2(IS)*DTG) - IF (IS2PARS(2).EQ.0) THEN ! Reminder : IS2PARS(2) = IS2BACKSCAT + ATT=ATT*EXP(ICE*VDIR2(IS)*DTG) + IF (IS2PARS(2).EQ.0) THEN ! Reminder : IS2PARS(2) = IS2BACKSCAT + ! + ! If there is not re-distribution in directions the scattering is just an attenuation + ! + ATT=ATT*EXP((ICE*VDIR(IS))*DTG) + END IF +#endif + SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH) = ATT*SPEC2(1+(IK-1)*NTH:NTH+(IK-1)*NTH) ! - ! If there is not re-distribution in directions the scattering is just an attenuation + ! Second part of ice term integration: scattering including re-distribution in directions ! - ATT=ATT*EXP((ICE*VDIR(IS))*DTG) - END IF -#endif - SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH) = ATT*SPEC2(1+(IK-1)*NTH:NTH+(IK-1)*NTH) - ! - ! Second part of ice term integration: scattering including re-distribution in directions - ! #ifdef W3_IS2 - IF (IS2PARS(2).GE.0) THEN - IF (IS2PARS(20).GT.0.5) THEN - ! - ! Case of isotropic back-scatter: the directional spectrum is decomposed into - ! - an isotropic part (ISO): eigenvalue of scattering is 0 - ! - the rest (SPEC-ISO): eigenvalue of scattering is VDIR(IS) - ! - SCAT = EXP(VDIR(IS)*IS2PARS(2)*DTG) - ISO = SUM(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH))/NTH - SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH) = ISO & - +(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH)-ISO)*SCAT - ELSE - ! - ! General solution with matrix exponentials: same as bottom scattering, see Ardhuin & Herbers (JFM 2002) - ! - SCATSPEC(1:NTH)=DBLE(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH)) - SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH) = & - REAL(MATMUL(IS2EIGVEC(:,:), EXP(IS2EIGVAL(:)*VDIR(IS)*DTG*IS2PARS(2)) & - *MATMUL(TRANSPOSE(IS2EIGVEC(:,:)),SCATSPEC))) + IF (IS2PARS(2).GE.0) THEN + IF (IS2PARS(20).GT.0.5) THEN + ! + ! Case of isotropic back-scatter: the directional spectrum is decomposed into + ! - an isotropic part (ISO): eigenvalue of scattering is 0 + ! - the rest (SPEC-ISO): eigenvalue of scattering is VDIR(IS) + ! + SCAT = EXP(VDIR(IS)*IS2PARS(2)*DTG) + ISO = SUM(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH))/NTH + SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH) = ISO & + +(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH)-ISO)*SCAT + ELSE + ! + ! General solution with matrix exponentials: same as bottom scattering, see Ardhuin & Herbers (JFM 2002) + ! + SCATSPEC(1:NTH)=DBLE(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH)) + SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH) = & + REAL(MATMUL(IS2EIGVEC(:,:), EXP(IS2EIGVAL(:)*VDIR(IS)*DTG*IS2PARS(2)) & + *MATMUL(TRANSPOSE(IS2EIGVEC(:,:)),SCATSPEC))) + END IF END IF - END IF #endif - ! - ! 10.2 Fluxes of energy and momentum due to ice effects - ! - FACTOR = DDEN(IK)/CG1(IK) !Jacobian to get energy in band - FACTOR2= FACTOR*GRAV*WN1(IK)/SIG(IK) ! coefficient to get momentum - DO ITH = 1,NTH - IS = ITH+(IK-1)*NTH - PHICE = PHICE + (SPEC(IS)-SPEC2(IS)) * FACTOR - COSI(1)=ECOS(IS) - COSI(2)=ESIN(IS) - TAUICE(:) = TAUICE(:) - (SPEC(IS)-SPEC2(IS))*FACTOR2*COSI(:) + ! + ! 10.2 Fluxes of energy and momentum due to ice effects + ! + FACTOR = DDEN(IK)/CG1(IK) !Jacobian to get energy in band + FACTOR2= FACTOR*GRAV*WN1(IK)/SIG(IK) ! coefficient to get momentum + DO ITH = 1,NTH + IS = ITH+(IK-1)*NTH + PHICE = PHICE + (SPEC(IS)-SPEC2(IS)) * FACTOR + COSI(1)=ECOS(IS) + COSI(2)=ESIN(IS) + TAUICE(:) = TAUICE(:) - (SPEC(IS)-SPEC2(IS))*FACTOR2*COSI(:) + END DO END DO - END DO - PHICE =-1.*DWAT*GRAV*PHICE /DTG - TAUICE(:)=TAUICE(:)/DTG + PHICE =-1.*DWAT*GRAV*PHICE /DTG + TAUICE(:)=TAUICE(:)/DTG + ENDIF ! end if IC_NUMERICS ELSE #ifdef W3_IS2 IF (IS2PARS(10).LT.0.5) THEN From 0a9e10f7d55f2b73eb2ffc03a1dd05fd05f434c7 Mon Sep 17 00:00:00 2001 From: john warner Date: Wed, 26 Mar 2025 16:27:29 -0400 Subject: [PATCH 077/136] update scrip_remap_conservative to use MPI (#1268) --------- Co-authored-by: Matthew Masarik --- ...servative.f => scrip_remap_conservative.F} | 536 +++++++++++++++++- model/src/cmake/src_list.cmake | 2 +- model/src/cmake/switches.json | 11 + regtests/bin/matrix.base | 219 +++---- regtests/bin/run_cmake_test | 19 +- regtests/mww3_test_02/info | 11 +- .../input/switch_PR3_UNO_SCRIPMPI | 1 + 7 files changed, 671 insertions(+), 128 deletions(-) rename model/src/SCRIP/{scrip_remap_conservative.f => scrip_remap_conservative.F} (92%) mode change 100644 => 100755 create mode 100644 regtests/mww3_test_02/input/switch_PR3_UNO_SCRIPMPI diff --git a/model/src/SCRIP/scrip_remap_conservative.f b/model/src/SCRIP/scrip_remap_conservative.F old mode 100644 new mode 100755 similarity index 92% rename from model/src/SCRIP/scrip_remap_conservative.f rename to model/src/SCRIP/scrip_remap_conservative.F index 4bbc748c82..c45003ad91 --- a/model/src/SCRIP/scrip_remap_conservative.f +++ b/model/src/SCRIP/scrip_remap_conservative.F @@ -252,6 +252,11 @@ subroutine remap_conserv(l_master, l_test) ! !----------------------------------------------------------------------- +#ifdef W3_SCRIPMPI + USE WMMDATMD, ONLY: MPI_COMM_GRD + USE W3ODATMD, ONLY: IAPROC, NTPROC + INCLUDE "mpif.h" +#endif logical(SCRIP_Logical), intent(in) :: l_master ! Am I the master ! processor (do I/O)? logical(SCRIP_Logical), intent(in) :: l_test ! Whether to @@ -262,11 +267,21 @@ subroutine remap_conserv(l_master, l_test) ! local variables ! !----------------------------------------------------------------------- +#ifdef W3_SCRIPMPI + integer (SCRIP_i4) :: IERR_MPI, IPROC, ratio + integer (SCRIP_i4) :: j, ij, add1, add2, got_weight + integer (SCRIP_i4) :: nlink, min_link, max_link + integer (SCRIP_i4), dimension(MPI_STATUS_SIZE) :: status + integer (SCRIP_i4), dimension(:), allocatable :: Numlinks + integer (SCRIP_i4), dimension(:), allocatable :: Asendi + integer (SCRIP_i4), dimension(:), allocatable :: Arecv1 + integer (SCRIP_i4), dimension(:), allocatable :: Arecv2 +#endif + integer (SCRIP_i4) :: grid1_str, grid1_end, grid2_str, grid2_end integer (SCRIP_i4), parameter :: & phi_or_theta = 2 ! integrate w.r.t. phi (1) or theta (2) - integer (SCRIP_i4) :: & i, inext, ! & n, nwgt, @@ -301,6 +316,12 @@ subroutine remap_conserv(l_master, l_test) ! and true area & ref_area ! Area of cell as computed by direct ! integration around its boundaries +#ifdef W3_SCRIPMPI + real (SCRIP_r8), dimension(:), allocatable :: Asend + real (SCRIP_r8), dimension(:), allocatable :: Arecvw + real (SCRIP_r8), dimension(:), allocatable :: Arecv + real (SCRIP_r8), dimension(:,:), allocatable :: Arecvw2d +#endif ! call OMP_SET_DYNAMIC(.FALSE.) @@ -333,11 +354,34 @@ subroutine remap_conserv(l_master, l_test) call timer_start(1) + + +#ifdef W3_SCRIPMPI +! +! To do this in mpi, we will just break up the sweep loops into chunks. Then +! gather all of the data at end of each loop so that each proc has a full set of +! data. First we want to determine start and end chunks for this processor. +! +! Revert back to 0 based processor number. + IPROC=IAPROC-1 + IF (NTPROC.eq.1) THEN + grid1_str=1 + grid1_end=grid1_size + ELSE + ratio=INT(grid1_size/NTPROC) + grid1_str=(IPROC*ratio)+1 + grid1_end=grid1_str+ratio-1 + IF (IPROC+1.eq.NTPROC) grid1_end=grid1_size + END IF +#else + grid1_str=1 + grid1_end=grid1_size +#endif + C$OMP PARALLEL DEFAULT(SHARED) PRIVATE(grid1_add) NUM_THREADS(nthreads) C$OMP DO SCHEDULE(DYNAMIC) - - do grid1_add = 1,grid1_size + do grid1_add = grid1_str,grid1_end if (mod(grid1_add,progint) .eq. 0 .and. is_master) then print *, grid1_add,' of ',grid1_size,' cells processed ...' @@ -351,6 +395,109 @@ subroutine remap_conserv(l_master, l_test) C$OMP END PARALLEL + +#ifdef W3_SCRIPMPI + IF (NTPROC.gt.1) THEN +! +! Here we need to gather all the data processed and +! send to each proc so they know the full data set. +! +! grid1 integrate +! + allocate (Asend(grid1_size)) + allocate (Arecv(grid1_size)) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid1_frac(grid1_size) +! zero it out. + DO grid1_add=1,grid1_size + Asend(grid1_add)=zero + Arecv(grid1_add)=zero + END DO +! fill the send for this tile. + DO grid1_add=grid1_str,grid1_end + Asend(grid1_add)=grid1_frac(grid1_add) + END DO + call mpi_allreduce(Asend, Arecv, grid1_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid1_add=1,grid1_size + grid1_frac(grid1_add)=Arecv(grid1_add) + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid1_area(grid1_size) +! zero it out. + DO grid1_add=1,grid1_size + Asend(grid1_add)=zero + Arecv(grid1_add)=zero + END DO +! fill the send for this tile. + DO grid1_add=grid1_str,grid1_end + Asend(grid1_add)=grid1_area(grid1_add) + END DO + call mpi_allreduce(Asend, Arecv, grid1_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid1_add=1,grid1_size + grid1_area(grid1_add)=Arecv(grid1_add) + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid1_centroid_lat(grid1_size) +! zero it out. + DO grid1_add=1,grid1_size + Asend(grid1_add)=zero + Arecv(grid1_add)=zero + END DO +! fill the send for this tile. + DO grid1_add=grid1_str,grid1_end + Asend(grid1_add)=grid1_centroid_lat(grid1_add) + END DO + call mpi_allreduce(Asend, Arecv, grid1_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid1_add=1,grid1_size + grid1_centroid_lat(grid1_add)=Arecv(grid1_add) + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid1_centroid_lon(grid1_size) +! zero it out. + DO grid1_add=1,grid1_size + Asend(grid1_add)=zero + Arecv(grid1_add)=zero + END DO +! fill the send for this tile. + DO grid1_add=grid1_str,grid1_end + Asend(grid1_add)=grid1_centroid_lon(grid1_add) + END DO + call mpi_allreduce(Asend, Arecv, grid1_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid1_add=1,grid1_size + grid1_centroid_lon(grid1_add)=Arecv(grid1_add) + END DO + deallocate(Asend, Arecv) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + allocate (Asend(grid2_size)) + allocate (Arecv(grid2_size)) +! Work on grid2_frac(grid2_size) +! zero it out. + DO grid2_add=1,grid2_size + Asend(grid2_add)=zero + Arecv(grid2_add)=zero + END DO +! fill the send for this tile. + DO grid2_add=1,grid2_size + Asend(grid2_add)=grid2_frac(grid2_add) + END DO + call mpi_allreduce(Asend, Arecv, grid2_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid2_add=1,grid2_size + grid2_frac(grid2_add)=Arecv(grid2_add) + END DO + deallocate(Asend, Arecv) + END IF +#endif + !----------------------------------------------------------------------- ! ! integrate around each cell on grid2 @@ -376,11 +523,29 @@ subroutine remap_conserv(l_master, l_test) call timer_start(2) +#ifdef W3_SCRIPMPI +! +! To do this in mpi, we will just break up the sweep loops into chunks. Then +! gather all of the data at end of each loop so that each proc has a full set of +! data. First we want to determine start and end chunks for this processor. +! + IF (NTPROC.eq.1) THEN + grid2_str=1 + grid2_end=grid2_size + ELSE + ratio=INT(grid2_size/NTPROC) + grid2_str=(IPROC*ratio)+1 + grid2_end=grid2_str+ratio-1 + IF (IPROC+1.eq.NTPROC) grid2_end=grid2_size + END IF +#else + grid2_str=1 + grid2_end=grid2_size +#endif C$OMP PARALLEL DEFAULT(SHARED) PRIVATE(grid2_add) NUM_THREADS(nthreads) C$OMP DO SCHEDULE(DYNAMIC) - - do grid2_add = 1,grid2_size + do grid2_add = grid2_str,grid2_end if (mod(grid2_add,progint) .eq. 0 .and. is_master) then print *, grid2_add,' of ',grid2_size,' cells processed ...' @@ -396,6 +561,367 @@ subroutine remap_conserv(l_master, l_test) call timer_stop(2) + +#ifdef W3_SCRIPMPI + IF (NTPROC.gt.1) THEN +! +! Here we need to gather all the data processed and +! send to each proc so they know the full data set. +! +! grid2 integrate +! + allocate (Asend(grid2_size)) + allocate (Arecv(grid2_size)) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid2_frac(grid2_size) +! zero it out. + DO grid2_add=1,grid2_size + Asend(grid2_add)=zero + Arecv(grid2_add)=zero + END DO +! fill the send for this tile. + DO grid2_add=grid2_str,grid2_end + Asend(grid2_add)=grid2_frac(grid2_add) + END DO + call mpi_allreduce(Asend, Arecv, grid2_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid2_add=1,grid2_size + grid2_frac(grid2_add)=Arecv(grid2_add) + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid2_area(grid2_size) +! zero it out. + DO grid2_add=1,grid2_size + Asend(grid2_add)=zero + Arecv(grid2_add)=zero + END DO +! fill the send for this tile. + DO grid2_add=grid2_str,grid2_end + Asend(grid2_add)=grid2_area(grid2_add) + END DO + call mpi_allreduce(Asend, Arecv, grid2_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid2_add=1,grid2_size + grid2_area(grid2_add)=Arecv(grid2_add) + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid2_centroid_lat(grid2_size) +! zero it out. + DO grid2_add=1,grid2_size + Asend(grid2_add)=zero + Arecv(grid2_add)=zero + END DO +! fill the send for this tile. + DO grid2_add=grid2_str,grid2_end + Asend(grid2_add)=grid2_centroid_lat(grid2_add) + END DO + call mpi_allreduce(Asend, Arecv, grid2_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid2_add=1,grid2_size + grid2_centroid_lat(grid2_add)=Arecv(grid2_add) + END DO +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Work on grid2_centroid_lon(grid2_size) +! zero it out. + DO grid2_add=1,grid2_size + Asend(grid2_add)=zero + Arecv(grid2_add)=zero + END DO +! fill the send for this tile. + DO grid2_add=grid2_str,grid2_end + Asend(grid2_add)=grid2_centroid_lon(grid2_add) + END DO + call mpi_allreduce(Asend, Arecv, grid2_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid2_add=1,grid2_size + grid2_centroid_lon(grid2_add)=Arecv(grid2_add) + END DO + deallocate(Asend, Arecv) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + allocate (Asend(grid1_size)) + allocate (Arecv(grid1_size)) +! Work on grid1_frac(grid1_size) +! zero it out. + DO grid1_add=1,grid1_size + Asend(grid1_add)=zero + Arecv(grid1_add)=zero + END DO +! fill the send for this tile. + DO grid1_add=1,grid1_size + Asend(grid1_add)=grid1_frac(grid1_add) + END DO + call mpi_allreduce(Asend, Arecv, grid1_size, MPI_DOUBLE, & + & MPI_SUM, MPI_COMM_GRD, IERR_MPI) +! fill the working array as a sum from all nodes. + DO grid1_add=1,grid1_size + grid1_frac(grid1_add)=Arecv(grid1_add) + END DO + deallocate(Asend, Arecv) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Both sweeps are now done. +! Here we need to gather all the data that was computed in +! store_link_cnsrv. Then we allow the Master node to +! compute the rest after these steps. +! +! gather total number of links that were computed on each processor. +! + allocate(Numlinks(NTPROC)) + call mpi_gather(num_links_map1, 1, MPI_INT, Numlinks, 1, & + & MPI_INT, 0, MPI_COMM_GRD, IERR_MPI) +! +! Now gather all the weights from other nodes to make one combined set. +! + IF (IPROC.ne.0) THEN + allocate (Asendi(num_links_map1)) + Asendi=0 +! +! Send grid1 add map1. + DO i=1,num_links_map1 + Asendi(i)=grid1_add_map1(i) + END DO + call mpi_send(Asendi, num_links_map1, MPI_INT, 0, & + & 10, MPI_COMM_GRD, IERR_MPI) +! +! Send grid2 add map1. + DO i=1,num_links_map1 + Asendi(i)=grid2_add_map1(i) + END DO + call mpi_send(Asendi, num_links_map1, MPI_INT, 0, & + & 20, MPI_COMM_GRD, IERR_MPI) + deallocate (Asendi) +! +! Send wts map1. + allocate (Asend(num_links_map1*num_wts)) + Asend=0 + ij=0 + DO i=1,num_links_map1 + DO j=1,num_wts + ij=ij+1 + Asend(ij)=wts_map1(j,i) + END DO + END DO + call mpi_send(Asend, num_links_map1*num_wts, MPI_DOUBLE, 0, & + & 30, MPI_COMM_GRD, IERR_MPI) + deallocate (Asend) + ELSE ! we are on the Master + DO i=2,NTPROC + allocate (Arecv1(Numlinks(i))) !grid1_add_map1 + allocate (Arecv2(Numlinks(i))) !grid2_add_map1 + allocate (Arecvw(num_wts*Numlinks(i))) !wts_map1 + allocate (Arecvw2d(num_wts,Numlinks(i))) !wts_map1 + Arecv1=0 + Arecv2=0 + Arecvw=zero + Arecvw2d=zero +! +! Receiving grd1 add map1 (grid1 area). +! + call mpi_recv(Arecv1, Numlinks(i), MPI_INT, i-1, 10, & + & MPI_COMM_GRD, status, IERR_MPI) +! +! Receiving grid2 add map1 (grid2 area). +! + call mpi_recv(Arecv2, Numlinks(i), MPI_INT, i-1, 20, & + & MPI_COMM_GRD, status, IERR_MPI) +! +! Receiving weights map1 +! + call mpi_recv(Arecvw, Numlinks(i)*num_wts, MPI_DOUBLE,i-1, & + & 30, MPI_COMM_GRD, status, IERR_MPI) +! restructure wts to be (1:num_wts,numlinks) + ij=0 + DO nlink=1,Numlinks(i) + DO j=1,num_wts + ij=ij+1 + Arecvw2d(j,nlink)=Arecvw(ij) + END DO + END DO +!----------------------------------------------------------------------- +! +! if the link already exists, add the weight to the current weight +! arrays +! This is taken from subroutine store_link_cnsrv. +!----------------------------------------------------------------------- + DO nlink=1,Numlinks(i) + add1=Arecv1(nlink) + add2=Arecv2(nlink) + got_weight=0 +! + min_link = min(link_add1(1,add1),link_add2(1,add2)) + max_link = max(link_add1(2,add1),link_add2(2,add2)) + if (min_link == 0) then + min_link = 1 + max_link = 0 + endif + do j=min_link,max_link + if (add1 == grid1_add_map1(j)) then + if (add2 == grid2_add_map1(j)) then + wts_map1(:,j)=wts_map1(:,j)+ & + & Arecvw2d(1:num_wts,nlink) + got_weight=1 + endif + endif + end do +!----------------------------------------------------------------------- +! +! if the link does not yet exist, increment number of links and +! check to see if remap arrays need to be increased to accomodate +! the new link. then store the link. +! +!----------------------------------------------------------------------- + if (got_weight.eq.0) then + num_links_map1 = num_links_map1 + 1 + if (num_links_map1 > max_links_map1) & + & call resize_remap_vars(1,resize_increment) + grid1_add_map1(num_links_map1) = add1 + grid2_add_map1(num_links_map1) = add2 + wts_map1 (:,num_links_map1) = Arecvw2d(1:num_wts,nlink) + END IF + + if (link_add1(1,add1)==0) link_add1(1,add1)=num_links_map1 + if (link_add2(1,add2)==0) link_add2(1,add2)=num_links_map1 + link_add1(2,add1) = num_links_map1 + link_add2(2,add2) = num_links_map1 + + END DO + deallocate (Arecv1, Arecv2, Arecvw, Arecvw2d) + END DO + END IF +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! Now distribute: num_links_map1, grid1_add_map1, grid2_add_map1, +! wts_map1, link_add1, link_add2, max_links_map1 +! +! send num_links_map1 +! + call mpi_bcast(num_links_map1, 1, MPI_INT, & + & 0, MPI_COMM_GRD, IERR_MPI) +! force this + max_links_map1=num_links_map1 +! +! here we do what is in resize_remap_vars and just make the +! sizes of grid1_add_map1, grid2_add_map1, and wts_map1 to be +! the same size as on the 0 node. +! + IF (IPROC.ne.0) THEN + deallocate (grid1_add_map1, grid2_add_map1, wts_map1) + allocate ( grid1_add_map1(num_links_map1), & + & grid2_add_map1(num_links_map1), & + & wts_map1(num_wts,num_links_map1)) + END IF + IF (IPROC.eq.0) THEN +! +! Only save the valid parts of grid1_add_map1, grid2_add_map1, wts_map1 +! + allocate (Asendi(num_links_map1)) +! + DO i=1,num_links_map1 + Asendi(i)=grid1_add_map1(i) + END DO + deallocate (grid1_add_map1) + allocate ( grid1_add_map1(num_links_map1) ) + DO i=1,num_links_map1 + grid1_add_map1(i)=Asendi(i) + END DO +! + DO i=1,num_links_map1 + Asendi(i)=grid2_add_map1(i) + END DO + deallocate (grid2_add_map1) + allocate ( grid2_add_map1(num_links_map1) ) + DO i=1,num_links_map1 + grid2_add_map1(i)=Asendi(i) + END DO + deallocate (Asendi) +! + allocate (Arecvw2d(num_wts,num_links_map1)) !wts_map1 + DO i=1,num_links_map1 + DO j=1,num_wts + Arecvw2d(j,i)=wts_map1(j,i) + END DO + END DO + deallocate (wts_map1) + allocate ( wts_map1(num_wts,num_links_map1) ) + DO i=1,num_links_map1 + DO j=1,num_wts + wts_map1(j,i)=Arecvw2d(j,i) + END DO + END DO + deallocate (Arecvw2d) + END IF +! +! send grid1_add_map1 +! + allocate (Asendi(num_links_map1)) + Asendi=0 + IF (IPROC.eq.0) THEN + DO i=1,num_links_map1 + Asendi(i)=grid1_add_map1(i) + END DO + END IF + call mpi_bcast(Asendi, num_links_map1, MPI_INT, & + & 0, MPI_COMM_GRD, IERR_MPI) + IF (IPROC.ne.0) THEN + DO i=1,num_links_map1 + grid1_add_map1(i)=Asendi(i) + END DO + END IF +! +! send grid2_add_map1 +! + Asendi=0 + IF (IPROC.eq.0) THEN + DO i=1,num_links_map1 + Asendi(i)=grid2_add_map1(i) + END DO + END IF + call mpi_bcast(Asendi, num_links_map1, MPI_INT, & + & 0, MPI_COMM_GRD, IERR_MPI) + IF (IPROC.ne.0) THEN + DO i=1,num_links_map1 + grid2_add_map1(i)=Asendi(i) + END DO + END IF + deallocate (Asendi) +! +! send wts_map1 +! + allocate (Asend(num_links_map1*num_wts)) + Asend=zero +! + ij=0 + IF (IPROC.eq.0) THEN + DO i=1,num_links_map1 + DO j=1,num_wts + ij=ij+1 + Asend(ij)=wts_map1(j,i) + END DO + END DO + END IF + ij=num_links_map1*num_wts + call mpi_bcast(Asend, ij, MPI_DOUBLE, & + & 0, MPI_COMM_GRD, IERR_MPI) + IF (IPROC.ne.0) THEN + wts_map1=zero + ij=0 + DO i=1,num_links_map1 + DO j=1,num_wts + ij=ij+1 + wts_map1(j,i)=Asend(ij) + END DO + END DO + END IF + deallocate (Asend) + deallocate(Numlinks) + END IF +#endif !----------------------------------------------------------------------- ! ! correct for situations where N/S pole not explicitly included in diff --git a/model/src/cmake/src_list.cmake b/model/src/cmake/src_list.cmake index d745be388d..317dd5016d 100644 --- a/model/src/cmake/src_list.cmake +++ b/model/src/cmake/src_list.cmake @@ -81,7 +81,7 @@ set(scrip_src ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_interface.F90 ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_iounitsmod.f90 ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_kindsmod.f90 - ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_conservative.f + ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_conservative.F ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_remap_vars.f ${CMAKE_CURRENT_SOURCE_DIR}/SCRIP/scrip_timers.f ) diff --git a/model/src/cmake/switches.json b/model/src/cmake/switches.json index a7b9bc94f9..5431947d41 100644 --- a/model/src/cmake/switches.json +++ b/model/src/cmake/switches.json @@ -43,6 +43,17 @@ } ] }, + { + "name": "scripmpi", + "num_switches": "upto1", + "description": "use MPI parallelism for SCRIP regridding", + "valid-options": [ + { + "name": "SCRIPMPI", + "requires": ["SCRIP", "MPI"] + } + ] + }, { "name": "shared", "num_switches": "one", diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 4b7e1e71ae..bbcb556644 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -171,7 +171,7 @@ echo "$rtst -s PR1 -w work_PR1_f -m grdset_f $ww3 mww3_test_04" >> matrix.body echo "$rtst -s PR1 -w work_PR1_g -m grdset_g $ww3 mww3_test_04" >> matrix.body fi - + fi if [ "$dist" = 'y' ] @@ -225,7 +225,7 @@ echo "$rtst -s PR1_MPI -w work_PR1_MPI_d -m grdset_d -f -p $mpi -n $np $ww3 mww3_test_04" >> matrix.body echo "$rtst -s PR1_MPI -w work_PR1_MPI_e -m grdset_e -f -p $mpi -n $np $ww3 mww3_test_04" >> matrix.body fi - + fi if [ "$prop2D" = 'y' ] && [ "$dist" = 'y' ] @@ -634,6 +634,7 @@ echo ' ' >> matrix.body echo "$rtst -s PR3_UNO_MPI_SCRIP -w work_PR3_UNO_MPI_a_c -m grdset_a -g curv -f -p $mpi -n $np $ww3 mww3_test_02" >> matrix.body echo "$rtst -s PR3_UNO_MPI_SCRIP -w work_PR3_UNO_MPI_b_c -m grdset_b -g curv -f -p $mpi -n $np $ww3 mww3_test_02" >> matrix.body + echo "$rtst -s PR3_UNO_SCRIPMPI -w work_PR3_UNO_SCRIPMPI -m grdset_b -g curv -f -p $mpi -n $np $ww3 mww3_test_02" >> matrix.body echo "$rtst -s PR3_UNO_MPI_SCRIP -w work_PR3_UNO_MPI_c_c -m grdset_c -g curv -f -p $mpi -n $np $ww3 mww3_test_02" >> matrix.body echo "$rtst -s PR3_UNO_MPI_SCRIP -w work_PR3_UNO_MPI_d_c -m grdset_d -g curv -f -p $mpi -n $np $ww3 mww3_test_02" >> matrix.body fi @@ -994,9 +995,9 @@ if [ "$dist" = 'y' ] then -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1007,7 +1008,7 @@ echo "$rtst -s ST1_PR1_MPI -w work_ST1_PR1_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1018,7 +1019,7 @@ echo "$rtst -s ST1_PR2_UQ_MPI -w work_ST1_PR2_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1029,7 +1030,7 @@ echo "$rtst -s ST1_PR2_UNO_MPI -w work_ST1_PR2_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1040,7 +1041,7 @@ echo "$rtst -s ST1_PR3_UQ_MPI -w work_ST1_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1050,9 +1051,9 @@ then echo "$rtst -s ST1_PR3_UNO_MPI -w work_ST1_PR3_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1063,7 +1064,7 @@ echo "$rtst -s ST2_PR1_MPI -w work_ST2_PR1_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1074,7 +1075,7 @@ echo "$rtst -s ST2_PR2_UQ_MPI -w work_ST2_PR2_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1085,7 +1086,7 @@ echo "$rtst -s ST2_PR2_UNO_MPI -w work_ST2_PR2_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1096,7 +1097,7 @@ echo "$rtst -s ST2_PR3_UQ_MPI -w work_ST2_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1106,9 +1107,9 @@ then echo "$rtst -s ST2_PR3_UNO_MPI -w work_ST2_PR3_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1119,7 +1120,7 @@ echo "$rtst -s ST3_PR1_MPI -w work_ST3_PR1_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1130,7 +1131,7 @@ echo "$rtst -s ST3_PR2_UQ_MPI -w work_ST3_PR2_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1141,7 +1142,7 @@ echo "$rtst -s ST3_PR2_UNO_MPI -w work_ST3_PR2_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1152,7 +1153,7 @@ echo "$rtst -s ST3_PR3_UQ_MPI -w work_ST3_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1162,9 +1163,9 @@ then echo "$rtst -s ST3_PR3_UNO_MPI -w work_ST3_PR3_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1177,7 +1178,7 @@ echo "$rtst -s ST4_PR1_MPI -w work_ST4_PR1_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1188,7 +1189,7 @@ echo "$rtst -s ST4_PR2_UQ_MPI -w work_ST4_PR2_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1199,7 +1200,7 @@ echo "$rtst -s ST4_PR2_UNO_MPI -w work_ST4_PR2_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1210,7 +1211,7 @@ echo "$rtst -s ST4_PR3_UQ_MPI -w work_ST4_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1220,9 +1221,9 @@ then echo "$rtst -s ST4_PR3_UNO_MPI -w work_ST4_PR3_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1233,7 +1234,7 @@ echo "$rtst -s ST6_PR1_MPI -w work_ST6_PR1_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1244,7 +1245,7 @@ echo "$rtst -s ST6_PR2_UQ_MPI -w work_ST6_PR2_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1255,7 +1256,7 @@ echo "$rtst -s ST6_PR2_UNO_MPI -w work_ST6_PR2_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1266,7 +1267,7 @@ echo "$rtst -s ST6_PR3_UQ_MPI -w work_ST6_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1277,7 +1278,7 @@ echo "$rtst -s ST6_PR3_UNO_MPI -w work_ST6_PR3_UNO_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - fi @@ -1287,9 +1288,9 @@ if [ "$hybd" = 'y' ] then -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1300,7 +1301,7 @@ echo "$rtst -s ST1_PR1_MPI_OMPH -w work_ST1_PR1_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1311,7 +1312,7 @@ echo "$rtst -s ST1_PR2_UQ_MPI_OMPH -w work_ST1_PR2_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1322,7 +1323,7 @@ echo "$rtst -s ST1_PR2_UNO_MPI_OMPH -w work_ST1_PR2_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1333,7 +1334,7 @@ echo "$rtst -s ST1_PR3_UQ_MPI_OMPH -w work_ST1_PR3_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1343,9 +1344,9 @@ then echo "$rtst -s ST1_PR3_UNO_MPI_OMPH -w work_ST1_PR3_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1356,7 +1357,7 @@ echo "$rtst -s ST2_PR1_MPI_OMPH -w work_ST2_PR1_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1367,7 +1368,7 @@ echo "$rtst -s ST2_PR2_UQ_MPI_OMPH -w work_ST2_PR2_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1378,7 +1379,7 @@ echo "$rtst -s ST2_PR2_UNO_MPI_OMPH -w work_ST2_PR2_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1389,7 +1390,7 @@ echo "$rtst -s ST2_PR3_UQ_MPI_OMPH -w work_ST2_PR3_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1399,9 +1400,9 @@ then echo "$rtst -s ST2_PR3_UNO_MPI_OMPH -w work_ST2_PR3_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1412,7 +1413,7 @@ echo "$rtst -s ST3_PR1_MPI_OMPH -w work_ST3_PR1_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1423,7 +1424,7 @@ echo "$rtst -s ST3_PR2_UQ_MPI_OMPH -w work_ST3_PR2_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1434,7 +1435,7 @@ echo "$rtst -s ST3_PR2_UNO_MPI_OMPH -w work_ST3_PR2_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1445,7 +1446,7 @@ echo "$rtst -s ST3_PR3_UQ_MPI_OMPH -w work_ST3_PR3_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1455,9 +1456,9 @@ then echo "$rtst -s ST3_PR3_UNO_MPI_OMPH -w work_ST3_PR3_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1468,7 +1469,7 @@ echo "$rtst -s ST4_PR1_MPI_OMPH -w work_ST4_PR1_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1479,7 +1480,7 @@ echo "$rtst -s ST4_PR2_UQ_MPI_OMPH -w work_ST4_PR2_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1490,7 +1491,7 @@ echo "$rtst -s ST4_PR2_UNO_MPI_OMPH -w work_ST4_PR2_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1501,7 +1502,7 @@ echo "$rtst -s ST4_PR3_UQ_MPI_OMPH -w work_ST4_PR3_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1511,9 +1512,9 @@ then echo "$rtst -s ST4_PR3_UNO_MPI_OMPH -w work_ST4_PR3_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1524,7 +1525,7 @@ echo "$rtst -s ST6_PR1_MPI_OMPH -w work_ST6_PR1_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1535,7 +1536,7 @@ echo "$rtst -s ST6_PR2_UQ_MPI_OMPH -w work_ST6_PR2_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1546,7 +1547,7 @@ echo "$rtst -s ST6_PR2_UNO_MPI_OMPH -w work_ST6_PR2_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1557,7 +1558,7 @@ echo "$rtst -s ST6_PR3_UQ_MPI_OMPH -w work_ST6_PR3_UQ_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1568,7 +1569,7 @@ echo "$rtst -s ST6_PR3_UNO_MPI_OMPH -w work_ST6_PR3_UNO_MPI_OMPH -m grdset_a -f -p $mpi -n $nr -t $nth $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - fi # Moving grid cases for OpenMP, ww3_ts3 and mww3_test_05 share switches @@ -1577,9 +1578,9 @@ if [ "$omp" = 'y' ] then -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1590,7 +1591,7 @@ echo "$rtst -s ST1_PR1_OMP -w work_ST1_PR1_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1601,7 +1602,7 @@ echo "$rtst -s ST1_PR2_UQ_OMP -w work_ST1_PR2_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1612,7 +1613,7 @@ echo "$rtst -s ST1_PR2_UNO_OMP -w work_ST1_PR2_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1623,7 +1624,7 @@ echo "$rtst -s ST1_PR3_UQ_OMP -w work_ST1_PR3_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1633,9 +1634,9 @@ then echo "$rtst -s ST1_PR3_UNO_OMP -w work_ST1_PR3_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1646,7 +1647,7 @@ echo "$rtst -s ST2_PR1_OMP -w work_ST2_PR1_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1657,7 +1658,7 @@ echo "$rtst -s ST2_PR2_UQ_OMP -w work_ST2_PR2_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1668,7 +1669,7 @@ echo "$rtst -s ST2_PR2_UNO_OMP -w work_ST2_PR2_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1679,7 +1680,7 @@ echo "$rtst -s ST2_PR3_UQ_OMP -w work_ST2_PR3_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1689,9 +1690,9 @@ then echo "$rtst -s ST2_PR3_UNO_OMP -w work_ST2_PR3_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1702,7 +1703,7 @@ echo "$rtst -s ST3_PR1_OMP -w work_ST3_PR1_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1713,7 +1714,7 @@ echo "$rtst -s ST3_PR2_UQ_OMP -w work_ST3_PR2_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1724,7 +1725,7 @@ echo "$rtst -s ST3_PR2_UNO_OMP -w work_ST3_PR2_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1735,7 +1736,7 @@ echo "$rtst -s ST3_PR3_UQ_OMP -w work_ST3_PR3_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1745,9 +1746,9 @@ then echo "$rtst -s ST3_PR3_UNO_OMP -w work_ST3_PR3_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1758,7 +1759,7 @@ echo "$rtst -s ST4_PR1_OMP -w work_ST4_PR1_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1769,7 +1770,7 @@ echo "$rtst -s ST4_PR2_UQ_OMP -w work_ST4_PR2_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1780,7 +1781,7 @@ echo "$rtst -s ST4_PR2_UNO_OMP -w work_ST4_PR2_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1791,7 +1792,7 @@ echo "$rtst -s ST4_PR3_UQ_OMP -w work_ST4_PR3_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1801,9 +1802,9 @@ then echo "$rtst -s ST4_PR3_UNO_OMP -w work_ST4_PR3_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1814,7 +1815,7 @@ echo "$rtst -s ST6_PR1_OMP -w work_ST6_PR1_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1825,7 +1826,7 @@ echo "$rtst -s ST6_PR2_UQ_OMP -w work_ST6_PR2_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1836,7 +1837,7 @@ echo "$rtst -s ST6_PR2_UNO_OMP -w work_ST6_PR2_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1847,7 +1848,7 @@ echo "$rtst -s ST6_PR3_UQ_OMP -w work_ST6_PR3_UQ_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi - if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then + if [ "$hur1mg" = 'y' ] || [ "$multi05" = 'y' ] ; then echo ' ' >> matrix.body ; fi if [ "$hur1mg" = 'y' ] then @@ -1857,13 +1858,13 @@ then echo "$rtst -s ST6_PR3_UNO_OMP -w work_ST6_PR3_UNO_OMP -m grdset_a -f -O -n $np $ww3 mww3_test_05" >> matrix.body fi -# - - - - - - - - - - - - +# - - - - - - - - - - - - fi # Second harmonic test case - if [ "$infgrv" = 'y' ] && [ "$shrd" = 'y' ] + if [ "$infgrv" = 'y' ] && [ "$shrd" = 'y' ] then echo ' ' >> matrix.body echo "$rtst $ww3 -w work_IG1 ww3_tig1.1" >> matrix.body @@ -1987,7 +1988,7 @@ echo "$rtst -s IC1IS2 -w work_IC1IS2_1000 -g 1000m $ww3 ww3_tic1.4" >> matrix.body echo "$rtst -s IC2IS2 -w work_IC2IS2_IC2b -g IC2b_1000m $ww3 ww3_tic1.4" >> matrix.body echo "$rtst -s IC2IS2 -w work_IC2IS2_IC2d -g IC2d_1000m $ww3 ww3_tic1.4" >> matrix.body - echo "$rtst -s IC2IS2 -w work_IC2IS2scat -g scat $ww3 ww3_tic2.3" >> matrix.body + echo "$rtst -s IC2IS2 -w work_IC2IS2scat -g scat $ww3 ww3_tic2.3" >> matrix.body echo "$rtst -s IC2IS2 -w work_IC2IS2creep -g creepOnly $ww3 ww3_tic2.3" >> matrix.body echo "$rtst -s IC2IS2 -w work_IC2IS2dissip -g dissipOnly $ww3 ww3_tic2.3" >> matrix.body fi @@ -2019,7 +2020,7 @@ echo "$rtst -s MPI -s NO_PDLIB -w work_ma -m grdset_a -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_b -g b -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_c -g c -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body - echo "$rtst -s MPI -s PDLIB -w work_pdlib -g pdlib -f -p $mpi -n $np $ww3 ww3_tp2.6" >> matrix.body + echo "$rtst -s MPI -s PDLIB -w work_pdlib -g pdlib -f -p $mpi -n $np $ww3 ww3_tp2.6" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mb -m grdset_b -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mc -m grdset_c -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body if [ "$rstrt_b4b" = 'y' ] @@ -2036,7 +2037,7 @@ fi # unstructured grid with PDLIB for domain decomposition and implicit solver, Neumann Bnd, depth breaking & triad interaction ST - if [ "$pdlib" = 'y' ] && [ "$dist" = 'y' ] + if [ "$pdlib" = 'y' ] && [ "$dist" = 'y' ] then echo ' ' >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_1A_a -f -g a -p $mpi -n $np -o netcdf -i input_Case1A $ww3 ww3_tp2.19" >> matrix.body @@ -2045,23 +2046,23 @@ fi - #Unresolved Obstacles Source Term (UOST) - if [ "$uost" = 'y' ] + #Unresolved Obstacles Source Term (UOST) + if [ "$uost" = 'y' ] then echo ' ' >> matrix.body if [ "$dist" = 'y' ] - then + then echo "$rtst -s MPI -w work_rg_shel_MPI -i input_rg_shel -f -p $mpi -n $np $ww3 ww3_ts4" >> matrix.body echo "$rtst -s MPI -w work_rg_multi_MPI -i input_rg_multi -m grdset -f -p $mpi -n $np $ww3 ww3_ts4" >> matrix.body echo "$rtst -s MPI -w work_ug_MPI -i input_ug -f -p $mpi -n $np $ww3 ww3_ts4" >> matrix.body - else + else echo "$rtst -w work_rg_shel -i input_rg_shel $ww3 ww3_ts4" >> matrix.body echo "$rtst -w work_rg_multi -i input_rg_multi -m grdset $ww3 ww3_ts4" >> matrix.body echo "$rtst -w work_ug -i input_ug $ww3 ww3_ts4" >> matrix.body fi fi - # Global unstructured grid and Unresolved Obstacles Source Term (UOST) + # Global unstructured grid and Unresolved Obstacles Source Term (UOST) if [ "$uost" = 'y' ] && [ "$dist" = 'y' ] then echo ' ' >> matrix.body @@ -2075,7 +2076,7 @@ fi fi - #Test of updating the restart spectra + #Test of updating the restart spectra if [ "$assim" = 'y' ] then echo ' ' >> matrix.body @@ -2095,7 +2096,7 @@ echo "$rtst -s ST4 -w work_UPD6_U_cap -i input_UPD6_U_cap $ww3 ww3_ta1" >> matrix.body fi - #Test of atmosphere, ocean, and ice coupling using OASIS + #Test of atmosphere, ocean, and ice coupling using OASIS if [ "$oasis" = 'y' ] && [ "$dist" = 'y' ] then echo ' ' >> matrix.body @@ -2219,15 +2220,15 @@ fi fi - #Test gint for restarts + #Test gint for restarts if [ "$ufs" = 'y' ] && [ "$grib" = 'y' ] then - echo ' ' >> matrix.body + echo ' ' >> matrix.body echo "$rtst -s MPI_OMPH -w work_c -m grdset_c -f -p $mpi -n $npl -t $nth1 $ww3 ww3_ufs1.2" >> matrix.body echo "mkdir -p ww3_ufs1.2/work_l" >> matrix.body echo "cp ww3_ufs1.2/work_c/restart.hafsl ww3_ufs1.2/work_l/restart.hafsl" >> matrix.body echo "$rtst -s MPI_OMPH -w work_l -m grdset_l -f -p $mpi -n $npl -t $nth1 $ww3 ww3_ufs1.2" >> matrix.body - fi + fi #GEFSv12 setup with ww3_multi and grib2 output diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index d7e05497b9..e5e90c0cd6 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -420,17 +420,20 @@ then cd $path_build if [[ "$outopt" = "all" ]] || [[ "$outopt" = "grib" ]] ; then - cat $file_c | sed 's/DIST/SHRD/' | sed 's/MPI //' | \ + # SCRIPMPI must proceed MPI in both blocks + cat $file_c | sed 's/SCRIPMPI //'| \ + sed 's/DIST/SHRD/' | sed 's/MPI //' | \ sed 's/OMPG //' | sed 's/NOGRB/NCEP2/' | \ sed 's/OMPH //' | sed 's/PDLIB //' | \ sed 's/B4B //' | sed 's/METIS //' | \ - sed 's/SCOTCH //' > $path_build/switch + sed 's/SCOTCH //' > $path_build/switch else - cat $file_c | sed 's/DIST/SHRD/' | sed 's/MPI //' | \ + cat $file_c | sed 's/SCRIPMPI //'| \ + sed 's/DIST/SHRD/' | sed 's/MPI //' | \ sed 's/OMPG //' | \ sed 's/OMPH //' | sed 's/PDLIB //' | \ sed 's/B4B //' | sed 's/METIS //' | \ - sed 's/SCOTCH //' > $path_build/switch + sed 's/SCOTCH //' > $path_build/switch fi echo "Switch file is $path_build/switch with switches:" >> $ofile @@ -444,14 +447,14 @@ then fi make -j 8 VERBOSE=1 >> $ofile 2>&1 rc=$? - if (( rc != 0 )); then + if (( rc != 0 )); then echo "Fatal error in make." echo "The build log is in ${ofile}" exit ${rc} fi make install >> $ofile 2>&1 rc=$? - if (( rc != 0 )); then + if (( rc != 0 )); then echo "Fatal error in make install." echo "The build log is in $ofile" exit ${rc} @@ -519,14 +522,14 @@ else fi make -j 8 VERBOSE=1 >> $ofile 2>&1 rc=$? - if (( rc != 0 )); then + if (( rc != 0 )); then echo "Fatal error in make." echo "The build log is in ${ofile}" exit ${rc} fi make install >> $ofile 2>&1 rc=$? - if (( rc != 0 )); then + if (( rc != 0 )); then echo "Fatal error in make." echo "The build log is in ${ofile}" exit ${rc} diff --git a/regtests/mww3_test_02/info b/regtests/mww3_test_02/info index c4847159f6..0ab120a272 100644 --- a/regtests/mww3_test_02/info +++ b/regtests/mww3_test_02/info @@ -80,21 +80,22 @@ # + switch_PR3_UQ_MPI_SCRIPNC # # + switch_PR3_UNO_MPI_SCRIP_T38 # # + switch_PR3_UQ_MPI_SCRIP_T38 # +# + switch_PR3_UNO_SCRIPMPI : Using SCRIP parallelized with MPI # # # # Example run_test commands: # # (some details will vary by local system and configuration) # -# ./bin/run_test -g curv -m grdset_a -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # +# ./bin/run_test -g curv -m grdset_a -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # # -w work_ap_PR3_MPI_SCRIP ../model mww3_test_02 # -# ./bin/run_test -g curv -m grdset_b -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # +# ./bin/run_test -g curv -m grdset_b -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # # -w work_bp_PR3_MPI_SCRIP ../model mww3_test_02 # -# ./bin/run_test -g curv -m grdset_c -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # +# ./bin/run_test -g curv -m grdset_c -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # # -w work_cp_PR3_MPI_SCRIP ../model mww3_test_02 # -# ./bin/run_test -g curv -m grdset_d -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # +# ./bin/run_test -g curv -m grdset_d -n 3 -p mpirun -s PR3_UQ_MPI_SCRIP \ # # -w work_dp_PR3_MPI_SCRIP ../model mww3_test_02 # # # # Hendrik Tolman, Sep 2005 # # Erick Rogers, Jun 2011 # -# Last Mod : Dec 2013 # +# Last Mod : John Warner, Mar 2025 # # # # Copyright 2009-2013 National Weather Service (NWS), # # National Oceanic and Atmospheric Administration. All rights # diff --git a/regtests/mww3_test_02/input/switch_PR3_UNO_SCRIPMPI b/regtests/mww3_test_02/input/switch_PR3_UNO_SCRIPMPI new file mode 100644 index 0000000000..d86344e900 --- /dev/null +++ b/regtests/mww3_test_02/input/switch_PR3_UNO_SCRIPMPI @@ -0,0 +1 @@ +NOGRB SCRIP DIST MPI PR3 UNO SCRIPMPI FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 From d6c52ea1ccd99a247984d1fb03180ea1fb68e226 Mon Sep 17 00:00:00 2001 From: Saeideh Banihashemi <91982033+sbanihash@users.noreply.github.com> Date: Tue, 29 Apr 2025 11:32:21 -0700 Subject: [PATCH 078/136] Bug fix for #1412 for IC_NUMERICS (#1413) Addition of regtest that turns on the IC_NUMERICS in IC4_M10 test case --- model/inp/ww3_grid.inp | 4 + model/src/w3iogrmd.F90 | 6 +- regtests/bin/matrix.base | 1 + .../input_IC4_M10_icenum/namelists_1-D.nml | 2 + .../input_IC4_M10_icenum/points.list | 16 ++++ .../ww3_tic1.1/input_IC4_M10_icenum/switch | 1 + .../input_IC4_M10_icenum/ww3_grid.inp | 45 +++++++++++ .../input_IC4_M10_icenum/ww3_grid.nml | 81 +++++++++++++++++++ .../input_IC4_M10_icenum/ww3_ounf.inp | 20 +++++ .../input_IC4_M10_icenum/ww3_ounf.nml | 29 +++++++ .../input_IC4_M10_icenum/ww3_outf.inp | 13 +++ .../input_IC4_M10_icenum/ww3_outp_spec.inp | 19 +++++ .../input_IC4_M10_icenum/ww3_outp_tab50.inp | 19 +++++ .../input_IC4_M10_icenum/ww3_outp_tab51.inp | 10 +++ .../input_IC4_M10_icenum/ww3_prep_icecon.inp | 38 +++++++++ .../input_IC4_M10_icenum/ww3_shel.inp | 69 ++++++++++++++++ .../input_IC4_M10_icenum/ww3_strt.inp | 17 ++++ 17 files changed, 387 insertions(+), 3 deletions(-) create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/namelists_1-D.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/points.list create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/switch create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.nml create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outf.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_spec.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab50.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab51.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_prep_icecon.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_shel.inp create mode 100644 regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_strt.inp diff --git a/model/inp/ww3_grid.inp b/model/inp/ww3_grid.inp index b3458402b5..bd6e5a3772 100644 --- a/model/inp/ww3_grid.inp +++ b/model/inp/ww3_grid.inp @@ -501,6 +501,10 @@ $ P2SF : ...... $ CALTYPE: Calendar type. The only accepted $ values are 'standard' (default), $ '365_day', or '360_day'. +$ IC_NUMERICS: Logical variable (T/F). Set to T to +$ allow the user to place the 'sea ice' +$ source terms with other source terms +$ Default is F (PR_1294) $ $ Diagnostic Sea-state Dependent Stress- - - - - - - - - - - - - - - - - $ Reichl et al. 2014 : Namelist FLD1 diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 9f9e8c8db1..338c8ef071 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -899,7 +899,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& - IICEDDISP, IICEFDISP, BTBETA, & + IICEDDISP, IICEFDISP, BTBETA,IC_NUMERICS, & AAIRCMIN, AAIRGB #ifdef W3_ASCII WRITE (NDSA,*) & @@ -915,7 +915,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& - IICEDDISP, IICEFDISP, BTBETA, & + IICEDDISP, IICEFDISP, BTBETA,IC_NUMERICS, & AAIRCMIN, AAIRGB #endif @@ -1060,7 +1060,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FLCTH, FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, & CTHG0S, STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, & IICEDISP, ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, & - IICEDDISP, IICEHDISP, IICEFDISP, BTBETA, & + IICEDDISP, IICEHDISP, IICEFDISP, BTBETA,IC_NUMERICS, & AAIRCMIN, AAIRGB READ(NDSM,END=801,ERR=802,IOSTAT=IERR)GRIDSHIFT diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index bbcb556644..b1dbd29a2e 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -1959,6 +1959,7 @@ echo "$rtst -w work_IC4_M8 -i input_IC4_M8 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -w work_IC4_M9 -i input_IC4_M9 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -w work_IC4_M10 -i input_IC4_M10 $ww3 ww3_tic1.1" >> matrix.body + echo "$rtst -w work_IC4_M10_icenum -i input_IC4_M10_icenum $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M1 -i input_IC5_M1 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M2 -i input_IC5_M2 $ww3 ww3_tic1.1" >> matrix.body echo "$rtst -g 1000m -w work_IC5_M3 -i input_IC5_M3 $ww3 ww3_tic1.1" >> matrix.body diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/namelists_1-D.nml b/regtests/ww3_tic1.1/input_IC4_M10_icenum/namelists_1-D.nml new file mode 100644 index 0000000000..53fac9fd0e --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/namelists_1-D.nml @@ -0,0 +1,2 @@ +&SIC4 IC4METHOD = 10 / +END OF NAMELISTS diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/points.list b/regtests/ww3_tic1.1/input_IC4_M10_icenum/points.list new file mode 100644 index 0000000000..e2a0afe3d4 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/points.list @@ -0,0 +1,16 @@ +0.00 0. 'Point 1 ' +1.00E3 0. 'Point 2 ' +2.00E3 0. 'Point 3 ' +3.00E3 0. 'Point 4 ' +4.00E3 0. 'Point 5 ' +5.00E3 0. 'Point 6 ' +6.00E3 0. 'Point 7 ' +7.00E3 0. 'Point 8 ' +8.00E3 0. 'Point 9 ' +9.00E3 0. 'Point 10 ' +10.00E3 0. 'Point 11 ' +11.00E3 0. 'Point 12 ' +12.00E3 0. 'Point 13 ' +13.00E3 0. 'Point 14 ' +14.00E3 0. 'Point 15 ' +15.00E3 0. 'Point 16 ' diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/switch b/regtests/ww3_tic1.1/input_IC4_M10_icenum/switch new file mode 100644 index 0000000000..31ef85baed --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/switch @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX2 LN0 ST0 NL0 BT0 DB0 TR0 BS0 IC4 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.inp new file mode 100644 index 0000000000..052ef3d4e6 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.inp @@ -0,0 +1,45 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + '1-D parameterized ice test ' +$ +$ 1.1 0.04118 25 24 0.0 + 1.1 0.0418 31 36 5.0 +$ + F T F F F T + 60. 60. 60. 60. +$ +$ IC4METHOD determines calculation +$ IC4METHOD = 1 - Wadhams et al. (1988) +$ IC4METHOD = 2 - Meylan et al. (2014) +$ IC4METHOD = 3 - Kohout & Meylan (2008) in Horvat & Tziperman (2015) +$ IC4METHOD = 4 - Kohout et al. (2014) +$ IC4METHOD = 5 - Simple ki step function +$ IC4METHOD = 6 - Simple ki step function via namelist +$ IC4METHOD = 7 - Doble et al. (GRL 2015) +$ IC4METHOD = 8 - Meylan et al. (2018) ; Liu et al. (2020) +$ IC4METHOD = 9 - RYW (2021) ; Yu et al. (2022) +$ IC4M8 Fit to R21A L ChfM2=0.059 +$ IC4M10 + &SIC4 IC4METHOD = 10 , IC4CN = 0.059/ +$ IC_NUMERICS + &MISC ICNUMERICS = T/ +END OF NAMELISTS +$ + 'RECT' F 'NONE' + 156 3 + 1.0E3 1.0E3 1. + -1.0E3 -1.0E3 1. +$ dlim dmin file# scale layout# format# formatdescrip filetype# filenm + -0.1 0.1 401 -1.0 1 1 '(....)' 'NAME' '../input_IC1/depth1d.flat' +$ + 10 1 1 '(....)' 'PART' 'input' +$ +$ First grid +$ + 2 2 F +$ + 0 0 F + 0 0 F + 0 0 +$ + 0. 0. 0. 0. 0 diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.nml b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.nml new file mode 100644 index 0000000000..e3f8dd58a7 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_grid.nml @@ -0,0 +1,81 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.0418 + SPECTRUM%NK = 31 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 5.0 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 60. + TIMESTEPS%DTXY = 60. + TIMESTEPS%DTKTH = 60. + TIMESTEPS%DTMIN = 60. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = '1-D parameterized ice test' + GRID%NML = '../input_IC4_M10/namelists_1-D.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'CART' + GRID%CLOS = 'NONE' + GRID%ZLIM = -0.1 + GRID%DMIN = 0.1 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 156 + RECT%NY = 3 + RECT%SX = 1.0E3 + RECT%SY = 1.0E3 + RECT%X0 = -1.0E3 + RECT%Y0 = -1.0E3 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -1.0 + DEPTH%FILENAME = '../input_IC1/depth1d.flat' +/ + +! -------------------------------------------------------------------- ! +! Define the input boundary points via INBND_COUNT_NML and +! INBND_POINT_NML namelist +! -------------------------------------------------------------------- ! +&INBND_COUNT_NML + INBND_COUNT%N_POINT = 1 +/ + +&INBND_POINT_NML + INBND_POINT(1) = 2 2 F +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.inp new file mode 100644 index 0000000000..4104d759ea --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.inp @@ -0,0 +1,20 @@ +$ WAVEWATCH III Grid output post-processing (netcdf) +$--------------------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 4 + 0 1 2 + F + ww3. + 4 + 1 999 1 999 3 2 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.nml b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.nml new file mode 100644 index 0000000000..46aa758fac --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_ounf.nml @@ -0,0 +1,29 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '19680606 000000' + FIELD%TIMESTRIDE = '3600.' + FIELD%TIMECOUNT = '99' + FIELD%TIMESPLIT = 4 + FIELD%LIST = 'DPT WLV HS DIR' + FIELD%PARTITION = '0 1 2' + FIELD%SAMEFILE = F + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%IXN = 999 + FILE%IYN = 999 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outf.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outf.inp new file mode 100644 index 0000000000..2b4c6bca80 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outf.inp @@ -0,0 +1,13 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 19680606 000000 3600. 99 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT WLV HS DIR +$ + 3 0 +$ + 1 999 1 999 1 1 diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_spec.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_spec.inp new file mode 100644 index 0000000000..b500e0ca4d --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_spec.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 120000 3600. 1 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 1 + 2 -1. 0. 33 F diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab50.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab50.inp new file mode 100644 index 0000000000..826bd422d5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab50.inp @@ -0,0 +1,19 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 600. 9999 +$ + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + -1 +$ + 2 + 2 50 diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab51.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab51.inp new file mode 100644 index 0000000000..e54faed463 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_outp_tab51.inp @@ -0,0 +1,10 @@ +$ WAVEWATCH III Point output post-processing +$ ------------------------------------------ + 19680606 000000 900. 49 +$ +$ 1 + 11 + -1 +$ + 2 + 2 51 diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_prep_icecon.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_prep_icecon.inp new file mode 100644 index 0000000000..26a94221f5 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_prep_icecon.inp @@ -0,0 +1,38 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : IC1, IC2, IC3, IC4, IC5 => Ice parameters (5) +$ MDN => Mud densities +$ MTH => Mud thicknesses +$ MVS => Mud viscosities +$ ICE => Ice concentrations. +$ LEV => Water levels. +$ WND => Winds. +$ WNS => Winds (including air-sea temp. dif.) +$ CUR => Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ Header flag : If true, write header on "*.ww3" data file +$ + 'ICE' 'AI' T T +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 000000 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F6.2))' + 2345 '../input_IC2_nondisp/icecon.156x3.txt' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_shel.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_shel.inp new file mode 100644 index 0000000000..2be39573e7 --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_shel.inp @@ -0,0 +1,69 @@ +$ WAVEWATCH III shell input file +$ ------------------------------ + T T Ice parameter 1 + F F Ice parameter 2 + F F Ice parameter 3 + F F Ice parameter 4 + T T Ice parameter 5 + F F Mud parameter 1 + F F Mud parameter 2 + F F Mud parameter 3 + F F Water levels + F F Currents + F F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 19680606 000000 + 19680606 120000 +$ + 1 +$ + 19680606 000000 900 19680606 120000 +N +$ Options: DPT CUR WND DT WLV ICE HS L T02 T01 TM1 FP DIR SPR DP EF +$ TH1M STH1M PHS PTP PLP PDIR PSP WSF TWS PNR UST CHA CGE FAW +$ TAW TWA WCC WCF WCH WCM SXY TWO BHD FOC TUS USS P2S WN USF +$ P2L ABR UBR BED FBB TBB MSS MSC DTD FCT CFX CFT CFK US1 US2 +DPT HS ICE DIR EF + 19680606 000000 900 19680606 120000 + 0.00 0. 'Point 1 ' + 1.00E3 0. 'Point 2 ' + 2.00E3 0. 'Point 3 ' + 3.00E3 0. 'Point 4 ' + 4.00E3 0. 'Point 5 ' + 5.00E3 0. 'Point 6 ' + 6.00E3 0. 'Point 7 ' + 7.00E3 0. 'Point 8 ' + 8.00E3 0. 'Point 9 ' + 9.00E3 0. 'Point 10 ' + 10.00E3 0. 'Point 11 ' + 11.00E3 0. 'Point 12 ' + 12.00E3 0. 'Point 13 ' + 13.00E3 0. 'Point 14 ' + 14.00E3 0. 'Point 15 ' + 15.00E3 0. 'Point 16 ' + 0. 0. 'STOPSTRING' + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 + 19680606 000000 0 19680606 120000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ constant case: +$ Meylan et al. (2014) pg 5050 : a=2.12e-3 and b=4.59e-2 + 'IC1' 19680606 000000 0.2 + 'IC5' 19680606 000000 4.59E-2 + 'STP' +$ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_strt.inp b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_strt.inp new file mode 100644 index 0000000000..49747e41af --- /dev/null +++ b/regtests/ww3_tic1.1/input_IC4_M10_icenum/ww3_strt.inp @@ -0,0 +1,17 @@ +$ WAVEWATCH III Initial conditions input file +$ ------------------------------------------- + 2 +$ 0.1 0.0001 225. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 315. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 240. 2 0. -5.E3 0. 5.E3 1.0 +$ fp sip thm ncos xm six ym siy hmax +$ 0.1 0.0001 270. 12 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 270. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 300. 2 0. -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 135. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 45. 12 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 120. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ 0.1 0.0001 60. 2 50.E3 -5.E3 0. 5.E3 1.0 +$ +$ alpha fp thm gamma sigA sigB xm six ym siy + 0.0081 0.1 270.0 1.0 0.07 0.09 0. -5.E3 0. 5.E3 From 3e94f856c390ecc4e63162ff3ada5cd740f76aa9 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Thu, 15 May 2025 08:09:39 -0400 Subject: [PATCH 079/136] Define ETOT and FMEAN2 in double precision and use single precision CBJ (#1427) in w3sdb1md to resolve type conversion warnings for GNU 13.3. Remove unused variables local to subroutine w3sdb1 Co-authored-by: Denise Worthen --- model/src/w3sdb1md.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index 7b4c0ce024..0e0c09e809 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -187,7 +187,7 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) USE W3ODATMD, ONLY: NDST USE W3GDATMD, ONLY: SIG USE W3ODATMD, only : IAPROC - USE W3PARALL, only : THR + USE W3PARALL, only : THR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -219,8 +219,8 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) INTEGER, SAVE :: IENT = 0 #endif REAL*8 :: HM, BB, ARG, Q0, QB, B, CBJ, HRMS, EB(NK) - REAL*8 :: AUX, CBJ2, RATIO, S0, S1, BR1, BR2, FAK - REAL :: ETOT, FMEAN2 + REAL*8 :: FAK + REAL*8 :: ETOT, FMEAN2 #ifdef W3_T0 REAL :: DOUT(NK,NTH) #endif @@ -323,7 +323,7 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) ELSE CBJ = 0.d0 ENDIF - D = - CBJ + D = real(- CBJ, 4) S = D * A ELSE IF (IWB == 2) THEN IF (ETOT .GT. THR) THEN @@ -333,7 +333,7 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) ELSE CBJ = 0. ENDIF - D = - CBJ + D = real(- CBJ, 4) S = D * A ENDIF From 93ee1030de7bbdd9b678700499d6e194cfd2946f Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Mon, 19 May 2025 09:59:14 -0400 Subject: [PATCH 080/136] develop: Fix hang bug by updating MPI bcast to be from 0 not IAPROC-1 (#1430) * fix hang in wave model initialization * remove tabs --- model/src/w3iopomd.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 7d1b05ec0d..07038fb7de 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -607,16 +607,16 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) ! Broadcast weight info to all MPI tasks: !First broadcast NOPTS, used in the next calls: - CALL MPI_BCAST(NOPTS,1,MPI_INTEGER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(NOPTS,1,MPI_INTEGER,0,MPI_COMM_IOPP,IERR_MPI) CALL MPI_Barrier(MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(PTLOC,2*NPT,MPI_REAL,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(PTIFAC,4*NPT,MPI_REAL,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) - CALL MPI_BCAST(IPTINT(:,:,1:NOPTS),2*4*NOPTS,MPI_INTEGER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTLOC,2*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTIFAC,4*NPT,MPI_REAL,0,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(IPTINT(:,:,1:NOPTS),2*4*NOPTS,MPI_INTEGER,0,MPI_COMM_IOPP,IERR_MPI) !Send point names individually DO IPT=1, NOPTS - CALL MPI_BCAST(PTNME(IPT),40,MPI_CHARACTER,IAPROC-1,MPI_COMM_IOPP,IERR_MPI) + CALL MPI_BCAST(PTNME(IPT),40,MPI_CHARACTER,0,MPI_COMM_IOPP,IERR_MPI) ENDDO CALL MPI_Barrier(MPI_COMM_IOPP,IERR_MPI) @@ -2295,8 +2295,8 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ! IF (LEN_TRIM(FNMPNT) .EQ. 0) THEN FNMPRE_LOCAL = FNMPRE - ELSE - FNMPRE_LOCAL = FNMPNT + ELSE + FNMPRE_LOCAL = FNMPNT END IF ! From 5e7a41ae87384ead72a3634a51477432df840a57 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Tue, 20 May 2025 19:24:31 +0200 Subject: [PATCH 081/136] correct bottom friction computation in BT4 based on CREST model formula (#1435) --- model/src/w3gridmd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index c094bd218f..7ccd66427c 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -5620,7 +5620,7 @@ SUBROUTINE W3GRID() ! Threshold of sed. motion in coastal environments, Proc. Pacific Coasts and ! ports, 1997 conference, Christchurch, p149-154, University of Cantebury, NZ SED_DSTAR=(GRAV*(SED_SG-1)/nu_water**2)**(0.333333)*SED_D50(ISEA) - SED_PSIC(ISEA)=0.3/(1+1.2*SED_DSTAR)+0.55*(1-exp(-0.02*SED_DSTAR)) + SED_PSIC(ISEA)=0.3/(1+1.2*SED_DSTAR)+0.055*(1-exp(-0.02*SED_DSTAR)) #endif From 351119beb9c01edd15a6aac3d942057006d4cd1f Mon Sep 17 00:00:00 2001 From: "Max H. Balsmeier" Date: Thu, 22 May 2025 16:47:57 +0200 Subject: [PATCH 082/136] MPI flags always added when OASIS is compiled (#1437) --- model/src/CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/model/src/CMakeLists.txt b/model/src/CMakeLists.txt index 4710576a51..73ccc4ffd8 100644 --- a/model/src/CMakeLists.txt +++ b/model/src/CMakeLists.txt @@ -105,6 +105,8 @@ set(netcdf_programs ww3_ounf ww3_ounp ww3_bounc ww3_trnc ww3_prnc) if("OASIS" IN_LIST switches) find_package(OASIS REQUIRED) target_link_libraries(ww3_lib PUBLIC OASIS::OASIS) + find_package(MPI REQUIRED COMPONENTS Fortran) + target_link_libraries(ww3_lib PUBLIC MPI::MPI_Fortran) endif() if(NETCDF) From f27fe037fbe3d594b21dfb87435c127427d48468 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Tue, 27 May 2025 16:01:52 +0200 Subject: [PATCH 083/136] correction of lambda computation (#1439) --- model/src/w3src4md.F90 | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index dcf1e58083..0d20f9e29f 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -2229,19 +2229,17 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & DO ITH=1,NTH IS=ITH+(IK-1)*NTH MSSLONG = K(IK)**SSDSC(20) * A(IS) * DDEN(IK) / CG(IK) ! contribution to MSS - MSSPC2 = MSSPC2 +MSSLONG*EC2(ITH) - MSSPS2 = MSSPS2 +MSSLONG*ES2(ITH) - MSSPCS = MSSPCS +MSSLONG*ESC(ITH) + MSSPC2 = MSSPC2 +MSSLONG*ECOS(ITH) + MSSPS2 = MSSPS2 +MSSLONG*ESIN(ITH) MSSP = MSSP +MSSLONG END DO MSSSUM (IK:NK,1) = MSSSUM (IK:NK,1) +MSSP MSSSUM (IK:NK,3) = MSSSUM (IK:NK,3) +MSSPC2 MSSSUM (IK:NK,4) = MSSSUM (IK:NK,4) +MSSPS2 - MSSSUM (IK:NK,5) = MSSSUM (IK:NK,5) +MSSPCS ! ! Direction of long wave mss summed up to IK ! - MSSD=0.5*(ATAN2(2*MSSSUM(IK,5),MSSSUM(IK,3)-MSSSUM(IK,4))) + MSSD=ATAN2(MSSSUM(IK,4),MSSSUM(IK,3)) IF (MSSD.LT.0) MSSD = MSSD + PI MSSSUM (IK,2) = MSSD END DO @@ -2476,7 +2474,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! ! directional saturation I ! integrate in azimuth - KO=(GRAV/(1E-6+USTAR**2))/(28./SSDSC(16))**2 + KO=(GRAV/(USTAR**2))/(28./SSDSC(16))**2 DO IK=1,NK IS0=(IK-1)*NTH KLOC=K(IK)**(2-SSDSC(20)) ! local wavenumber factor, if mss not used. @@ -2503,16 +2501,14 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & /(SSDSC(13)+1)*LMODULATION(1:NTH) ! Breaking strength : generalisation of Duncan's b parameter BTOVER = SQRT(BTH0(IK))-SQRT(SSDSBT) - BRM12(IK)=SSDSC(2)*(MAX(0.,BTOVER))**(2.5)/SIG(IK) ! not function of direction + BRM12(IK)=SSDSC(2)*(MAX(0.,BTOVER))**(2.5) ! not function of direction ! For consistency set BRLAMBDA set to zero if b is zero BRLAMBDA(IS0+1:IS0+NTH)= MAX(0.,SIGN(BRLAMBDA(IS0+1:IS0+NTH),BTOVER)) ! Source term / sig2 (action dissipation) - SRHS(IS0+1:IS0+NTH)= BRM12(IK)/GRAV**2*BRLAMBDA(IS0+1:IS0+NTH)*C**5 + SRHS(IS0+1:IS0+NTH)= BRM12(IK)/GRAV**2*BRLAMBDA(IS0+1:IS0+NTH)*C**5/SIG(IK) ! diagonal DDIAG(IS0+1:IS0+NTH) = SRHS(IS0+1:IS0+NTH)*SSDSBR/MAX(1.e-20,BTH(1:NTH))/MAX(1e-20,A(IS0+1:IS0+NTH)) ! END DO - ! Breaking probability (Is actually the breaking rate) - PB = BRLAMBDA *C ! END SELECT !############################################################################################" @@ -2582,21 +2578,22 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! ! precomputes integration of Lambda over direction ! times wavelength times a (a=5 in Reul&Chapron JGR 2003) times dk - ! + ! Romero 2019 - whitecap coverate (COEF4), and air entrainment rate Va (output as wcm) (COEF5) DO IK=1,MIN(FLOOR(AAIRCMIN),NK) C=SIG(IK)/K(IK) IS0=(IK-1)*NTH COEF4(IK) = C*C*SUM(BRLAMBDA(IS0+1:IS0+NTH)) & *2.*PI/GRAV*SSDSC(7) * DDEN(IK)/(SIG(IK)*CG(IK)) + ! BRM12 for dissipation needs to be reformulated ( and positive) to the power of 3/2 (Deike et. al 2017; GRL) COEF5(IK) = C**3*SUM(BRLAMBDA(IS0+1:IS0+NTH) & - *BRM12(IK)) & + *(-1.*SSDSC(2))*(BRM12(IK)/SSDSC(2))**(3./5.)) & *AAIRGB/GRAV * DDEN(IK)/(SIG(IK)*CG(IK)) ! COEF4(IK) = SUM(BRLAMBDA((IK-1)*NTH+1:IK*NTH) * DTH) *(2*PI/K(IK)) * & ! SSDSC(7) * DDEN(IK)/(DTH*SIG(IK)*CG(IK)) ! NB: SSDSC(7) is WHITECAPWIDTH END DO ! Need to extrapolate above NK if necessary ... to be added later. - DO IK=MIN(FLOOR(AAIRCMIN),NK),NK + DO IK=MIN(FLOOR(AAIRCMIN),NK)+1,NK ! +1 otherwise affects the resolved values. COEF4(IK)=0. COEF5(IK)=0. END DO From 0a0fccb740be3b20a57d888188893d581203ab87 Mon Sep 17 00:00:00 2001 From: "Max H. Balsmeier" Date: Wed, 28 May 2025 16:44:11 +0200 Subject: [PATCH 084/136] Changed order of statements in CMakeLists.txt (#1440) Avoided 'DSO missing from command line' error during the linking step through changing the order of compilation flags --- model/src/CMakeLists.txt | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/model/src/CMakeLists.txt b/model/src/CMakeLists.txt index 73ccc4ffd8..bf530276ef 100644 --- a/model/src/CMakeLists.txt +++ b/model/src/CMakeLists.txt @@ -152,11 +152,6 @@ if("OMPG" IN_LIST switches) target_link_libraries(ww3_lib PUBLIC OpenMP::OpenMP_Fortran) endif() -if("MPI" IN_LIST switches) - find_package(MPI REQUIRED COMPONENTS Fortran) - target_link_libraries(ww3_lib PUBLIC MPI::MPI_Fortran) -endif() - # Handle PDLIB, SCRIP, SCRIPNC build files directly instead of through configuration file if("PDLIB" IN_LIST switches) if("SCOTCH" IN_LIST switches) @@ -172,6 +167,11 @@ elseif("METIS" IN_LIST switches) endif() endif() +if("MPI" IN_LIST switches) + find_package(MPI REQUIRED COMPONENTS Fortran) + target_link_libraries(ww3_lib PUBLIC MPI::MPI_Fortran) +endif() + if("SCRIP" IN_LIST switches) target_sources(ww3_lib PRIVATE ${scrip_src}) endif() From e88ae71992409a939d6b3d89cb159ba19f5b2594 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Thu, 29 May 2025 14:15:50 +0200 Subject: [PATCH 085/136] correct field exchange for air density if provided as homogeneous input field (#1438) --- model/src/w3fldsmd.F90 | 9 ++ regtests/bin/matrix.base | 1 + regtests/ww3_tp2.15/info | 7 +- .../input_const/namelists_ADRIATIC.nml | 5 + regtests/ww3_tp2.15/input_const/points.list | 1 + regtests/ww3_tp2.15/input_const/switch | 1 + regtests/ww3_tp2.15/input_const/switch_MPI | 1 + regtests/ww3_tp2.15/input_const/switch_ST4 | 1 + regtests/ww3_tp2.15/input_const/switch_ST6 | 1 + regtests/ww3_tp2.15/input_const/ww3_grid.inp | 33 +++++ regtests/ww3_tp2.15/input_const/ww3_grid.nml | 88 +++++++++++++ regtests/ww3_tp2.15/input_const/ww3_ounf.inp | 21 ++++ regtests/ww3_tp2.15/input_const/ww3_ounf.nml | 25 ++++ .../ww3_tp2.15/input_const/ww3_ounp_par.inp | 118 ++++++++++++++++++ .../ww3_tp2.15/input_const/ww3_ounp_par.nml | 47 +++++++ .../ww3_tp2.15/input_const/ww3_ounp_spec.inp | 118 ++++++++++++++++++ .../ww3_tp2.15/input_const/ww3_ounp_spec.nml | 45 +++++++ regtests/ww3_tp2.15/input_const/ww3_outf.inp | 10 ++ .../ww3_tp2.15/input_const/ww3_prnc_WND.inp | 52 ++++++++ .../ww3_tp2.15/input_const/ww3_prnc_WND.nml | 27 ++++ regtests/ww3_tp2.15/input_const/ww3_shel.inp | 54 ++++++++ regtests/ww3_tp2.15/input_const/ww3_shel.nml | 78 ++++++++++++ regtests/ww3_tp2.15/input_const/ww3_strt.inp | 7 ++ 23 files changed, 748 insertions(+), 2 deletions(-) create mode 100644 regtests/ww3_tp2.15/input_const/namelists_ADRIATIC.nml create mode 100644 regtests/ww3_tp2.15/input_const/points.list create mode 100644 regtests/ww3_tp2.15/input_const/switch create mode 100644 regtests/ww3_tp2.15/input_const/switch_MPI create mode 100644 regtests/ww3_tp2.15/input_const/switch_ST4 create mode 100644 regtests/ww3_tp2.15/input_const/switch_ST6 create mode 100644 regtests/ww3_tp2.15/input_const/ww3_grid.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_grid.nml create mode 100644 regtests/ww3_tp2.15/input_const/ww3_ounf.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_ounf.nml create mode 100644 regtests/ww3_tp2.15/input_const/ww3_ounp_par.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_ounp_par.nml create mode 100644 regtests/ww3_tp2.15/input_const/ww3_ounp_spec.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_ounp_spec.nml create mode 100644 regtests/ww3_tp2.15/input_const/ww3_outf.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_prnc_WND.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_prnc_WND.nml create mode 100644 regtests/ww3_tp2.15/input_const/ww3_shel.inp create mode 100644 regtests/ww3_tp2.15/input_const/ww3_shel.nml create mode 100644 regtests/ww3_tp2.15/input_const/ww3_strt.inp diff --git a/model/src/w3fldsmd.F90 b/model/src/w3fldsmd.F90 index dbd0dae53e..fa26467bb5 100644 --- a/model/src/w3fldsmd.F90 +++ b/model/src/w3fldsmd.F90 @@ -2324,6 +2324,15 @@ SUBROUTINE W3FLDH (J, NDST, NDSE, MX, MY, NX, NY, T0, TN, & END DO #ifdef W3_T WRITE (NDST,9020) +#endif + ELSE IF ( J .EQ. 6 ) THEN + DO IX=1, NX + DO IY=1, NY + FS0(IX,IY) = FSN(IX,IY) + END DO + END DO +#ifdef W3_T + WRITE (NDST,9020) #endif END IF #ifdef W3_T diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index b1dbd29a2e..c4eea304c9 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -720,6 +720,7 @@ echo "$rtst -s PR3_UQ -w work_PR3_UQ $ww3 ww3_tp2.13" >> matrix.body echo "$rtst -w work_PR3_UQ $ww3 ww3_tp2.15" >> matrix.body echo "$rtst -w work_5km -g 5km $ww3 ww3_tp2.15" >> matrix.body + echo "$rtst -i input_const -w work_PR3_UQ_CONST $ww3 ww3_tp2.15" >> matrix.body echo "$rtst -i input_rho -w work_PR3_UQ_RHO $ww3 ww3_tp2.15" >> matrix.body echo "$rtst -s ST4 -i input_rho -w work_ST4FLX5 $ww3 ww3_tp2.15" >> matrix.body echo "$rtst -s ST6 -i input_rho -w work_ST6FLX5 $ww3 ww3_tp2.15" >> matrix.body diff --git a/regtests/ww3_tp2.15/info b/regtests/ww3_tp2.15/info index acee860aea..02af08fa6e 100644 --- a/regtests/ww3_tp2.15/info +++ b/regtests/ww3_tp2.15/info @@ -55,8 +55,11 @@ # -o netcdf -N ../model ww3_tp2.15 # # # # Run using FLX5 # -# ./bin/run_test -i input_rho -s ST6 -w work_ST6FLX5 ../model ww3_tp2.15 # -# ./bin/run_test -i input_rho -s ST4 -w work_ST4FLX5 ../model ww3_tp2.15 # +# ./bin/run_test -i input_rho -s ST6 -w work_ST6FLX5 ../model ww3_tp2.15 # +# ./bin/run_test -i input_rho -s ST4 -w work_ST4FLX5 ../model ww3_tp2.15 # +# # +# Run using homogeneous RHO and TAU input fields # +# ./bin/run_test -i input_const -w work_CONST ../model ww3_tp2.15 # # # # A matlab script is provided in the input directory: extract_AA_STE.m # # which computes STE parameters at the location of the Acqua Alta # diff --git a/regtests/ww3_tp2.15/input_const/namelists_ADRIATIC.nml b/regtests/ww3_tp2.15/input_const/namelists_ADRIATIC.nml new file mode 100644 index 0000000000..f28f4cc6db --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/namelists_ADRIATIC.nml @@ -0,0 +1,5 @@ +&SIN4 BETAMAX = 1.33, Z0MAX = 0.002 / +&SDS4 SDSBCHOICE = 1, FXFM3=2.5, SDSBR = 0.00085, SDSCUM = 0.0 / +&SNL1 NLPROP = 2.7E7 / +&MISC STDX = 11.2, STDY = 11.2, STDT = 1800., FLAGTR = 4 / +END OF NAMELISTS diff --git a/regtests/ww3_tp2.15/input_const/points.list b/regtests/ww3_tp2.15/input_const/points.list new file mode 100644 index 0000000000..b5a4ba4ce3 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/points.list @@ -0,0 +1 @@ +12.5088 45.3138 'AA ' diff --git a/regtests/ww3_tp2.15/input_const/switch b/regtests/ww3_tp2.15/input_const/switch new file mode 100644 index 0000000000..78bc1388fc --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/switch @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_tp2.15/input_const/switch_MPI b/regtests/ww3_tp2.15/input_const/switch_MPI new file mode 100644 index 0000000000..2016e1ae1f --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/switch_MPI @@ -0,0 +1 @@ +NOGRB DIST MPI PR3 UQ FLX0 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_tp2.15/input_const/switch_ST4 b/regtests/ww3_tp2.15/input_const/switch_ST4 new file mode 100644 index 0000000000..d8f1dbdad1 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/switch_ST4 @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX5 LN1 ST4 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_tp2.15/input_const/switch_ST6 b/regtests/ww3_tp2.15/input_const/switch_ST6 new file mode 100644 index 0000000000..d99342ed9c --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/switch_ST6 @@ -0,0 +1 @@ +NOGRB SHRD PR3 UQ FLX5 LN1 ST6 NL1 BT1 DB1 TR0 BS0 IC0 IS0 REF0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 O10 O11 diff --git a/regtests/ww3_tp2.15/input_const/ww3_grid.inp b/regtests/ww3_tp2.15/input_const/ww3_grid.inp new file mode 100644 index 0000000000..81d2759630 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_grid.inp @@ -0,0 +1,33 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + 'ADRIATIC SEA 15km LAMBERT CONFORMAL ' +$ + 1.1 0.05 40 36 .5 +$ + F T T T F T +$ + 900. 450. 450. 5. +$ + &SIN4 BETAMAX = 1.33, Z0MAX = 0.002 / + &SDS4 SDSBCHOICE = 1, FXFM3=2.5, SDSBR = 0.00085, SDSCUM = 0.0 / + &SNL1 NLPROP = 2.7E7 / + &MISC STDX = 11.2, STDY = 11.2, STDT = 1800., FLAGTR = 4 / +END OF NAMELISTS +$ + 'CURV' T 'NONE' + 43 42 +$ Longitudes for GLW CURV grid + 41 1. 0. 1 1 '(...)' 'NAME' '../input/lon_ste_adri_15km.dat' +$ Latitudes for GLW CURV grid + 42 1. 0. 1 1 '(...)' 'NAME' '../input/lat_ste_adri_15km.dat' +$ Bottom Bathymetry + -0.10 2.50 43 0.001000 1 1 '(....)' 'NAME' '../input/ste_adri_15km_etopo1.depth' +$ Sub-grid information + 44 0.010000 1 1 '(...)' 'NAME' '../input/ste_adri_15km_etopo1.obstr' +$ + 45 1 1 '(...)' 'NAME' '../input/ste_adri_15km_etopo1.mask' +$ + 0. 0. 0. 0. 0 +$ +$ End of input file + diff --git a/regtests/ww3_tp2.15/input_const/ww3_grid.nml b/regtests/ww3_tp2.15/input_const/ww3_grid.nml new file mode 100644 index 0000000000..bbb3894d31 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_grid.nml @@ -0,0 +1,88 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.05 + SPECTRUM%NK = 40 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = .5 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLCTH = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 900. + TIMESTEPS%DTXY = 450. + TIMESTEPS%DTKTH = 450. + TIMESTEPS%DTMIN = 5. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'ADRIATIC SEA 15km LAMBERT CONFORMAL' + GRID%NML = '../input_rho/namelists_ADRIATIC.nml' + GRID%TYPE = 'CURV' + GRID%COORD = 'SPHE' + GRID%CLOS = 'NONE' + GRID%ZLIM = -0.10 + GRID%DMIN = 2.50 +/ + +! -------------------------------------------------------------------- ! +! Define the curvilinear grid type via CURV_NML namelist +! -------------------------------------------------------------------- ! +&CURV_NML + CURV%NX = 43 + CURV%NY = 42 + CURV%XCOORD%FILENAME = '../input/lon_ste_adri_15km.dat' + CURV%XCOORD%FORMAT = '(...)' + CURV%YCOORD%FILENAME = '../input/lat_ste_adri_15km.dat' + CURV%YCOORD%FORMAT = '(...)' +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = 0.001000 + DEPTH%FILENAME = '../input/ste_adri_15km_etopo1.depth' +/ + +! -------------------------------------------------------------------- ! +! Define the point status map via MASK_NML namelist +! -------------------------------------------------------------------- ! +&MASK_NML + MASK%FILENAME = '../input/ste_adri_15km_etopo1.mask' + MASK%FORMAT = '(...)' +/ + +! -------------------------------------------------------------------- ! +! Define the obstruction map via OBST_NML namelist +! -------------------------------------------------------------------- ! +&OBST_NML + OBST%SF = 0.010000 + OBST%FILENAME = '../input/ste_adri_15km_etopo1.obstr' + OBST%FORMAT = '(...)' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.15/input_const/ww3_ounf.inp b/regtests/ww3_tp2.15/input_const/ww3_ounf.inp new file mode 100644 index 0000000000..564610663d --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_ounf.inp @@ -0,0 +1,21 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 20140309 000000 900. 9999 +$ +N +HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK +$ +$ + 3 4 + 0 1 2 + T +$ +$ -------------------------------------------------------------------- $ +$ File prefix +$ number of characters in date [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +$ IX and IY ranges [regular:IX NX IY NY, unstructured:IP NP 1 1] +$ + ww3. + 6 + 1 1000000 1 1000000 +$ diff --git a/regtests/ww3_tp2.15/input_const/ww3_ounf.nml b/regtests/ww3_tp2.15/input_const/ww3_ounf.nml new file mode 100644 index 0000000000..d4e8c91515 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_ounf.nml @@ -0,0 +1,25 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20140309 000000' + FIELD%TIMESTRIDE = '900.' + FIELD%TIMECOUNT = '9999' + FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK' + FIELD%PARTITION = '0 1 2' + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.15/input_const/ww3_ounp_par.inp b/regtests/ww3_tp2.15/input_const/ww3_ounp_par.inp new file mode 100644 index 0000000000..2725072a6b --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_ounp_par.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20140309 000000 3600. 37 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ 1 +$ 2 +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 3 + T 150 + 2 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ +$ 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output + 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, nubmer of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.15/input_const/ww3_ounp_par.nml b/regtests/ww3_tp2.15/input_const/ww3_ounp_par.nml new file mode 100644 index 0000000000..cb31335feb --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_ounp_par.nml @@ -0,0 +1,47 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20140309 000000' + POINT%TIMESTRIDE = '3600.' + POINT%TIMECOUNT = '37' + POINT%TYPE = 2 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! -------------------------------------------------------------------- ! +&PARAM_NML + PARAM%OUTPUT = 2 +/ + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.15/input_const/ww3_ounp_spec.inp b/regtests/ww3_tp2.15/input_const/ww3_ounp_spec.inp new file mode 100644 index 0000000000..867a274c7b --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_ounp_spec.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20140309 000000 3600. 37 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ 1 +$ 2 +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 3 + T 150 + 1 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ + 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output +$ 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, nubmer of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.15/input_const/ww3_ounp_spec.nml b/regtests/ww3_tp2.15/input_const/ww3_ounp_spec.nml new file mode 100644 index 0000000000..6177264b14 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_ounp_spec.nml @@ -0,0 +1,45 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounp.nml - Point output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via POINT_NML namelist +! -------------------------------------------------------------------- ! +&POINT_NML + POINT%TIMESTART = '20140309 000000' + POINT%TIMESTRIDE = '3600.' + POINT%TIMECOUNT = '37' +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 0, inventory of file +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the type 1, spectra via SPECTRA_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRA_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 2, mean parameter via PARAM_NML namelist +! -------------------------------------------------------------------- ! +&PARAM_NML +/ + +! -------------------------------------------------------------------- ! +! Define the type 3, source terms via SOURCE_NML namelist +! -------------------------------------------------------------------- ! +&SOURCE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.15/input_const/ww3_outf.inp b/regtests/ww3_tp2.15/input_const/ww3_outf.inp new file mode 100644 index 0000000000..05e04c291b --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_outf.inp @@ -0,0 +1,10 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 20140309 000000 3600. 37 +$ +N +HS DIR DP T02 FP STMAXE STMAXD HMAXE HCMAXE HMAXD HCMAXD QP QKK +$ + 3 0 + 1 43 1 42 1 1 +$ diff --git a/regtests/ww3_tp2.15/input_const/ww3_prnc_WND.inp b/regtests/ww3_tp2.15/input_const/ww3_prnc_WND.inp new file mode 100644 index 0000000000..ca9cd35a72 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_prnc_WND.inp @@ -0,0 +1,52 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ TAU Atm. momentum. +$ RHO Air density. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'WND' 'LL' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + longitude latitude time +$ +$ Variables to use --------------------------------------------------- $ +$ + U V +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_rho/wind.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.15/input_const/ww3_prnc_WND.nml b/regtests/ww3_tp2.15/input_const/ww3_prnc_WND.nml new file mode 100644 index 0000000000..f7e4a81929 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_prnc_WND.nml @@ -0,0 +1,27 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_prnc.nml - Field preprocessor ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define the forcing fields to preprocess via FORCING_NML namelist +! -------------------------------------------------------------------- ! +&FORCING_NML + FORCING%FIELD%WINDS = T + FORCING%GRID%LATLON = T +/ + +! -------------------------------------------------------------------- ! +! Define the content of the input file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML + FILE%FILENAME = '../input_rho/wind.nc' + FILE%LONGITUDE = 'longitude' + FILE%LATITUDE = 'latitude' + FILE%VAR(1) = 'U' + FILE%VAR(2) = 'V' +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.15/input_const/ww3_shel.inp b/regtests/ww3_tp2.15/input_const/ww3_shel.inp new file mode 100644 index 0000000000..24deb0a054 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_shel.inp @@ -0,0 +1,54 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ + F F Water levels + F F Currents + T F Winds + F F Ice concentrations + T T Atmospheric momentum + T T Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ + 20140310 000000 + 20140310 060000 +$ + 1 +$ + 20140310 000000 900 20140310 060000 +$ --------------------------------------------------------------- +$ D C W D W I H L T T T C F D S D P P P P P P W P D F C C U C +$ P U N T L C S 0 M G P I P P H T L T S W S N T C F F S H +$ T R D V E 2 1 E R R S P P H I S F R D X D T A +$ --------------------------------------------------------------- +$ T F T F T F T T T T T T T T T T T T T T T T T T T F F F F F +$ F F F F F F F F F F F F F F F F F F F F F F F +$ --------------------------------------------------------------- +$ F T T W W W W A U B F T S T J F T U M M P U U +$ A A W C C C C B B E B B X W O U S S S 2 S S +$ W W A C F H M R R D B B Y O C S S S C S 1 2 +$ --------------------------------------------------------------- + N + HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK + 20140310 000000 3600 20140310 060000 + 12.5088 45.3138 'AA ' + 0.0 0.0 'STOPSTRING' + 20140310 000000 0 20140310 120000 + 20140310 000000 0 20140310 120000 + 20140310 000000 0 20140310 120000 + 20140310 000000 0 20140310 120000 + +$ + 'TAU' 20140310 000000 -0.03 -0.01 + 'TAU' 20140310 030000 -0.20 -0.15 + 'TAU' 20140310 060000 -0.10 -0.25 + 'RHO' 20140310 000000 1.15 + 'RHO' 20140310 030000 1.25 + 'RHO' 20140310 060000 1.20 + 'STP' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.15/input_const/ww3_shel.nml b/regtests/ww3_tp2.15/input_const/ww3_shel.nml new file mode 100644 index 0000000000..a93172343e --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_shel.nml @@ -0,0 +1,78 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%START = '20140310 000000' + DOMAIN%STOP = '20140310 060000' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_NML + INPUT%FORCING%WINDS = 'T' + INPUT%FORCING%ATM_MOMENTUM = 'H' + INPUT%FORCING%AIR_DENSITY = 'H' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'HS WND RHO TAU T02 DP DIR FP MXE MXES MXH MXHC SDMH SDMHC QP QKK' + TYPE%POINT%FILE = '../input_rho/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '20140310 000000' '900' '20140310 060000' + DATE%POINT = '20140310 000000' '3600' '20140310 060000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML + HOMOG_COUNT%N_TAU = 3 + HOMOG_COUNT%N_RHO = 3 +/ + +&HOMOG_INPUT_NML + HOMOG_INPUT(1)%NAME = 'TAU' + HOMOG_INPUT(1)%DATE ='20140310 000000' + HOMOG_INPUT(1)%VALUE1 = -0.03 + HOMOG_INPUT(1)%VALUE2 = -0.01 + + HOMOG_INPUT(2)%NAME = 'TAU' + HOMOG_INPUT(2)%DATE ='20140310 030000' + HOMOG_INPUT(2)%VALUE1 = -0.20 + HOMOG_INPUT(2)%VALUE2 = -0.15 + + HOMOG_INPUT(3)%NAME = 'TAU' + HOMOG_INPUT(3)%DATE ='20140310 060000' + HOMOG_INPUT(3)%VALUE1 = -0.10 + HOMOG_INPUT(3)%VALUE2 = -0.25 + + HOMOG_INPUT(4)%NAME = 'RHO' + HOMOG_INPUT(4)%DATE ='20140310 000000' + HOMOG_INPUT(4)%VALUE1 = 1.15 + + HOMOG_INPUT(5)%NAME = 'RHO' + HOMOG_INPUT(5)%DATE ='20140310 030000' + HOMOG_INPUT(5)%VALUE1 = 1.25 + + HOMOG_INPUT(6)%NAME = 'RHO' + HOMOG_INPUT(6)%DATE ='20140310 060000' + HOMOG_INPUT(6)%VALUE1 = 1.20 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_tp2.15/input_const/ww3_strt.inp b/regtests/ww3_tp2.15/input_const/ww3_strt.inp new file mode 100644 index 0000000000..a20af30625 --- /dev/null +++ b/regtests/ww3_tp2.15/input_const/ww3_strt.inp @@ -0,0 +1,7 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Initial conditions input file $ +$--------------------------------------------------------------------- $ + 3 +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ From 654702305cefdf8a519afd206f3f8d5842438c54 Mon Sep 17 00:00:00 2001 From: Juan Manuel Castillo Sanchez <48921434+ukmo-juan-castillo@users.noreply.github.com> Date: Mon, 9 Jun 2025 13:28:08 +0100 Subject: [PATCH 086/136] New regtest matrix for the Met Office EX supercomputer (#1448) --- regtests/bin/matrix_cmake_ukmo_cray | 40 ++++++++++++++--------------- regtests/bin/matrix_ukmo_cray | 36 +++++++++++++------------- 2 files changed, 37 insertions(+), 39 deletions(-) diff --git a/regtests/bin/matrix_cmake_ukmo_cray b/regtests/bin/matrix_cmake_ukmo_cray index fc6cf64b9d..729e527bc6 100755 --- a/regtests/bin/matrix_cmake_ukmo_cray +++ b/regtests/bin/matrix_cmake_ukmo_cray @@ -66,7 +66,7 @@ EOF echo '#PBS -l ncpus=16' >> matrix.head echo '#PBS -l mem=16GB' >> matrix.head echo '#PBS -q shared' >> matrix.head - echo '#PBS -l walltime=04:00:00' >> matrix.head + echo '#PBS -l walltime=03:00:00' >> matrix.head echo '#PBS -N ww3_regtest' >> matrix.head echo '#PBS -j oe' >> matrix.head echo '#PBS -o matrix.out' >> matrix.head @@ -78,38 +78,36 @@ EOF if [[ $cmplr == "ukmo_cray" ]] || [[ $cmplr == "ukmo_cray_debug" ]]; then # Load targetted versions of Cray Development Tools (bug in Fortran StreamIO # for older versions) and netCDF/HDF5 modules: - echo "module load cdt/18.12" >> matrix.head - echo "module load cray-netcdf/4.6.1.3" >> matrix.head - echo "module load cray-hdf5/1.10.2.0" >> matrix.head - echo "export METIS_PATH=/home/d02/frey/WW3/ParMETIS" >> matrix.head + echo "module switch PrgEnv-cray PrgEnv-cray/8.4.0" >> matrix.head + echo "module load cpe/23.05" >> matrix.head + echo "module switch cce cce/15.0.0" >> matrix.head + echo "module load cray-hdf5-parallel/1.12.2.1" >> matrix.head + echo "module load cray-netcdf-hdf5parallel/4.9.0.1" >> matrix.head + echo "export METIS_PATH=/data/users/juan.m.castillo/REGTESTS/parmetis-4.0.3_cce" >> matrix.head + echo "export SCOTCH_PATH=/data/users/juan.m.castillo/REGTESTS/scotch_cce" >> matrix.head elif [[ $cmplr == ukmo_cray_gnu* ]]; then # ParMETIS library not currently working with Cray compiler. # Use GNU compiler for programs that use PDLIB. - echo "module switch PrgEnv-cray PrgEnv-gnu/5.2.82" >> matrix.head - echo "module load cray-netcdf" >> matrix.head - echo "export METIS_PATH=/home/d02/frey/WW3/ParMETIS_GNU" >> matrix.head - -elif [[ $cmplr == ukmo_cray_intel* ]]; then - echo "module switch PrgEnv-cray PrgEnv-intel" >> matrix.head - echo "module swap intel/15.0.0.090 intel/18.0.5.274" >> matrix.head - echo "module load cdt/18.12" >> matrix.head - echo "module load cray-netcdf/4.6.1.3" >> matrix.head - echo "module load cray-hdf5/1.10.2.0" >> matrix.head + echo "module switch PrgEnv-cray PrgEnv-gnu/8.4.0" >> matrix.head + echo "module load cpe/23.05" >> matrix.head + echo "module load cray-hdf5-parallel/1.12.2.1" >> matrix.head + echo "module load cray-netcdf-hdf5parallel/4.9.0.1" >> matrix.head + echo "export METIS_PATH=/data/users/juan.m.castillo/REGTESTS/parmetis-4.0.3_gnu" >> matrix.head + echo "export SCOTCH_PATH=/data/users/juan.m.castillo/REGTESTS/scotch_gnu" >> matrix.head else echo "Unknown compiler for UKMO regression tests: $cmplr" exit 1 fi -# Need newer cmake version on the XC - echo "module load cmake/3.21.3" >> matrix.head - -# SNP Launcher 7.7.4 allows -np switch: - echo "module load cray-snplauncher/7.7.4" >> matrix.head echo "export NETCDF_CONFIG=\$(which nc-config)" >> matrix.head -# On the Cray XC, we need to stop CMake from searching for +# For CMAKE + echo "export CC=cc" >> matrix.head + echo "export FTN=ftn" >> matrix.head + +# On the EX, we need to stop CMake from searching for # the NetCDF libraries - they are provided by the ftn wrapper. echo "export CMAKE_OPTIONS=-DEXCLUDE_FIND=\"netcdf\"" >> matrix.head diff --git a/regtests/bin/matrix_ukmo_cray b/regtests/bin/matrix_ukmo_cray index e49890ef29..7cf3b622bb 100755 --- a/regtests/bin/matrix_ukmo_cray +++ b/regtests/bin/matrix_ukmo_cray @@ -51,7 +51,7 @@ echo '#PBS -l ncpus=16' >> matrix.head echo '#PBS -l mem=16GB' >> matrix.head echo '#PBS -q shared' >> matrix.head - echo '#PBS -l walltime=04:00:00' >> matrix.head + echo '#PBS -l walltime=03:00:00' >> matrix.head echo '#PBS -N ww3_regtest' >> matrix.head echo '#PBS -j oe' >> matrix.head echo '#PBS -o matrix.out' >> matrix.head @@ -63,34 +63,34 @@ if [[ $cmplr == "ukmo_cray" ]] || [[ $cmplr == "ukmo_cray_debug" ]]; then # Load targetted versions of Cray Development Tools (bug in Fortran StreamIO # for older versions) and netCDF/HDF5 modules: - echo "module load cdt/18.12" >> matrix.head - echo "module load cray-netcdf/4.6.1.3" >> matrix.head - echo "module load cray-hdf5/1.10.2.0" >> matrix.head - echo "export METIS_PATH=/home/d02/frey/WW3/ParMETIS" >> matrix.head + echo "module switch PrgEnv-cray PrgEnv-cray/8.4.0" >> matrix.head + echo "module load cpe/23.05" >> matrix.head + echo "module switch cce cce/15.0.0" >> matrix.head + echo "module load cray-hdf5-parallel/1.12.2.1" >> matrix.head + echo "module load cray-netcdf-hdf5parallel/4.9.0.1" >> matrix.head + echo "export METIS_PATH=/data/users/juan.m.castillo/REGTESTS/parmetis-4.0.3_cce" >> matrix.head + echo "export SCOTCH_PATH=/data/users/juan.m.castillo/REGTESTS/scotch_cce" >> matrix.head elif [[ $cmplr == ukmo_cray_gnu* ]]; then # ParMETIS library not currently working with Cray compiler. # Use GNU compiler for programs that use PDLIB. - echo "module switch PrgEnv-cray PrgEnv-gnu/5.2.82" >> matrix.head - echo "module load cray-netcdf" >> matrix.head - echo "export METIS_PATH=/home/d02/frey/WW3/ParMETIS_GNU" >> matrix.head - -elif [[ $cmplr == ukmo_cray_intel* ]]; then - echo "module switch PrgEnv-cray PrgEnv-intel" >> matrix.head - echo "module swap intel/15.0.0.090 intel/18.0.5.274" >> matrix.head - echo "module load cdt/18.12" >> matrix.head - echo "module load cray-netcdf/4.6.1.3" >> matrix.head - echo "module load cray-hdf5/1.10.2.0" >> matrix.head + echo "module switch PrgEnv-cray PrgEnv-gnu/8.4.0" >> matrix.head + echo "module load cpe/23.05" >> matrix.head + echo "module load cray-hdf5-parallel/1.12.2.1" >> matrix.head + echo "module load cray-netcdf-hdf5parallel/4.9.0.1" >> matrix.head + echo "export METIS_PATH=/data/users/juan.m.castillo/REGTESTS/parmetis-4.0.3_gnu" >> matrix.head + echo "export SCOTCH_PATH=/data/users/juan.m.castillo/REGTESTS/scotch_gnu" >> matrix.head else echo "Unknown compiler for UKMO regression tests: $cmplr" exit 1 fi -# SNP Launcher 7.7.4 allows -np switch: - echo " module load cray-snplauncher/7.7.4" >> matrix.head + echo " export NETCDF_CONFIG=\$(which nc-config)" >> matrix.head - echo " export NETCDF_CONFIG=\$(which nc-config)" >> matrix.head +# For CMAKE + echo "export CC=cc" >> matrix.head + echo "export FTN=ftn" >> matrix.head # Compiler option. Set cmplOption to # y if using for the first time or using a different compiler From 1cca7c5c4fa480a9cd35a8ec9f8234e005dec78d Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 21 Jul 2025 11:37:04 -0400 Subject: [PATCH 087/136] =?UTF-8?q?Upgrade=20WW3=20to=20Spack=E2=80=91Stac?= =?UTF-8?q?k=201.9.2=20and=20add=20support=20for=20Ursa=20(#1462)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Saeideh.Banihashemi --- regtests/bin/matrix_cmake_ncep | 91 +++++++++++++++++++++++----------- 1 file changed, 62 insertions(+), 29 deletions(-) diff --git a/regtests/bin/matrix_cmake_ncep b/regtests/bin/matrix_cmake_ncep index 1fa1a2d6fd..0914330567 100755 --- a/regtests/bin/matrix_cmake_ncep +++ b/regtests/bin/matrix_cmake_ncep @@ -56,11 +56,11 @@ EOF modjasper='jasper/2.0.32' modzlib='zlib/1.2.13' modpng='libpng/1.6.37' - modhdf5='hdf5/1.14.0' + modhdf5='hdf5/1.14.3' modbacio='bacio/2.4.1' - modg2='g2/3.4.5' + modg2='g2/3.5.1' modw3emc='w3emc/2.10.0' - modesmf='esmf/8.6.0' + modesmf='esmf/8.8.0' modscotch='scotch/7.0.4' # Set batchq queue, choose modules and other custom variables to fit system and @@ -68,23 +68,29 @@ EOF ishera=`hostname | grep hfe` isorion=`hostname | grep orion` ishercules=`hostname | grep hercules` + isursa=`hostname | grep ufe` if [ $ishera ] then batchq='slurm' if [ $compiler = "intel" ] then - spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.6.0/envs/unified-env-rocky8/install/modulefiles/Core' - modcomp='stack-intel/2021.5.0' - modmpi='stack-intel-oneapi-mpi/2021.5.1' - metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hera/intel/spack-stack/1.6.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + spackstackpath='/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.2.1/install/modulefiles/Core' + spackstackpath2='/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.2.1/install/modulefiles/intel-oneapi-mpi/2021.13-sbi3u54/gcc/13.3.0' + modcomp='stack-oneapi/2024.2.1' + modmpi='stack-intel-oneapi-mpi/2021.13' + metispath='/scratch4/NCEPDEV/marine/Ming.Chen/apps/parmetis/parmetis_intel/hera/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' + modzlib='zlib/1.2.11' elif [ $compiler = "gnu" ] then - spackstackpath='/scratch1/NCEPDEV/nems/role.epic/spack-stack/spack-stack-1.6.0/envs/unified-env-rocky8/install/modulefiles/Core' - modcomp='stack-gcc/9.2.0' - modmpi='stack-openmpi/4.1.5' - metispath='/scratch1/NCEPDEV/climate/Matthew.Masarik/waves/opt/hera/gnu/spack-stack/1.6.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + spackstackpath='/contrib/spack-stack/spack-stack-1.9.2/envs/ue-gcc-13.3.0/install/modulefiles/Core' + spackstackpath2='/contrib/spack-stack/installs/gnu/modulefiles' + spackstackpath3='/contrib/spack-stack/installs/openmpi/modulefiles' + modcomp='stack-gcc/13.3.0' + modmpi='stack-openmpi/4.1.6' + metispath='/scratch4/NCEPDEV/marine/Ming.Chen/apps/parmetis/parmetis_gnu/hera/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' + modzlib='zlib/1.2.11' else echo "Compiler $compiler not supported on hera" exit 1 @@ -94,11 +100,12 @@ EOF if [ $compiler = "intel" ] then batchq='slurm' - spackstackpath='/work/noaa/epic/role-epic/spack-stack/orion/spack-stack-1.6.0/envs/unified-env-rocky9/install/modulefiles/Core' - modcomp='stack-intel/2021.9.0' - modmpi='stack-intel-oneapi-mpi/2021.9.0' - metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/orion/intel/spack-stack/1.6.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + spackstackpath='/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.1.0/install/modulefiles/Core/' + spackstackpath2='/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.1.0/install/modulefiles/intel-oneapi-mpi/2021.13-li242lf/gcc/12.2.0' + modcomp='stack-oneapi/2024.2.1' + modmpi='stack-intel-oneapi-mpi/2021.13' + metispath='/work/noaa/marine/Ming.Chen/apps/parmetis/parmetis_intel/orion/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' else echo "Compiler $compiler not supported on orion" exit 1 @@ -108,23 +115,46 @@ EOF batchq='slurm' if [ $compiler = "intel" ] then - spackstackpath='/work/noaa/epic/role-epic/spack-stack/hercules/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' - modcomp='stack-intel/2021.9.0' - modmpi='stack-intel-oneapi-mpi/2021.9.0' - metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/hercules/intel/spack-stack/1.6.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + spackstackpath='/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.1.0/install/modulefiles/Core' + spackstackpath2='/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.1.0/install/modulefiles/intel-oneapi-mpi/2021.13-sqiixt7/gcc/13.3.0' + modcomp='stack-oneapi/2024.2.1' + modmpi='stack-intel-oneapi-mpi/2021.13' + metispath='/work/noaa/marine/Ming.Chen/apps/parmetis/parmetis_intel/hercules/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' elif [ $compiler = "gnu" ] then - spackstackpath='/work/noaa/epic/role-epic/spack-stack/hercules/spack-stack-1.6.0/envs/unified-env/install/modulefiles/Core' - spackstackpath2='/work/noaa/epic/role-epic/spack-stack/hercules/modulefiles' - modcomp='stack-gcc/12.2.0' - modmpi='stack-mvapich2/2.3.7' - metispath='/work/noaa/marine/Matthew.Masarik/waves/opt/hercules/gnu/spack-stack/1.6.0/parmetis-4.0.3/install' - modcmake='cmake/3.23.1' + spackstackpath='/apps/contrib/spack-stack/spack-stack-1.9.2/envs/ue-gcc-13.3.0/install/modulefiles/Core' + spackstackpath2='/apps/contrib/spack-stack/modulefiles' + modcomp='stack-gcc/13.3.0' + modmpi='stack-openmpi/4.1.6' + metispath='/work/noaa/marine/Ming.Chen/apps/parmetis/parmetis_gnu/hercules/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' else echo "Compiler $compiler not supported on hercules" exit 1 fi + elif [ $isursa ] + then + batchq='slurm' + if [ $compiler = "intel" ] + then + spackstackpath='/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.2.1/install/modulefiles/Core' + spackstackpath2='/contrib/spack-stack/spack-stack-1.9.2/envs/ue-oneapi-2024.2.1/install/modulefiles/intel-oneapi-mpi/2021.13-haww6b3/gcc/12.4.0' + modcomp='stack-oneapi/2024.2.1' + modmpi='stack-intel-oneapi-mpi/2021.13' + metispath='/scratch4/NCEPDEV/marine/Ming.Chen/apps/parmetis/parmetis_intel/ursa/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' + elif [ $compiler = "gnu" ] + then + spackstackpath='/contrib/spack-stack/spack-stack-1.9.2/envs/ue-gcc-12.4.0/install/modulefiles/Core' + modcomp='stack-gcc/12.4.0' + modmpi='stack-openmpi/4.1.6' + metispath='/scratch4/NCEPDEV/marine/Ming.Chen/apps/parmetis/parmetis_gnu/ursa/parmetis-4.0.3/install' + modcmake='cmake/3.27.9' + else + echo "Compiler $compiler not supported on ursa" + exit 1 + fi else batchq= fi @@ -196,6 +226,9 @@ EOF if [ ! -z $spackstackpath2 ]; then echo " module use $spackstackpath2" >> matrix.head fi + if [ ! -z $spackstackpath3 ]; then + echo " module use $spackstackpath3" >> matrix.head + fi echo " module load $modcomp" >> matrix.head echo " module load $modmpi" >> matrix.head echo " module load $modcmake" >> matrix.head From d6160abb9a9cc763d4fecf84049cdd92721c685c Mon Sep 17 00:00:00 2001 From: Juan Manuel Castillo Sanchez <48921434+ukmo-juan-castillo@users.noreply.github.com> Date: Wed, 23 Jul 2025 18:22:19 +0100 Subject: [PATCH 088/136] Removal of labelled statements (#1457) --- model/src/constants.F90 | 254 ++- model/src/gx_outf.F90 | 109 +- model/src/gx_outp.F90 | 65 +- model/src/mod_fileio.f90 | 14 +- model/src/mod_xnl4v5.f90 | 518 ++--- model/src/pdlib_field_vec.F90 | 2 - model/src/serv_xnl4v5.f90 | 66 +- model/src/w3arrymd.F90 | 233 +-- model/src/w3bullmd.F90 | 192 +- model/src/w3canomd.F90 | 30 +- model/src/w3dispmd.F90 | 12 +- model/src/w3fld1md.F90 | 3 - model/src/w3fld2md.F90 | 1 - model/src/w3fldsmd.F90 | 693 ++++--- model/src/w3flx2md.F90 | 1 - model/src/w3flx3md.F90 | 1 - model/src/w3gridmd.F90 | 367 ++-- model/src/w3initmd.F90 | 63 +- model/src/w3iobcmd.F90 | 132 +- model/src/w3iogomd.F90 | 481 ++--- model/src/w3iogrmd.F90 | 255 +-- model/src/w3iopomd.F90 | 73 +- model/src/w3iorsmd.F90 | 504 +++-- model/src/w3iosfmd.F90 | 22 +- model/src/w3iotrmd.F90 | 434 +++-- model/src/w3meminfo.F90 | 23 +- model/src/w3ounfmetamd.F90 | 23 +- model/src/w3partmd.F90 | 12 +- model/src/w3pro1md.F90 | 2 - model/src/w3profsmd.F90 | 1292 +++++++------ model/src/w3psmcmd.F90 | 2 - model/src/w3sbt4md.F90 | 1 - model/src/w3servmd.F90 | 769 +++++--- model/src/w3sis1md.F90 | 1 - model/src/w3sis2md.F90 | 1 - model/src/w3sln1md.F90 | 1 - model/src/w3snl1md.F90 | 26 +- model/src/w3snl2md.F90 | 72 +- model/src/w3snl3md.F90 | 52 +- model/src/w3snl4md.F90 | 432 ++--- model/src/w3snl5md.F90 | 2 - model/src/w3snlsmd.F90 | 12 +- model/src/w3src4md.F90 | 167 +- model/src/w3src6md.F90 | 3 - model/src/w3srcemd.F90 | 50 +- model/src/w3str1md.F90 | 1 - model/src/w3strkmd.F90 | 512 +++-- model/src/w3tidemd.F90 | 117 +- model/src/w3timemd.F90 | 324 ++-- model/src/w3triamd.F90 | 18 +- model/src/w3updtmd.F90 | 88 +- model/src/w3wavemd.F90 | 1042 +++++----- model/src/wmesmfmd.F90 | 118 +- model/src/wminitmd.F90 | 486 ++--- model/src/wmupdtmd.F90 | 39 +- model/src/wmwavemd.F90 | 63 +- model/src/ww3_bounc.F90 | 97 +- model/src/ww3_bound.F90 | 104 +- model/src/ww3_gint.F90 | 61 +- model/src/ww3_grib.F90 | 251 ++- model/src/ww3_gspl.F90 | 178 +- model/src/ww3_ounf.F90 | 3361 ++++++++++++++++----------------- model/src/ww3_ounp.F90 | 1190 ++++++------ model/src/ww3_outf.F90 | 95 +- model/src/ww3_outp.F90 | 143 +- model/src/ww3_prep.F90 | 234 +-- model/src/ww3_prnc.F90 | 897 +++++---- model/src/ww3_prtide.F90 | 85 +- model/src/ww3_sbs1.F90 | 139 +- model/src/ww3_shel.F90 | 1432 +++++++------- model/src/ww3_strt.F90 | 66 +- model/src/ww3_trck.F90 | 426 ++--- model/src/ww3_trnc.F90 | 207 +- model/src/ww3_uprstr.F90 | 77 +- 74 files changed, 9636 insertions(+), 9683 deletions(-) diff --git a/model/src/constants.F90 b/model/src/constants.F90 index c4f67b371d..6e43b26c15 100644 --- a/model/src/constants.F90 +++ b/model/src/constants.F90 @@ -34,6 +34,7 @@ MODULE CONSTANTS !/ 20-Jan-2017 : Add parameters for ESMF ( version 6.02 ) !/ 01-Mar-2018 : Add UNDEF parameter ( version 6.02 ) !/ 05-Jun-2018 : Add PDLIB parameters ( version 6.04 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -275,134 +276,131 @@ SUBROUTINE KZEONE(X, Y, RE0, IM0, RE1, IM1) ! ABSCISSAS AND THE WEIGHT FACTORS USED IN THE GAUSS- ! HERMITE QUADRATURE. R2 = X*X + Y*Y - IF (R2.GE.1.96D2) GO TO 50 - IF (R2.GE.1.849D1) GO TO 30 - ! THIS SECTION CALCULATES THE FUNCTIONS USING THE SERIES - ! EXPANSIONS - X2 = X/2.0D0 - Y2 = Y/2.0D0 - P1 = X2*X2 - P2 = Y2*Y2 - T1 = -(DLOG(P1+P2)/2.0D0+0.5772156649015329D0) - ! THE CONSTANT IN THE PRECEDING STATEMENT IS EULER*S - ! CONSTANT - T2 = -DATAN2(Y,X) - X2 = P1 - P2 - Y2 = X*Y2 - RTERM = 1.0D0 - ITERM = 0.0D0 - RE0 = T1 - IM0 = T2 - T1 = T1 + 0.5D0 - RE1 = T1 - IM1 = T2 - P2 = DSQRT(R2) - L = 2.106D0*P2 + 4.4D0 - IF (P2.LT.8.0D-1) L = 2.129D0*P2 + 4.0D0 - DO N=1,INT(L) - P1 = N - P2 = N*N - R1 = RTERM - RTERM = (R1*X2-ITERM*Y2)/P2 - ITERM = (R1*Y2+ITERM*X2)/P2 - T1 = T1 + 0.5D0/P1 - RE0 = RE0 + T1*RTERM - T2*ITERM - IM0 = IM0 + T1*ITERM + T2*RTERM - P1 = P1 + 1.0D0 - T1 = T1 + 0.5D0/P1 - RE1 = RE1 + (T1*RTERM-T2*ITERM)/P1 - IM1 = IM1 + (T1*ITERM+T2*RTERM)/P1 - END DO - R1 = X/R2 - 0.5D0*(X*RE1-Y*IM1) - R2 = -Y/R2 - 0.5D0*(X*IM1+Y*RE1) - P1 = DEXP(X) - RE0 = P1*RE0 - IM0 = P1*IM0 - RE1 = P1*R1 - IM1 = P1*R2 - RETURN - ! THIS SECTION CALCULATES THE FUNCTIONS USING THE INTEGRAL - ! REPRESENTATION, EQN 3, EVALUATED WITH 15 POINT GAUSS- - ! HERMITE QUADRATURE -30 X2 = 2.0D0*X - Y2 = 2.0D0*Y - R1 = Y2*Y2 - P1 = DSQRT(X2*X2+R1) - P2 = DSQRT(P1+X2) - T1 = EXSQ(1)/(2.0D0*P1) - RE0 = T1*P2 - IM0 = T1/P2 - RE1 = 0.0D0 - IM1 = 0.0D0 - DO N=2,8 - T2 = X2 + TSQ(N) - P1 = DSQRT(T2*T2+R1) - P2 = DSQRT(P1+T2) - T1 = EXSQ(N)/P1 - RE0 = RE0 + T1*P2 - IM0 = IM0 + T1/P2 - T1 = EXSQ(N)*TSQ(N) - RE1 = RE1 + T1*P2 - IM1 = IM1 + T1/P2 - END DO - T2 = -Y2*IM0 - RE1 = RE1/R2 - R2 = Y2*IM1/R2 - RTERM = 1.41421356237309D0*DCOS(Y) - ITERM = -1.41421356237309D0*DSIN(Y) - ! THE CONSTANT IN THE PREVIOUS STATEMENTS IS,OF COURSE, - ! SQRT(2.0). - IM0 = RE0*ITERM + T2*RTERM - RE0 = RE0*RTERM - T2*ITERM - T1 = RE1*RTERM - R2*ITERM - T2 = RE1*ITERM + R2*RTERM - RE1 = T1*X + T2*Y - IM1 = -T1*Y + T2*X - RETURN - ! THIS SECTION CALCULATES THE FUNCTIONS USING THE - ! ASYMPTOTIC EXPANSIONS -50 RTERM = 1.0D0 - ITERM = 0.0D0 - RE0 = 1.0D0 - IM0 = 0.0D0 - RE1 = 1.0D0 - IM1 = 0.0D0 - P1 = 8.0D0*R2 - P2 = DSQRT(R2) - L = 3.91D0+8.12D1/P2 - R1 = 1.0D0 - R2 = 1.0D0 - M = -8 - K = 3 - DO N=1,INT(L) - M = M + 8 - K = K - M - R1 = FLOAT(K-4)*R1 - R2 = FLOAT(K)*R2 - T1 = FLOAT(N)*P1 - T2 = RTERM - RTERM = (T2*X+ITERM*Y)/T1 - ITERM = (-T2*Y+ITERM*X)/T1 - RE0 = RE0 + R1*RTERM - IM0 = IM0 + R1*ITERM - RE1 = RE1 + R2*RTERM - IM1 = IM1 + R2*ITERM - END DO - T1 = DSQRT(P2+X) - T2 = -Y/T1 - P1 = 8.86226925452758D-1/P2 - ! THIS CONSTANT IS SQRT(PI)/2.0, WITH PI=3.14159... - RTERM = P1*DCOS(Y) - ITERM = -P1*DSIN(Y) - R1 = RE0*RTERM - IM0*ITERM - R2 = RE0*ITERM + IM0*RTERM - RE0 = T1*R1 - T2*R2 - IM0 = T1*R2 + T2*R1 - R1 = RE1*RTERM - IM1*ITERM - R2 = RE1*ITERM + IM1*RTERM - RE1 = T1*R1 - T2*R2 - IM1 = T1*R2 + T2*R1 - RETURN + IF (R2.GE.1.96D2) THEN + ! CALCULATE THE FUNCTIONS USING THE ASYMPTOTIC EXPANSIONS + RTERM = 1.0D0 + ITERM = 0.0D0 + RE0 = 1.0D0 + IM0 = 0.0D0 + RE1 = 1.0D0 + IM1 = 0.0D0 + P1 = 8.0D0*R2 + P2 = DSQRT(R2) + L = 3.91D0+8.12D1/P2 + R1 = 1.0D0 + R2 = 1.0D0 + M = -8 + K = 3 + DO N=1,INT(L) + M = M + 8 + K = K - M + R1 = FLOAT(K-4)*R1 + R2 = FLOAT(K)*R2 + T1 = FLOAT(N)*P1 + T2 = RTERM + RTERM = (T2*X+ITERM*Y)/T1 + ITERM = (-T2*Y+ITERM*X)/T1 + RE0 = RE0 + R1*RTERM + IM0 = IM0 + R1*ITERM + RE1 = RE1 + R2*RTERM + IM1 = IM1 + R2*ITERM + END DO + T1 = DSQRT(P2+X) + T2 = -Y/T1 + P1 = 8.86226925452758D-1/P2 + ! THIS CONSTANT IS SQRT(PI)/2.0, WITH PI=3.14159... + RTERM = P1*DCOS(Y) + ITERM = -P1*DSIN(Y) + R1 = RE0*RTERM - IM0*ITERM + R2 = RE0*ITERM + IM0*RTERM + RE0 = T1*R1 - T2*R2 + IM0 = T1*R2 + T2*R1 + R1 = RE1*RTERM - IM1*ITERM + R2 = RE1*ITERM + IM1*RTERM + RE1 = T1*R1 - T2*R2 + IM1 = T1*R2 + T2*R1 + ELSE IF (R2.GE.1.849D1) THEN + ! CALCULATE THE FUNCTIONS USING THE INTEGRAL + ! REPRESENTATION, EQN 3, EVALUATED WITH 15 POINT GAUSS- + ! HERMITE QUADRATURE + X2 = 2.0D0*X + Y2 = 2.0D0*Y + R1 = Y2*Y2 + P1 = DSQRT(X2*X2+R1) + P2 = DSQRT(P1+X2) + T1 = EXSQ(1)/(2.0D0*P1) + RE0 = T1*P2 + IM0 = T1/P2 + RE1 = 0.0D0 + IM1 = 0.0D0 + DO N=2,8 + T2 = X2 + TSQ(N) + P1 = DSQRT(T2*T2+R1) + P2 = DSQRT(P1+T2) + T1 = EXSQ(N)/P1 + RE0 = RE0 + T1*P2 + IM0 = IM0 + T1/P2 + T1 = EXSQ(N)*TSQ(N) + RE1 = RE1 + T1*P2 + IM1 = IM1 + T1/P2 + END DO + T2 = -Y2*IM0 + RE1 = RE1/R2 + R2 = Y2*IM1/R2 + RTERM = 1.41421356237309D0*DCOS(Y) + ITERM = -1.41421356237309D0*DSIN(Y) + ! THE CONSTANT IN THE PREVIOUS STATEMENTS IS,OF COURSE, + ! SQRT(2.0). + IM0 = RE0*ITERM + T2*RTERM + RE0 = RE0*RTERM - T2*ITERM + T1 = RE1*RTERM - R2*ITERM + T2 = RE1*ITERM + R2*RTERM + RE1 = T1*X + T2*Y + IM1 = -T1*Y + T2*X + ELSE + ! CALCULATE THE FUNCTIONS USING THE SERIES EXPANSIONS + X2 = X/2.0D0 + Y2 = Y/2.0D0 + P1 = X2*X2 + P2 = Y2*Y2 + T1 = -(DLOG(P1+P2)/2.0D0+0.5772156649015329D0) + ! THE CONSTANT IN THE PRECEDING STATEMENT IS EULER*S + ! CONSTANT + T2 = -DATAN2(Y,X) + X2 = P1 - P2 + Y2 = X*Y2 + RTERM = 1.0D0 + ITERM = 0.0D0 + RE0 = T1 + IM0 = T2 + T1 = T1 + 0.5D0 + RE1 = T1 + IM1 = T2 + P2 = DSQRT(R2) + L = 2.106D0*P2 + 4.4D0 + IF (P2.LT.8.0D-1) L = 2.129D0*P2 + 4.0D0 + DO N=1,INT(L) + P1 = N + P2 = N*N + R1 = RTERM + RTERM = (R1*X2-ITERM*Y2)/P2 + ITERM = (R1*Y2+ITERM*X2)/P2 + T1 = T1 + 0.5D0/P1 + RE0 = RE0 + T1*RTERM - T2*ITERM + IM0 = IM0 + T1*ITERM + T2*RTERM + P1 = P1 + 1.0D0 + T1 = T1 + 0.5D0/P1 + RE1 = RE1 + (T1*RTERM-T2*ITERM)/P1 + IM1 = IM1 + (T1*ITERM+T2*RTERM)/P1 + END DO + R1 = X/R2 - 0.5D0*(X*RE1-Y*IM1) + R2 = -Y/R2 - 0.5D0*(X*IM1+Y*RE1) + P1 = DEXP(X) + RE0 = P1*RE0 + IM0 = P1*IM0 + RE1 = P1*R1 + IM1 = P1*R2 + END IF END SUBROUTINE KZEONE ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/model/src/gx_outf.F90 b/model/src/gx_outf.F90 index c8ab00e384..94626c4664 100644 --- a/model/src/gx_outf.F90 +++ b/model/src/gx_outf.F90 @@ -70,6 +70,7 @@ PROGRAM GXOUTF !/ 27-Aug-2015 : ICEH and ICEF added as output ( version 5.10 ) !/ 25-Aug-2018 : Add WBT parameter ( version 6.06 ) !/ 22-Mar-2021 : RHOA and TAUA added as output ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ !/ Copyright 2009 National Weather Service (NWS), @@ -107,6 +108,8 @@ PROGRAM GXOUTF ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTOPN Subr. Id. Abort when opening file if error. + ! EXTIOF Subr. Id. Abort when I/O file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -152,7 +155,7 @@ PROGRAM GXOUTF USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3IOGRMD, ONLY: W3IOGR USE W3IOGOMD, ONLY: W3READFLGRD, W3IOGO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -237,8 +240,10 @@ PROGRAM GXOUTF ! JLEN = LEN_TRIM(FNMPRE) OPEN (NDSI,FILE=FNMPRE(:JLEN)//'gx_outf.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'GXOUTF','INPUT',1) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTF','INPUT',2) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -277,7 +282,8 @@ PROGRAM GXOUTF ! Output times ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT + READ (NDSI,*,IOSTAT=IERR) TOUT, DTREQ, NOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTF','INPUT',2) DTREQ = MAX ( 0. , DTREQ ) IF ( DTREQ.EQ.0 ) NOUT = 1 NOUT = MAX ( 1 , NOUT ) @@ -297,7 +303,10 @@ PROGRAM GXOUTF IDTIME(21:23) = ' ' WRITE (NDSO,941) IDTIME, NOUT ! - IF ( MOD(NINT(DTREQ),60) .NE. 0 ) GOTO 810 + IF ( MOD(NINT(DTREQ),60) .NE. 0 ) THEN + WRITE (NDSE,1010) + CALL EXTCDE ( 10 ) + END IF ! ! ... Output fields ! @@ -392,7 +401,8 @@ PROGRAM GXOUTF ! ... Grid range ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IX0, IXN, IY0, IYN, MSOUT, MBOUT + READ (NDSI,*,IOSTAT=IERR) IX0, IXN, IY0, IYN, MSOUT, MBOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTF','INPUT',2) ! WRITE (NDSO,947) ! @@ -420,7 +430,8 @@ PROGRAM GXOUTF MBOUT = .NOT. MBOUT ! OPEN (NDSDAT,FILE=FNMPRE(:JLEN)//'ww3.grads',form='UNFORMATTED', convert=file_endian, & - ERR=811,IOSTAT=IERR) + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'GXOUTF','INPUT',11,NAMEF='ww3.grads') ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 5. Time management. @@ -434,7 +445,7 @@ PROGRAM GXOUTF CALL W3IOGO ( 'READ', NDSOG, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,942) - GOTO 600 + EXIT END IF CYCLE END IF @@ -459,13 +470,13 @@ PROGRAM GXOUTF !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 6. Close data file and write control file ! -600 CONTINUE WRITE (NDSO,980) ! WRITE (NDSO,981) CLOSE (NDSDAT) WRITE (NDSO,982) - OPEN (NDSCTL,FILE=FNMPRE(:JLEN)//'ww3.ctl',ERR=812,IOSTAT=IERR) + OPEN (NDSCTL,FILE=FNMPRE(:JLEN)//'ww3.ctl',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'GXOUTF','OUTPUT',12,NAMEF='ww3.ctl') ! IH0 = TIME0(2)/10000 IM0 = MOD(TIME0(2)/100,100) @@ -478,7 +489,10 @@ PROGRAM GXOUTF IF ( DTREQ .GT. 3599. ) THEN CINC = 'HR' IINC = NINT(DTREQ/3600.) - IF ( MOD(NINT(DTREQ),3600) .NE. 0 ) GOTO 820 + IF ( MOD(NINT(DTREQ),3600) .NE. 0 ) THEN + WRITE (NDSE,1020) DTREQ + CALL EXTCDE ( 20 ) + END IF ELSE CINC = 'MN' IINC = NINT(DTREQ/60.) @@ -631,44 +645,8 @@ PROGRAM GXOUTF ! WRITE (NDSCTL,992) ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 2 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 3 ) - ! -810 CONTINUE - WRITE (NDSE,1010) - CALL EXTCDE ( 10 ) - ! -811 CONTINUE - WRITE (NDSE,1011) - CALL EXTCDE ( 11 ) - ! -812 CONTINUE - WRITE (NDSE,1012) - CALL EXTCDE ( 12 ) - ! -820 CONTINUE - WRITE (NDSE,1020) DTREQ - CALL EXTCDE ( 20 ) - ! -821 CONTINUE - WRITE (NDSE,1021) - CALL EXTCDE ( 21 ) - ! -888 CONTINUE WRITE (NDSO,999) + STOP ! ! Formats ! @@ -698,7 +676,6 @@ PROGRAM GXOUTF 948 FORMAT ( ' Longitudes : ',2I6/ & ' lattidutes : ',2I6/ & ' Opening file ww3.grads') -949 FORMAT ( ' Alternative definition is used ') 950 FORMAT ( ' Sea points in mask : ',A) 951 FORMAT ( ' Bound. pts. in mask: ',A) ! @@ -732,41 +709,12 @@ PROGRAM GXOUTF ' ========================================='/ & ' WAVEWATCH III GrADS field output '/) ! -#ifdef W3_T -9050 FORMAT ( ' TEST GXOUTF : KPDS : ',13I4/ & - ' ',12I4) -9051 FORMAT ( ' TEST GXOUTF : KGDS : ',8I6/ & - ' ',8I6/ & - ' ',6I6) -#endif - ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & ' SMALLEST OUTPUT INCREMENT IS 60 SEC.'/) ! -1011 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' ERROR IN OPENING OUTPUT FILE ww3.grads'/ & - ' IOSTAT =',I5/) - ! -1012 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' ERROR IN OPENING OUTPUT FILE ww3.ctl'/ & - ' IOSTAT =',I5/) - ! 1020 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & ' FIELD INCREMENT > 1HR BUT NOT MULTIPLE',F10.0/) ! -1021 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' UPDATE PARS IN LOOP 610 !!!'/) !/ !/ Internal subroutine GXEXGO ---------------------------------------- / !/ @@ -1447,11 +1395,6 @@ SUBROUTINE GXEXGO ( NX, NY, NSEA ) ! ! Formats ! -940 FORMAT (1X,I8,3I3.2,2X,4E12.4) -950 FORMAT (1X,A13,I9.8,I7.6,2(2F8.2,I4), & - 1X,A4,F8.4,1X,A10,2I2,1X,A11,I4) -951 FORMAT (1X,2F10.5,2I8) - ! 990 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO :'/ & ' GROUP',I2,' PARAMETER',I3,' NOT LISTED ' ) 999 FORMAT (/' *** WAVEWATCH III ERROR IN GXEXGO :'/ & diff --git a/model/src/gx_outp.F90 b/model/src/gx_outp.F90 index 8dce5f4d03..ea5312e1d0 100644 --- a/model/src/gx_outp.F90 +++ b/model/src/gx_outp.F90 @@ -63,6 +63,7 @@ PROGRAM GXOUTP !/ 27-Aug-2015 : Sice add as additional output ( version 5.10 ) !/ (in source terms) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -123,6 +124,8 @@ PROGRAM GXOUTP ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTOPN Subr. Id. Abort when opening file if error. + ! EXTIOF Subr. Id. Abort when I/O file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -170,7 +173,7 @@ PROGRAM GXOUTP #else USE W3IOPOMD, ONLY: W3IOPO #endif - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -257,8 +260,10 @@ PROGRAM GXOUTP ! J = LEN_TRIM(FNMPRE) OPEN (NDSI,FILE=FNMPRE(:J)//'gx_outp.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'GXOUTP','INPUT',10) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTP','INPUT',11) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -302,7 +307,8 @@ PROGRAM GXOUTP ! Output times ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT + READ (NDSI,*,IOSTAT=IERR) TOUT, DTREQ, NOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTP','INPUT',11) DTREQ = MAX ( 0. , DTREQ ) IF ( DTREQ.EQ.0 ) NOUT = 1 NOUT = MAX ( 1 , NOUT ) @@ -329,7 +335,8 @@ PROGRAM GXOUTP ! DO CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IPOINT + READ (NDSI,*,IOSTAT=IERR) IPOINT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTP','INPUT',11) IF ( IPOINT .GT. 0 ) THEN IF ( IPOINT .LE. NOPTS ) THEN IF ( .NOT. FLREQ(IPOINT) ) NREQ = NREQ + 1 @@ -358,7 +365,8 @@ PROGRAM GXOUTP ! ... Output of output points ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) FLSRCE + READ (NDSI,*,IOSTAT=IERR) FLSRCE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'GXOUTP','INPUT',11) WRITE (NDSO,952) NLEV = 0 DO I=1, 7 @@ -430,7 +438,10 @@ PROGRAM GXOUTP IF ( DTREQ .GT. 3599. ) THEN CINC = 'HR' IINC = NINT(DTREQ/3600.) - IF ( MOD(NINT(DTREQ),3600) .NE. 0 ) GOTO 820 + IF ( MOD(NINT(DTREQ),3600) .NE. 0 ) THEN + WRITE (NDSE,1020) DTREQ + CALL EXTCDE ( 20 ) + END IF ELSE CINC = 'MN' IINC = NINT(DTREQ/60.) @@ -458,34 +469,9 @@ PROGRAM GXOUTP END DO ! WRITE (NDSCGR,974) - ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 10 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 11 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 12 ) - ! -820 CONTINUE - WRITE (NDSE,1020) DTREQ - CALL EXTCDE ( 20 ) - ! -821 CONTINUE - WRITE (NDSE,1021) - CALL EXTCDE ( 21 ) - ! -888 CONTINUE ! WRITE (NDSO,999) + STOP ! ! Formats ! @@ -552,22 +538,9 @@ PROGRAM GXOUTP ' ========================================='/ & ' WAVEWATCH III GrADS point output '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTP : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTP : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTP : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1020 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & ' FIELD INCREMENT > 1HR BUT NOT MULTIPLE',F10.0/) ! -1021 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/ & - ' UPDATE PARS IN LOOP 610 !!!'/) !/ !/ Internal subroutine GXEXPO ---------------------------------------- / !/ diff --git a/model/src/mod_fileio.f90 b/model/src/mod_fileio.f90 index b09081b9e2..74f58473d8 100644 --- a/model/src/mod_fileio.f90 +++ b/model/src/mod_fileio.f90 @@ -110,6 +110,7 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! ! 17/06/2002 Initialisation of IUNIT=-1 included ! 24/08/2002 Bug fixed when routine called with IUFIND=0 ! 08/02/2003 Bug fixed when file could not be created due to invalid path +! 04/07/2025 Remove labelled statements ! ! 1. Purpose ! @@ -209,7 +210,8 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! if(iufind/=0 .and. iufind/=1) then if(i_print >0) write(i_out,*) 'Z_FILEIO: Incorrect value for IUFIND:',iufind iostat = -5 - goto 9999 + if(i_print>=1) write(i_out,*) 'Z_FILEIO/Z:',trim(filename),' ',qual,iunit,iostat + return end if ! ! @@ -252,14 +254,12 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! else open(file=filename,unit=junit,form=cform,iostat=iostat) end if - if(iostat/=0) then - iostat = -4 - goto 9999 - end if + if(iostat/=0) iostat = -4 end if end if close(junit,status=cstat) - goto 9999 + if(i_print>=1) write(i_out,*) 'Z_FILEIO/Z:',trim(filename),' ',qual,iunit,iostat + return end if ! ! if the file exists, check if it is opened @@ -344,8 +344,6 @@ subroutine z_fileio(filename,qual,iufind,iunit,iostat) ! end if end if ! -9999 continue -! if(i_print>=1) write(i_out,*) 'Z_FILEIO/Z:',trim(filename),' ',qual,iunit,iostat ! return diff --git a/model/src/mod_xnl4v5.f90 b/model/src/mod_xnl4v5.f90 index 9cddd8d6c5..c5bc0900c7 100644 --- a/model/src/mod_xnl4v5.f90 +++ b/model/src/mod_xnl4v5.f90 @@ -500,6 +500,7 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & ! Compute size of points on locus, stored in KLOCUS ! 13/06/2003 Test parameters moved to Q_SETCONFIG ! 04/09/2003 Routine Q_SETVERSION added +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -618,12 +619,12 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & !------------------------------------------------------------------------------ if(iq_type<1 .or. iq_type>3) then ierr = 1 - goto 9999 + return end if ! if(iq_grid<1 .or. iq_grid>3) then ierr = 2 - goto 9999 + return end if ! ! Retrieve size of spectral grid from input @@ -649,14 +650,14 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & ! if(abs(dstep-dgap) < 0.001) then ierr = 31 - goto 9999 + return end if ! ! check if sector is symmetric around zero in the case of sector grid ! if(abs(dird(1)+dird(ndir)) > 0.01) then ierr = 32 - goto 9999 + return end if end if ! @@ -690,7 +691,7 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & if(iuerr/=0) then call q_error('e','FILEIO','Problem in deleting error file *.ERR') ierr = 4 - goto 9999 + return end if ! ! create new files, first create logging file @@ -720,7 +721,7 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & call q_setconfig(iquad) if (iq_err /=0) then ierr = 5 - goto 9999 + return end if !--------------------------------------------------------------------------------- ! check settings for inconsistencies @@ -728,7 +729,7 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & call q_chkconfig if (iq_err /=0) then ierr = 6 - goto 9999 + return end if !--------------------------------------------------------------------------------- ! determine minimum size of number of points on locus as stored in database @@ -761,7 +762,7 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & call q_ctrgrid(2,igrid) if(iq_err /= 0) then ierr = 7 - goto 9999 + return end if end if ! @@ -771,16 +772,6 @@ subroutine xnl_init(sigma,dird,nsigma,ndir,pftail,x_grav,depth,ndepth, & end if end do ! -! -! Create or open triplet output data file if iq_triq > 0 -! -! -9999 continue -! -!! if (iq_log ==0) call z_fileio(trim(qbase)//'.log','DF',iufind,luq_log,iuerr) -!! if (iq_prt ==0) call z_fileio(trim(qbase)//'.prt','DF',iufind,luq_prt,iuerr) -! -! return end subroutine xnl_init @@ -843,6 +834,7 @@ subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & ! 09/09/2002 Upgrade to release 5 ! 16/09/2002 Parameter IPROC included to take care of MPI processors ! 27/09/2002 Description of input argument SIGMA corrected +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -937,41 +929,43 @@ subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & if(q_depth < q_mindepth) then xnl = 0. call q_error('w','DEPTH','Zero transfer returned') - goto 9999 -end if -! -! check if iquad has changed since last call, this is no more allowed -! -!!if (iquad /= i_qlast .and. i_qmain/=1) then -!! call q_error('e','IQUAD','Value of IQUAD differs from initial value') -!! ierr = 1 -!! goto 9999 -!!end if -!-----------------------------------------------------------------------------+ -! main choice between various options | -!-----------------------------------------------------------------------------+ -! -if(iquad>=1 .and. iquad <=3) then -! - a = aspec - call q_xnl4v4(aspec,sigma,angle,nsig,ndir,depth,xnl,diag,ierr) -! - if(ierr/=0) then - call q_error('e','wrtvv','Problem in Q_XNL4V4') - goto 9999 - end if -!------------------------------------------------------------------------------ -! compute scale factor to include WAM depth scaling -!------------------------------------------------------------------------------ -! - if(iq_dscale ==1) then - call q_dscale(aspec,sigma,angle,nsig,ndir,depth,q_grav,q_dfac) -! - xnl = xnl*q_dfac -! - if(iq_prt >=1) write(luq_prt,'(a,f7.4)') 'XNL_MAIN depth scale factor:',q_dfac + ierr = 1 +else + ! + ! check if iquad has changed since last call, this is no more allowed + ! + !!if (iquad /= i_qlast .and. i_qmain/=1) then + !! call q_error('e','IQUAD','Value of IQUAD differs from initial value') + !! ierr = 1 + !!end if + !-----------------------------------------------------------------------------+ + ! main choice between various options | + !-----------------------------------------------------------------------------+ + ! + if(iquad>=1 .and. iquad <=3) then + ! + a = aspec + call q_xnl4v4(aspec,sigma,angle,nsig,ndir,depth,xnl,diag,ierr) + ! + if(ierr/=0) then + call q_error('e','wrtvv','Problem in Q_XNL4V4') + else + !------------------------------------------------------------------------------ + ! compute scale factor to include WAM depth scaling + !------------------------------------------------------------------------------ + ! + if(iq_dscale ==1) then + call q_dscale(aspec,sigma,angle,nsig,ndir,depth,q_grav,q_dfac) + ! + xnl = xnl*q_dfac + ! + if(iq_prt >=1) write(luq_prt,'(a,f7.4)') 'XNL_MAIN depth scale factor:',q_dfac + end if + end if end if end if + +if(ierr==0) then ! ! check conservation laws ! @@ -981,8 +975,7 @@ subroutine xnl_main(aspec,sigma,angle,nsig,ndir,depth,iquad,xnl,diag, & write(luq_prt,'(a)') 'XNL_MAIN: Conservation checks' write(luq_prt,'(a,4e13.5)') 'XNL_MAIN: E/A/MOMX/MOMY:',sum_e,sum_a,sum_mx,sum_my end if -! -9999 continue +end if ! ierr = iq_err ! @@ -1702,6 +1695,7 @@ subroutine q_cmplocus(ka,kb,km,kw,loclen) ! 12/06/2003 Call to Z_POYAREA added to check POLAR2 ! 08/08/2003 Check on areas only for loci with k3m/k1m < 100 ! Otherwise machine accuracy plays a role +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -1833,7 +1827,10 @@ subroutine q_cmplocus(ka,kb,km,kw,loclen) !------------------------------------------------------------------------------ ! call q_locpos(ka,kb,km,kw,loclen) - if(iq_err/=0) goto 9999 + if(iq_err/=0) then + call q_stack('-q_cmplocus') + return + end if ! ! compute position of start and end point for tracing ! the locus @@ -1860,7 +1857,8 @@ subroutine q_cmplocus(ka,kb,km,kw,loclen) call q_error('e','LOCUS','Severe problem in POLAR2') write(luq_err,'(a)') 'Q_CMPLOCUS: ratio > 1.5' ! - goto 9999 + call q_stack('-q_cmplocus') + return end if ! ! 01/10/2001 @@ -1923,8 +1921,6 @@ subroutine q_cmplocus(ka,kb,km,kw,loclen) end do ! ! -9999 continue -! call q_stack('-q_cmplocus') ! return @@ -2011,6 +2007,7 @@ subroutine q_ctrgrid(itask,igrid) ! 09/09/2003 Bug fixed in assigning IGRID=0 when BQF still in memory ! 13/09/2003 When BFQ incorrupt, it is deleted and a new one is created ! Bug fixed in setting of s_depth when iq_disp==1 +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -2142,7 +2139,8 @@ subroutine q_ctrgrid(itask,igrid) else call q_error('e','DISPER','Incorrect value for IQ_DISP') write(luq_err,'(a,i4)') 'IQ_DISP=',iq_disp - goto 9999 + call q_stack('-q_ctrgrid') + return end if ! ! @@ -2154,7 +2152,8 @@ subroutine q_ctrgrid(itask,igrid) if(lastquadfile==bqname) then if(iq_screen>0) write(iscreen,'(2a)') 'Q_CTRGRID: Rereading of bqfile skipped: ',lastquadfile igrid = 0 - goto 9999 + call q_stack('-q_ctrgrid') + return end if !------------------------------------------------------------------------------------------- if(iq_prt >= 2) then @@ -2240,7 +2239,7 @@ subroutine q_ctrgrid(itask,igrid) ! check spectral interaction grid and depth for consistency !--------------------------------------------------------------------------------------- if(.not. lq_grid) then -az: do iaz = 1,naz + do iaz = 1,naz if(abs(q_ad(iaz)-z_ad(iaz)) > 0.01) then write(luq_prt,'(a)') 'Q_CTRGRID: Directions do not agree' do jaz=1,naz @@ -2248,13 +2247,13 @@ subroutine q_ctrgrid(itask,igrid) end do lq_grid = .true. igrid = 2 - exit az + exit end if - end do az + end do end if ! if(.not. lq_grid) then -ak: do ikz = 1,nkz + do ikz = 1,nkz if(abs(q_sig(ikz)-z_sig(ikz)) > 0.01) then write(luq_prt,'(a)') 'Q_CTRGRID: Wave numbers do not agree' do jkz=1,nkz @@ -2262,9 +2261,9 @@ subroutine q_ctrgrid(itask,igrid) end do lq_grid = .true. igrid = 2 - exit ak + exit end if - end do ak + end do end if ! ! compare water depths @@ -2288,7 +2287,9 @@ subroutine q_ctrgrid(itask,igrid) !------------------------------------------------------------------------------ if(itask==1) then if(luq_bqf>0) call z_fclose(luq_bqf) - goto 9999 + if (allocated(z_ad)) deallocate(z_ad,z_sig) + call q_stack('-q_ctrgrid') + return end if !----------------------------------------------------------------------------- ! if lq_grid==true a new grid has to be generated @@ -2316,8 +2317,10 @@ subroutine q_ctrgrid(itask,igrid) q_depth = q_depth_saved ! if(iq_err /=0) then - lastquadfile = 'quad_err_.bqf' - goto 9999 + lastquadfile = 'quad_err_.bqf' + if (allocated(z_ad)) deallocate(z_ad,z_sig) + call q_stack('-q_ctrgrid') + return end if ! igrid = 0 @@ -2362,11 +2365,8 @@ subroutine q_ctrgrid(itask,igrid) end if ! -9999 continue -! if (allocated(z_ad)) deallocate(z_ad,z_sig) ! -! call q_stack('-q_ctrgrid') ! return @@ -2781,6 +2781,7 @@ subroutine q_getlocus(ik1,ia1,ik3,ia3,ifnd) ! 13/06/2003 Parameter t_cple, t_jac and t_sym assigned ! Bug fixed in nearest bin approach, symmetry regained ! 27/08/2003 Short-cut when number of points on locus is ZERO +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -2923,7 +2924,8 @@ subroutine q_getlocus(ik1,ia1,ik3,ia3,ifnd) if (amem > iamax) then ifnd = 0 call q_error('e','MEMORY','Incorrect addres') - goto 9999 + call q_stack('-q_getlocus') + return end if ! !----------------------------------------------------------------------------- @@ -2937,7 +2939,10 @@ subroutine q_getlocus(ik1,ia1,ik3,ia3,ifnd) ! ! short-cut when number of NON-ZERO points on locus is ZERO [27/8/2003] ! -if(nlocusx==0) goto 9999 +if(nlocusx==0) then + call q_stack('-q_getlocus') + return +end if ! r_ik2(1:nloc) = quad_ik2(kmem,amem,1:nloc) r_ia2(1:nloc) = quad_ia2(kmem,amem,1:nloc) @@ -3091,8 +3096,6 @@ subroutine q_getlocus(ik1,ia1,ik3,ia3,ifnd) ! !------------------------------------------------------------------------------ ! -9999 continue -! call q_stack('-q_getlocus') ! return @@ -3434,6 +3437,7 @@ subroutine q_locpos(ka,kb,km,kw,loclen) ! 09/08/2002 Upgrade to release 4.0 ! 29/08/2002 Error handling z_root2 relaxed and some write statements modified ! 07/10/2002 Initialisation of QSQ replaced +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -3595,7 +3599,8 @@ subroutine q_locpos(ka,kb,km,kw,loclen) ! if(iter>=maxiter) then call q_error('e','Start kb','Too many iterations needed') - goto 9999 + call q_stack('-q_locpos') + return end if ! ! search root by Ridders method @@ -3626,7 +3631,8 @@ subroutine q_locpos(ka,kb,km,kw,loclen) ! if(iter>=maxiter) then call q_error('e','Start ka','Too many iterations needed') - goto 9999 + call q_stack('-q_locpos') + return end if ! ! search root by Ridder's method @@ -3652,7 +3658,8 @@ subroutine q_locpos(ka,kb,km,kw,loclen) ! if(iter>=maxiter) then call q_error('e','Start kb','Too many iterations needed') - goto 9999 + call q_stack('-q_locpos') + return end if ! ! search root by Ridders method @@ -3742,9 +3749,6 @@ subroutine q_locpos(ka,kb,km,kw,loclen) loclen = 4.*max(aa,bb)*((1. + a1*mm1 + a2*mm1**2) + (b1*mm1 + b2*mm1**2)*log(1/mm1)) end if ! -! -9999 continue -! call q_stack('-q_locpos') ! return @@ -3798,6 +3802,7 @@ subroutine q_makegrid ! 10/09/2002 Upgrade to release 5 ! Value of LASTQUADFILE set ! 10/06/2003 Output to GRD file always without compacting +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -3862,6 +3867,7 @@ subroutine q_makegrid ! logical lwrite ! indicator if binary interaction grid has been written successfully real smax ! maximum s-value +logical failed ! indicates if the calculation failed ! real, allocatable :: xloc(:),yloc(:) real qq @@ -3895,78 +3901,87 @@ subroutine q_makegrid ! compute components of reference wave number, ! for setting up interaction grid !------------------------------------------------------------------------------------- -k1: do ikq1=1,nkq1 -! +failed = .false. +do ikq1=1,nkq1 + ! if(iq_screen==2) write(iscreen,*) 'k1-ring:',ikq1 -! + ! aa1 = q_ad(iaref) kk1 = q_k(ikq1) krefx = kk1*cos(q_ad(iaref)*dera) krefy = kk1*sin(q_ad(iaref)*dera) -! + ! k1x = krefx k1y = krefy -! - -k3: do ikq3 = ikq1,nkq ! - if(iq_screen==2) write(iscreen,*) 'k1-k3 indices:',ikq1,ikq3 -! + ! + do ikq3 = ikq1,nkq ! + if(iq_screen==2) write(iscreen,*) 'k1-k3 indices:',ikq1,ikq3 + ! kk3 = q_k(ikq3) -! -! -a3: do iaq3 = iag1,iag2 -! + ! + ! + do iaq3 = iag1,iag2 + ! if(iaq3 == iag1 .and. ikq3 == ikq1) cycle -! + ! aa3 = q_ad(iaq3) k3x = kk3*cos(aa3*dera) k3y = kk3*sin(aa3*dera) -!------------------------------------------------------------------------------ -! compute locus for a specified combination of k1 and k3 -! -!----------------------------------------------------------------------------- + !------------------------------------------------------------------------------ + ! compute locus for a specified combination of k1 and k3 + ! + !----------------------------------------------------------------------------- ia_k1 = iaq1; ik_k1 = ikq1 ia_k3 = iaq3; ik_k3 = ikq3 call q_cmplocus(ka,kb,km,kw,crf1) -! - if(iq_err/=0) goto 9999 -!------------------------------------------------------------------------------ -! redistibute or filter data points along locus -! + ! + if(iq_err/=0) then + failed = .true. + exit + end if + !------------------------------------------------------------------------------ + ! redistibute or filter data points along locus + ! call q_modify - if(iq_err > 0) goto 9999 -!------------------------------------------------------------------------------ -! compute weights for interpolation in computational grid -! + if(iq_err > 0) then + failed = .true. + exit + end if + !------------------------------------------------------------------------------ + ! compute weights for interpolation in computational grid + ! call q_weight - if(iq_err > 0) goto 9999 -!------------------------------------------------------------------------------ -! special storing mechanism for interactions per combination of k1 and k3 -! + if(iq_err > 0) then + failed = .true. + exit + end if + !------------------------------------------------------------------------------ + ! special storing mechanism for interactions per combination of k1 and k3 + ! kmem = (ikq3-ikq1+1) - (ikq1-2*nkq-2)*(ikq1-1)/2; jaq3 = iaq3-iaref+1 ! ensure that data stored in matrix start at index (1,1) amem = jaq3 ! index of direction -! -! -!------------------------------------------------------------------------------- -! Convert real indices to integer indexing and real weights -! -! 3-----------4 ja2p w1 = (1-wk)*(1-wa) -! | . | w2 = wk*(1-wa) -! |. . + . . .| wa2 A w3 = (1-wk)*wa -! | . | | w4 = wk*wa -! | . | wa -! | . | | -! 1-----------2 ja2 V -! jk2 wk2 jk2p -! -! <-wk-> -! -!------------------------------------------------------------------------------- + ! + ! + !------------------------------------------------------------------------------- + ! Convert real indices to integer indexing and real weights + ! + ! 3-----------4 ja2p w1 = (1-wk)*(1-wa) + ! | . | w2 = wk*(1-wa) + ! |. . + . . .| wa2 A w3 = (1-wk)*wa + ! | . | | w4 = wk*wa + ! | . | wa + ! | . | | + ! 1-----------2 ja2 V + ! jk2 wk2 jk2p + ! + ! <-wk-> + ! + !------------------------------------------------------------------------------- nzloc = 0 -! -loc: do iloc = 1,nlocus -! + ! + do iloc = 1,nlocus + ! ik2 = floor(wk_k2(iloc)) ia2 = floor(wa_k2(iloc)) wk = wk_k2(iloc)-real(ik2) @@ -3975,7 +3990,7 @@ subroutine q_makegrid w2k2 = wk*(1.-wa) w3k2 = (1.-wk)*wa w4k2 = wk*wa -! + ! ik4 = floor(wk_k4(iloc)) ia4 = floor(wa_k4(iloc)) wk = wk_k4(iloc)-real(ik4) @@ -3984,11 +3999,11 @@ subroutine q_makegrid w2k4 = wk*(1.-wa) w3k4 = (1.-wk)*wa w4k4 = wk*wa -! -! Take care of points that lie below lowest wave number -! when no geometric scaling is applied, then modify weights -! such that directional position is retained -! + ! + ! Take care of points that lie below lowest wave number + ! when no geometric scaling is applied, then modify weights + ! such that directional position is retained + ! if(iq_geom==0) then if(ik2 ==0) then ik2 = 1 @@ -4005,17 +4020,17 @@ subroutine q_makegrid w4k4 = 0. end if end if -! -! compute combined tail factor and product of coupling coefficient, step size, -! symmetry factor, and tail factor divided by jacobian -! + ! + ! compute combined tail factor and product of coupling coefficient, step size, + ! symmetry factor, and tail factor divided by jacobian + ! tfac = wt_k2(iloc)*wt_k4(iloc) quad_zz(kmem,amem,iloc) = cple_mod(iloc)*ds_mod(iloc)*sym_mod(iloc)/jac_mod(iloc)*tfac -! -!---------------------------------------------------------------------------------------- -! compact data by elimating zero-contribution on locus -!---------------------------------------------------------------------------------------- -! + ! + !---------------------------------------------------------------------------------------- + ! compact data by elimating zero-contribution on locus + !---------------------------------------------------------------------------------------- + ! if(iq_compact==1 .and. abs(quad_zz(kmem,amem,iloc)) > 1.e-15) then nzloc = nzloc + 1 jloc = nzloc @@ -4024,83 +4039,86 @@ subroutine q_makegrid jloc = iloc end if nztot2 = nztot2 + 1 -! -! shift data -! + ! + ! shift data + ! quad_zz(kmem,amem,jloc) = quad_zz(kmem,amem,iloc) -! + ! quad_ik2(kmem,amem,jloc) = ik2 ! lower wave number index of k2 quad_ia2(kmem,amem,jloc) = ia2 ! lower direction index of k2 quad_ik4(kmem,amem,jloc) = ik4 ! lower wave number index of k4 quad_ia4(kmem,amem,jloc) = ia4 ! lower direction index of k4 -! + ! quad_w1k2(kmem,amem,jloc) = w1k2 ! weight 1 of k2 quad_w2k2(kmem,amem,jloc) = w2k2 ! weight 2 of k2 quad_w3k2(kmem,amem,jloc) = w3k2 ! weight 3 of k2 quad_w4k2(kmem,amem,jloc) = w4k2 ! weight 4 of k2 -! + ! quad_w1k4(kmem,amem,jloc) = w1k4 ! weight 1 of k4 quad_w2k4(kmem,amem,jloc) = w2k4 ! weight 2 of k4 quad_w3k4(kmem,amem,jloc) = w3k4 ! weight 3 of k4 quad_w4k4(kmem,amem,jloc) = w4k4 ! weight 4 of k4 -! -! - end do loc -! + ! + ! + end do + ! if(iq_compact==1) then quad_nloc(kmem,amem) = nzloc ! store compacted number of points on locus else quad_nloc(kmem,amem) = nlocus ! store number of points on locus nzloc = nlocus end if + ! + ! write(luq_prt,'(a,4i5)') 'Q_MAKEGRID kmem amem nlocus:',kmem,amem,nlocus,nzloc + ! + end do + if (failed) exit + end do + if (failed) exit +end do ! -! write(luq_prt,'(a,4i5)') 'Q_MAKEGRID kmem amem nlocus:',kmem,amem,nlocus,nzloc -! - end do a3 - end do k3 -end do k1 -!------------------------------------------------------------------------------ -! Write locus information to binary file -!------------------------------------------------------------------------------ -! -write(luq_bqf) q_header -! -!------------------------------------------------------------------------------ -! spectral interaction grid -!------------------------------------------------------------------------------ -! -write(luq_bqf) naq,nkq -write(luq_bqf) q_sig -write(luq_bqf) q_ad -write(luq_bqf) iq_geom,iq_disp,iq_geom -write(luq_bqf) q_depth -! -!------------------------------------------------------------------------------ -! interaction grid -!------------------------------------------------------------------------------ -! -write(luq_bqf) quad_nloc -write(luq_bqf) quad_ik2 -write(luq_bqf) quad_ia2 -write(luq_bqf) quad_ik4 -write(luq_bqf) quad_ia4 -write(luq_bqf) quad_w1k2 -write(luq_bqf) quad_w2k2 -write(luq_bqf) quad_w3k2 -write(luq_bqf) quad_w4k2 -write(luq_bqf) quad_w1k4 -write(luq_bqf) quad_w2k4 -write(luq_bqf) quad_w3k4 -write(luq_bqf) quad_w4k4 -write(luq_bqf) quad_zz -! -! -lwrite = .true. -lastquadfile = bqname -! -if(iq_screen >= 1 .and. iq_test>=1) write(iscreen,'(2a)') 'q_makegrid: LASTQUADFILE: ',lastquadfile -! -9999 continue +if (.not. failed) then + !------------------------------------------------------------------------------ + ! Write locus information to binary file + !------------------------------------------------------------------------------ + ! + write(luq_bqf) q_header + ! + !------------------------------------------------------------------------------ + ! spectral interaction grid + !------------------------------------------------------------------------------ + ! + write(luq_bqf) naq,nkq + write(luq_bqf) q_sig + write(luq_bqf) q_ad + write(luq_bqf) iq_geom,iq_disp,iq_geom + write(luq_bqf) q_depth + ! + !------------------------------------------------------------------------------ + ! interaction grid + !------------------------------------------------------------------------------ + ! + write(luq_bqf) quad_nloc + write(luq_bqf) quad_ik2 + write(luq_bqf) quad_ia2 + write(luq_bqf) quad_ik4 + write(luq_bqf) quad_ia4 + write(luq_bqf) quad_w1k2 + write(luq_bqf) quad_w2k2 + write(luq_bqf) quad_w3k2 + write(luq_bqf) quad_w4k2 + write(luq_bqf) quad_w1k4 + write(luq_bqf) quad_w2k4 + write(luq_bqf) quad_w3k4 + write(luq_bqf) quad_w4k4 + write(luq_bqf) quad_zz + ! + ! + lwrite = .true. + lastquadfile = bqname + ! + if(iq_screen >= 1 .and. iq_test>=1) write(iscreen,'(2a)') 'q_makegrid: LASTQUADFILE: ',lastquadfile +end if ! if(allocated(xloc)) deallocate(xloc,yloc) ! @@ -4178,6 +4196,7 @@ subroutine q_modify ! 6/06/2003 Activate output to XDIA configuration file ! 10/06/2003 Conversion to new indexing and lumping debugged ! 11/06/2003 Call to subroutine Q_SYMMETRY added +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -4466,7 +4485,9 @@ subroutine q_modify if(jerr > 0) then iq_err = iq_err + 1 call q_error('e','INTER','Problem in interpolation process') - goto 9999 + if(allocated(sold)) deallocate(sold,snew) + call q_stack('-q_modify') + return end if end if ! @@ -4503,9 +4524,6 @@ subroutine q_modify ! end do ! -! -9999 continue -! if(allocated(sold)) deallocate(sold,snew) ! call q_stack('-q_modify') @@ -4558,6 +4576,7 @@ subroutine q_polar2(kmin,kmax,kx_beg,ky_beg,kx_end,ky_end,loclen,ierr) ! 08/08/2003 Check included for maximum number of IPOL by using MPOL ! MPOL=MLOCUS/2+1-1 (-1 added regarding IPOL=IPOL+1 in Q_MODIFY) ! Check included on ARG=0 for IQ_LOCUS=2 and parameter dke added +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -4767,9 +4786,6 @@ subroutine q_polar2(kmin,kmax,kx_beg,ky_beg,kx_end,ky_end,loclen,ierr) y2_loc(ipol) = k_pol(ipol)*sin(a_pol(ipol)) end do ! -! -9999 continue -! call q_stack('-q_polar2') ! return @@ -4832,6 +4848,7 @@ subroutine q_setconfig(iquad) ! 13/06/2003 Set test output, from XNL_INIT ! 16/06/2003 Switch IQ_SYM added ! 09/09/2003 Variable ID_FACMAX added +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -4945,7 +4962,8 @@ subroutine q_setconfig(iquad) if(iq_screen>0) write(iscreen,'(a,i4)') 'Q_SETCONFIG: iquad=',iquad call q_error('e','IQUAD','No valid value of iquad has been given, default settings') write(luq_err,'(a,i4)') 'Q_SETCONFIG: Value of IQUAD:',iquad - goto 9999 + call q_stack('-q_setconfig') + return end if !------------------------------------------------------------------------------------------------- ! @@ -5028,8 +5046,6 @@ subroutine q_setconfig(iquad) end if end if ! -9999 continue -! call q_stack('-q_setconfig') ! return @@ -5069,6 +5085,7 @@ subroutine q_searchgrid(depth,igrid) ! 5/09/2003 Search algorithm improved ! 09/09/2003 factor ID_FACMAX introduced and extra test output created ! Input water depth saved for output +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -5144,7 +5161,11 @@ subroutine q_searchgrid(depth,igrid) if(iq_screen>=1) write(iscreen,'(a)') 'Q_SEARCHGRID: grid accepted, read whole database' ! call q_ctrgrid(2,igrid) - goto 9999 + ! + ! restore water depth + q_depth = s_depth + call q_stack('-q_searchgrid') + return end if ! ! save depth for which nearest grid file is to be found @@ -5231,7 +5252,11 @@ subroutine q_searchgrid(depth,igrid) q_depth = d_upper else call q_error('e','SEARCHGRID','No valid nearest grid could be found') - goto 9999 + ! + ! restore water depth + q_depth = s_depth + call q_stack('-q_searchgrid') + return end if ! !----------------------------------------------------------------------------------------------- @@ -5256,8 +5281,6 @@ subroutine q_searchgrid(depth,igrid) write(luq_prt,'(a,i4)') 'Q_SEARCHGRID: igrid of nearest grid operation:',igrid end if ! -9999 continue -! ! restore water depth ! q_depth = s_depth @@ -5327,6 +5350,7 @@ subroutine q_stack(mod_name) ! 13/10/1999 Error handling improved ! 08/08/2002 Upgrade to release 4 ! 11/06/2003 Extra check on output to print or test file +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -5389,7 +5413,7 @@ subroutine q_stack(mod_name) ! if(iq_stack > mq_stack) then call q_error('e','STACKMAX',' ') - goto 9999 + return else cstack(iq_stack) = mod_name(2:mod_len) end if @@ -5403,17 +5427,12 @@ subroutine q_stack(mod_name) else write(luq_err,'(a)') 'Module name:',mod_name call q_error('e','STACKNAME',' ') - goto 9999 + return end if else call q_error('e','STACKCALL',' ') - goto 9999 end if ! -!!\Z -! -9999 continue -! return end subroutine !------------------------------------------------------------------------------ @@ -5450,6 +5469,7 @@ subroutine q_summary ! 11/06/2003 Initial version ! Parameter iq_space removed ! 16/06/2003 Switch IQ_SYM added +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -5621,8 +5641,6 @@ subroutine q_summary write(luq_prt,'(a)') '----------------------------------------------' end if ! -9999 continue -! call q_stack('-q_summary') ! return @@ -5776,6 +5794,7 @@ subroutine q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) ! diagonal term ! 27/08/2003 Short-cut when number of non-zero points on locus is ZERO ! 05/09/2003 Switches for test output in nearest bin approach modified +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -5859,7 +5878,10 @@ subroutine q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) diagk3 = 0. ! ! -if(ik1==ik3 .and. ia1==ia3) goto 9999 ! skip routine if k1=k3 +if(ik1==ik3 .and. ia1==ia3) then ! skip routine if k1=k3 + call q_stack('-q_t13v4') + return +end if ! ! obtain information requested locus based on a information ! about a precomputed locus, as stored in the database file @@ -5868,7 +5890,8 @@ subroutine q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) ! if(ifnd==0 .or. nlocusx==0) then t13 = 0. - goto 9999 + call q_stack('-q_t13v4') + return end if !--------------------------------------------------------------------------------------- qn1 = nspec(ik1,ia1) @@ -5978,8 +6001,6 @@ subroutine q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) !!if(iq_integ==3) write(luq_int,'(4i3,i5,1000e13.5)') ik1,ia1,ik3,ia3,nloc, & !!& t_s(nloc),t13,(dt13(iloc),iloc=1,nloc) ! -9999 continue -! call q_stack('-q_t13v4') ! return @@ -6017,6 +6038,7 @@ subroutine q_weight ! 09/08/2002 Modification of weights ! 13/08/2002 storage of log-spacing replace by linear spacing ! 20/08/2002 Bug fixed when geometric scaling is assumed +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -6191,8 +6213,6 @@ subroutine q_weight ! end do ! -9999 continue -! call q_stack('-q_weight') ! return @@ -6402,6 +6422,7 @@ subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) ! Allocation of dynamic data array's moved to Q_ALLOCATE ! 24/06/2003 Range of loop for IK3 made dependent on value of IQ_SYM ! 25/06/2003 Bug fixed in assigment of contribution of diagonal term +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -6535,16 +6556,21 @@ subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) if(iq_search==0 .or. iq_type/=3) then call q_init call q_ctrgrid(2,igrid) - if(iq_err /= 0) goto 9999 + if(iq_err /= 0) then + call q_stack('-q_xnl4v4') + return + end if ! if(igrid/=0) then call q_error('e','NOGRID','No proper grid exists') - goto 9999 + call q_stack('-q_xnl4v4') + return end if ! if(iq_make ==3) then call q_error('e','MAKEGRID','Only computation of grid') - goto 9999 + call q_stack('-q_xnl4v4') + return end if !------------------------------------------------------------------------------ ! set overall scale factor resulting from optional SEARCH for nearest grid @@ -6562,10 +6588,14 @@ subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) if(igrid/=0) then call q_error('e','NOGRID','No proper grid exists') - goto 9999 + call q_stack('-q_xnl4v4') + return end if ! - if(iq_err /=0) goto 9999 + if(iq_err /=0) then + call q_stack('-q_xnl4v4') + return + end if end if ! !------------------------------------------------------------------------------ @@ -6643,7 +6673,10 @@ subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) call q_t13v4(ik1,ia1,ik3,ia3,t13,diagk1,diagk3) ! ! - if(iq_err /= 0) goto 9999 + if(iq_err /= 0) then + call q_stack('-q_xnl4v4') + return + end if ! ! check contribution T13 with the computed with triplet method ! @@ -6730,8 +6763,6 @@ subroutine q_xnl4v4(aspec,sigma,angle,nsig,nang,depth,xnl,diag,ierr) end do end do ! ! -9999 continue -! call q_stack('-q_xnl4v4') ! return @@ -6870,6 +6901,7 @@ real function x_cple(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,iq_cple,depth,grav) ! type and depth via interface ! 09/08/2002 Upgrade to release 4.0 ! 10/09/2002 g included in interface +! 04/07/2025 Remove labelled statements ! ! 1. Purpose: ! @@ -6923,7 +6955,7 @@ real function x_cple(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,iq_cple,depth,grav) !------------------------------------------------------------------------------ if (iq_cple < 1 .or. iq_cple > 4) then x_cple = 0. - goto 9999 + return end if ! select case(iq_cple) @@ -6943,8 +6975,6 @@ real function x_cple(k1x,k1y,k2x,k2y,k3x,k3y,k4x,k4y,iq_cple,depth,grav) ! end select ! -9999 continue -! return end function !------------------------------------------------------------------------------ diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index b386b8786a..d8fe242699 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -450,7 +450,6 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) USE W3WDATMD, ONLY : VA USE W3GDATMD, ONLY: NSEAL USE W3ADATMD, ONLY: NSEALM - USE W3SERVMD, ONLY : EXTCDE #ifdef W3_TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME #endif @@ -809,7 +808,6 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) ! 4. Subroutines used : ! USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA, WADATS - USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NSEA USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF USE W3WDATMD, ONLY: VA, UST, USTDIR, ASF, FPIS diff --git a/model/src/serv_xnl4v5.f90 b/model/src/serv_xnl4v5.f90 index 71334672fc..f6d38c141d 100644 --- a/model/src/serv_xnl4v5.f90 +++ b/model/src/serv_xnl4v5.f90 @@ -17,26 +17,27 @@ SUBROUTINE y_gauleg(x1,x2,x,w,n) m=(n+1)/2 xm=0.5d0*(x2+x1) xl=0.5d0*(x2-x1) - do 12 i=1,m + do i=1,m z=cos(3.141592654d0*(i-.25d0)/(n+.5d0)) -1 continue + do p1=1.d0 p2=0.d0 - do 11 j=1,n + do j=1,n p3=p2 p2=p1 p1=((2.d0*j-1.d0)*z*p2-(j-1.d0)*p3)/j -11 continue + end do pp=n*(z*p1-p2)/(z*z-1.d0) z1=z z=z1-p1/pp - if(abs(z-z1).gt.EPS)goto 1 + if(abs(z-z1).le.EPS) exit + end do x(i)=xm-xl*z x(n+1-i)=xm+xl*z w(i)=2.d0*xl/((1.d0-z*z)*pp*pp) w(n+1-i)=w(i) -12 continue + end do ! return END subroutine @@ -118,6 +119,7 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! ! 18/01/2001 Check include if n1==1 ! 24/01/2001 Check for equality of y2 data loosened if n2==1 ! 13/09/2001 Documentation updated +! 04/07/2025 Remove labelled statements ! ! 1. Purpose ! @@ -193,7 +195,7 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! ! if(n1==1) then y2 = y1(1) - goto 9999 + return end if ! ! check minimum and maximum data values @@ -205,12 +207,12 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! ! if (abs(xmin1-xmax1) < eps .or. abs(x1(1)-x1(n1)) < eps) then ierr = 2 - goto 9999 + return end if ! if ((abs(xmin2-xmax2) < eps .or. abs(x2(1)-x2(n2)) < eps) .and. n2 > 1) then ierr = 3 - goto 9999 + return end if ! ! check input data for monotonicity @@ -220,7 +222,7 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! if(x1(i1) > x1(i1+1)) then ierr=1 write(*,*) 'z_intp1: i1 x1(i1) x1(i1+1):',i1,x1(i1),x1(i1+1) - goto 9999 + return end if end do ! @@ -228,7 +230,7 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! if(x2(i2) > x2(i2+1)) then ierr=ierr+10 write(*,*) 'z_intp1: i2 x2(i2) x2(i2+1):',i2,x2(i2),x2(i2+1) - goto 9999 + return end if end do ! @@ -237,7 +239,7 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! if(x1(i1) < x1(i1+1)) then ierr=2 write(*,*) 'z_intp1: i1 x1(i1) x1(i1+1):',i1,x1(i1),x1(i1+1) - goto 9999 + return end if end do ! @@ -245,7 +247,7 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! if(x2(i2) < x2(i2+1)) then ierr=ierr + 20 write(*,*) 'z_intp1: i2 x2(i2) x2(i2+1):',i2,x2(i2),x2(i2+1) - goto 9999 + return end if end do end if @@ -281,8 +283,6 @@ subroutine z_intp1(x1,y1,x2,y2,n1,n2,ierr) ! end do end if ! -9999 continue -! return end subroutine ! @@ -446,6 +446,7 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) ! 0.02 07/11/1999 Test added to check boundaries, and reverse if necessary ! Bug fixed in assigning answer ! 0.03 02/09/2002 Maximum number of iterations set to 20, instead of 10 +! X.XX 04/07/2025 Remove labelled statements ! ! 1. Purpose ! @@ -523,6 +524,7 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) real xl ! lower boundary of interval real xm ! middle point of interval real xnew ! new estimate according to Ridders method +logical success ! indicates a successful calculation ! ierr = 0 ! set error level unused =-1.11e30 ! set start value @@ -554,6 +556,7 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) !if(luprint > 0) write(luprint,'(a,4e13.5)') & !& 'Z_ROOT2: xx1 xx2 fl fh:',xx1,xx2,fl,fh ! +success = .false. if((fl > 0. .and. fh < 0.) .or. (fl < 0. .and. fh > 0.))then xl = xx1 xh = xx2 @@ -563,7 +566,10 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) xm = 0.5*(xl+xh) fm = func(xm) s = sqrt(fm**2-fl*fh) - if(s == 0.) goto 9000 + if(s == 0.) then + success = .true. + exit + end if xnew = xm+(xm-xl)*(sign(1.,fl-fh)*fm/s) ! ! if(luprint>0) write(luprint,'(a,4e13.5)') & @@ -571,12 +577,16 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) ! if (abs(xnew-zriddr) <= xacc) then ! if(luprint>0) write(luprint,'(a)') 'Z_ROOT2: xnew=zriddr' - goto 9000 + success = .true. + exit end if ! zriddr = xnew fnew = func(zriddr) - if (fnew == 0.) goto 9000 + if (fnew == 0.) then + success = .true. + exit + end if ! if(sign(fm,fnew) /= fm) then xl = xm @@ -591,36 +601,38 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) fl = fnew else ierr = 1 - goto 9000 + success = .true. + exit endif ! - if(abs(xh-xl) <= xacc) goto 9000 + if(abs(xh-xl) <= xacc) then + success = .true. + exit + end if ! if(luprint > 0) write(luprint,'(a,i4,5e14.6)') & & 'Z_ROOT2: iter,x1,x2,|x1-x2|,xacc,z:', iter,xl,xh,abs(xl-xh),xacc,fnew ! end do - ierr = 2 - if(luprint > 0) write(luprint,'(a)') 'Z_ROOT2: -> ierr=2' - goto 9000 + if (.not. success) then + ierr = 2 + if(luprint > 0) write(luprint,'(a)') 'Z_ROOT2: -> ierr=2' + end if else if (fl == 0.) then zriddr = xx1 else if (fh == 0.) then zriddr = xx2 else ierr = 3 - goto 9999 + return ! 'root must be bracketed in zriddr' endif ! -9000 continue -! z_root2 = zriddr ! if(luprint > 0) write(luprint,'(a,2i3,5e13.5)') & & 'Z_ROOT2: ierr,iter,xl,xh,acc,x0,z0:', ierr,iter,xl,xh,xacc,z_root2,func(z_root2) ! -9999 continue ! return end function diff --git a/model/src/w3arrymd.F90 b/model/src/w3arrymd.F90 index 845d6ccae5..7c810ed08e 100644 --- a/model/src/w3arrymd.F90 +++ b/model/src/w3arrymd.F90 @@ -89,6 +89,7 @@ SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 20-Jan-2017 : Add error exit using EXTCDE. ( version 6.02 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -147,7 +148,7 @@ SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTIOF ! IMPLICIT NONE !/ @@ -195,20 +196,22 @@ SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & IF (IIDFM.EQ.1) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,*,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,*,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,*,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,*,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END IF ! ! Fixed format read : @@ -216,20 +219,22 @@ SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDFM.EQ.2) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,RFORM,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,RFORM,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,RFORM,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,RFORM,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END IF ! ! Unformat read : @@ -237,20 +242,22 @@ SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDLA.EQ.1) THEN DO IY=LY, HY - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END IF END IF ! @@ -264,24 +271,8 @@ SUBROUTINE INA2R (ARRAY, MX, MY, LX, HX, LY, HY, & ! RETURN ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,900) - CALL EXTCDE ( ISTAT ) - ! -801 CONTINUE - WRITE (NDSE,901) ISTAT - CALL EXTCDE ( ISTAT ) - ! ! Formats ! -900 FORMAT (/' *** ERROR INA2R : '/ & - ' PREMATURE END OF FILE'/) -901 FORMAT (/' *** ERROR INA2R : '/ & - ' ERROR IN READING FROM FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST INA2R : INPUT :'/6X,8I4,2I3,1X,A,I3,2E12.4) #endif @@ -306,6 +297,7 @@ SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 20-Jan-2017 : Add error exit using EXTCDE. ( version 6.02 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -318,7 +310,7 @@ SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTIOF ! IMPLICIT NONE !/ @@ -365,20 +357,22 @@ SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & IF (IIDFM.EQ.1) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,*,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,*,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,*,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END DO ELSE - READ (NDS,*,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,*,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END IF ! ! Fixed format read : @@ -386,20 +380,22 @@ SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDFM.EQ.2) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,RFORM,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,RFORM,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,RFORM,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END DO ELSE - READ (NDS,RFORM,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,RFORM,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END IF ! ! Unformat read : @@ -407,20 +403,22 @@ SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDLA.EQ.1) THEN DO IY=LY, HY - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & - (ARRAY(IX,IY),IX=LX,HX) + READ (NDS,IOSTAT=ISTAT) (ARRAY(IX,IY),IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END DO ELSE - READ (NDS,END=800,ERR=801,IOSTAT=ISTAT) & + READ (NDS,IOSTAT=ISTAT) & ((ARRAY(IX,IY),IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2I','',ISTAT) END IF END IF ! @@ -434,24 +432,8 @@ SUBROUTINE INA2I (ARRAY, MX, MY, LX, HX, LY, HY, & ! RETURN ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,900) - CALL EXTCDE ( ISTAT ) - ! -801 CONTINUE - WRITE (NDSE,901) ISTAT - CALL EXTCDE ( ISTAT ) - ! ! Formats ! -900 FORMAT (/' *** ERROR INA2I : '/ & - ' PREMATURE END OF FILE'/) -901 FORMAT (/' *** ERROR INA2I : '/ & - ' ERROR IN READING FROM FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST INA2I : INPUT :'/6X,8I4,2I3,1X,A,I3,2I5) #endif @@ -478,6 +460,7 @@ SUBROUTINE OUTA2R (ARRAY, MX, MY, LX, HX, LY, HY, & !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 20-Jan-2017 : Add error exit using EXTCDE. ( version 6.02 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -494,7 +477,7 @@ SUBROUTINE OUTA2R (ARRAY, MX, MY, LX, HX, LY, HY, & #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTIOF ! IMPLICIT NONE !/ @@ -541,20 +524,22 @@ SUBROUTINE OUTA2R (ARRAY, MX, MY, LX, HX, LY, HY, & IF (IIDFM.EQ.1) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,*,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END DO ELSE IF (IIDLA.EQ.2) THEN - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,*,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,INT(HX/VSC)),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,*,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END DO ELSE - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,*,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END IF ! ! Fixed format write : @@ -562,20 +547,22 @@ SUBROUTINE OUTA2R (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDFM.EQ.2) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,RFORM,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END DO ELSE IF (IIDLA.EQ.2) THEN - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,RFORM,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,RFORM,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END DO ELSE - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,RFORM,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END IF ! ! Unformat write : @@ -583,37 +570,28 @@ SUBROUTINE OUTA2R (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDLA.EQ.1) THEN DO IY=LY, HY - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END DO ELSE IF (IIDLA.EQ.2) THEN - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & - (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) + WRITE (NDS,IOSTAT=ISTAT) (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END DO ELSE - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'OUTA2R','',ISTAT,ISWRITE=.TRUE.) END IF END IF ! RETURN ! - ! Escape locations write errors : - ! -800 CONTINUE - WRITE (NDSE,900) ISTAT - CALL EXTCDE ( ISTAT ) - ! ! Formats ! -900 FORMAT (/' *** ERROR OUTA2R : '/ & - ' ERROR IN WRITING TO FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST OUTA2R : INPUT :'/6X,8I4,2I3,1X,A,I3,2E12.4) #endif @@ -637,6 +615,7 @@ SUBROUTINE OUTA2I (ARRAY, MX, MY, LX, HX, LY, HY, & !/ 30-Oct-2009 : Implement add offset argument. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 20-Jan-2017 : Add error exit using EXTCDE. ( version 6.02 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -649,7 +628,7 @@ SUBROUTINE OUTA2I (ARRAY, MX, MY, LX, HX, LY, HY, & #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTIOF ! IMPLICIT NONE !/ @@ -696,20 +675,22 @@ SUBROUTINE OUTA2I (ARRAY, MX, MY, LX, HX, LY, HY, & IF (IIDFM.EQ.1) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,*,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,*,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,*,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE - WRITE (NDS,*,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,*,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END IF ! ! Fixed format write : @@ -717,20 +698,22 @@ SUBROUTINE OUTA2I (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDFM.EQ.2) THEN IF (IIDLA.EQ.1) THEN DO IY=LY, HY - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,RFORM,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,RFORM,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,RFORM,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE - WRITE (NDS,RFORM,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,RFORM,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END IF ! ! Unformat write : @@ -738,37 +721,29 @@ SUBROUTINE OUTA2I (ARRAY, MX, MY, LX, HX, LY, HY, & ELSE IF (IIDLA.EQ.1) THEN DO IY=LY, HY - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE IF (IIDLA.EQ.2) THEN - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=LY,HY) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) ELSE IF (IIDLA.EQ.3) THEN DO IY=HY, LY, -1 - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & - ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + WRITE (NDS,IOSTAT=ISTAT) ((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END DO ELSE - WRITE (NDS,ERR=800,IOSTAT=ISTAT) & + WRITE (NDS,IOSTAT=ISTAT) & (((ARRAY(IX,IY)-VOF)/VSC,IX=LX,HX),IY=HY,LY,-1) + IF (ISTAT.NE.0) CALL EXTIOF(NDSE,ISTAT,'INA2R','',ISTAT) END IF END IF ! RETURN ! - ! Escape locations write errors : - ! -800 CONTINUE - WRITE (NDSE,900) ISTAT - CALL EXTCDE ( ISTAT ) - ! ! Formats ! -900 FORMAT (/' *** ERROR OUTA2I : '/ & - ' ERROR IN WRITING TO FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST OUTA2I : INPUT :'/6X,8I4,2I3,1X,A,I3,2I5) #endif diff --git a/model/src/w3bullmd.F90 b/model/src/w3bullmd.F90 index c85b620c42..9c0b385ca9 100644 --- a/model/src/w3bullmd.F90 +++ b/model/src/w3bullmd.F90 @@ -101,6 +101,7 @@ SUBROUTINE W3BULL & !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 ) !/ 15-Aug-2011 : Adjustments to version 4.05 ( version 4.05 ) !/ 11-Mar-2013 : Minor cleanup ( version 4.09 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -360,115 +361,114 @@ SUBROUTINE W3BULL & IF ( HSTOT .GT. 0. ) WRITE (CASCBLINE(6:7),'(I2)') NINT(HSTOT/0.3048) #endif ! - IF ( NPART.EQ.0 .OR. HSTOT.LT.0.1 ) GOTO 699 ! ! 5.b Switch off peak with too low wave height ! - DO IP=1, NPART - FLAG(IP) = HSP(IP) .GT. BHSMIN - ENDDO - ! - ! 5.c Find next highest wave height - ! - INOTAB = 0 - ! -601 CONTINUE - ! - HMAX = 0. - IPNOW = 0 - DO IP=1, NPART - IF ( HSP(IP).GT.HMAX .AND. FLAG(IP) ) THEN - IPNOW = IP - HMAX = HSP(IP) - ENDIF - ENDDO - ! - ! 5.d No more peaks, skip to output - ! - IF ( IPNOW .EQ. 0 ) GOTO 699 - ! - ! 5.e Find matching field - ! - ITAB = 0 - ! - DO IP=1, NPTAB - IF ( TPT(IP,2) .GT. 0. ) THEN - ! - DELHS = ABS ( HST(IP,2) - HSP(IPNOW) ) - DELTP = ABS ( TPT(IP,2) - TPP(IPNOW) ) - DELDM = ABS ( DMT(IP,2) - DMP(IPNOW) ) - IF ( DELDM .GT. 180. ) DELDM = 360. - DELDM - IF ( DELHS.LT.DHSMAX .AND. & - DELTP.LT.DTPMAX .AND. & - DELDM.LT.DDMMAX ) ITAB = IP - ! - ENDIF - ENDDO - ! - ! 5.f No matching field, find empty fields - ! - IF ( ITAB .EQ. 0 ) THEN - DO IP=NPTAB, 1, -1 - IF ( TPT(IP,1).LT.0. .AND. TPT(IP,2).LT.0. ) & - ITAB = IP + IF ( NPART.NE.0 .AND. HSTOT.GE.0.1 ) THEN + DO IP=1, NPART + FLAG(IP) = HSP(IP) .GT. BHSMIN ENDDO - ENDIF - ! - ! 5.g Slot in table found, write - ! - ! Remove clear windseas - ! - IF ( ITAB .NE. 0 ) THEN ! - WRITE (PART,'(1X,F5.2,F5.1,I4)') & - HSP(IPNOW), TPP(IPNOW), NINT(DMP(IPNOW)) + ! 5.c Find next highest wave height + ! + INOTAB = 0 + ! + DO + ! + HMAX = 0. + IPNOW = 0 + DO IP=1, NPART + IF ( HSP(IP).GT.HMAX .AND. FLAG(IP) ) THEN + IPNOW = IP + HMAX = HSP(IP) + ENDIF + ENDDO + ! + ! 5.d No more peaks, skip to output + ! + IF ( IPNOW .EQ. 0 ) EXIT + ! + ! 5.e Find matching field + ! + ITAB = 0 + ! + DO IP=1, NPTAB + IF ( TPT(IP,2) .GT. 0. ) THEN + ! + DELHS = ABS ( HST(IP,2) - HSP(IPNOW) ) + DELTP = ABS ( TPT(IP,2) - TPP(IPNOW) ) + DELDM = ABS ( DMT(IP,2) - DMP(IPNOW) ) + IF ( DELDM .GT. 180. ) DELDM = 360. - DELDM + IF ( DELHS.LT.DHSMAX .AND. & + DELTP.LT.DTPMAX .AND. & + DELDM.LT.DDMMAX ) ITAB = IP + ! + ENDIF + ENDDO + ! + ! 5.f No matching field, find empty fields + ! + IF ( ITAB .EQ. 0 ) THEN + DO IP=NPTAB, 1, -1 + IF ( TPT(IP,1).LT.0. .AND. TPT(IP,2).LT.0. ) & + ITAB = IP + ENDDO + ENDIF + ! + ! 5.g Slot in table found, write + ! + ! Remove clear windseas + ! + IF ( ITAB .NE. 0 ) THEN + ! + WRITE (PART,'(1X,F5.2,F5.1,I4)') & + HSP(IPNOW), TPP(IPNOW), NINT(DMP(IPNOW)) #ifdef W3_NCO - WRITE (CPART,'(I2,1X,I2.2,1X,I3.3)') & - NINT(HSP(IPNOW)/0.3048), & - NINT(TPP(IPNOW)), & - NINT(MOD(DMP(IPNOW)+180.,360.)) + WRITE (CPART,'(I2,1X,I2.2,1X,I3.3)') & + NINT(HSP(IPNOW)/0.3048), & + NINT(TPP(IPNOW)), & + NINT(MOD(DMP(IPNOW)+180.,360.)) #endif - DELDW = MOD ( ABS ( UDIR - DMP(IPNOW) ) , 360. ) - IF ( DELDW .GT. 180. ) DELDW = 360. - DELDW - AFR = 2.*PI/TPP(IPNOW) - AGE = UABS * WNP(IPNOW) / AFR - IF ( DELDW.LT.DDWMAX .AND. AGE.GT.AGEMIN ) PART(1:1) = '*' - ! - ASCBLINE(5+ITAB*18:19+ITAB*18) = PART + DELDW = MOD ( ABS ( UDIR - DMP(IPNOW) ) , 360. ) + IF ( DELDW .GT. 180. ) DELDW = 360. - DELDW + AFR = 2.*PI/TPP(IPNOW) + AGE = UABS * WNP(IPNOW) / AFR + IF ( DELDW.LT.DDWMAX .AND. AGE.GT.AGEMIN ) PART(1:1) = '*' + ! + ASCBLINE(5+ITAB*18:19+ITAB*18) = PART #ifdef W3_NCO - CASCBLINE(ITAB*10-1:ITAB*10+7) = CPART + CASCBLINE(ITAB*10-1:ITAB*10+7) = CPART #endif - ! - DO IFLD=1,NPTAB - IF(ITAB.EQ.IFLD)THEN - IYY(IFLD)=.TRUE. - HSD(IFLD)=HSP(IPNOW) - TPD(IFLD)=TPP(IPNOW) - WDD(IFLD)=NINT(DMP(IPNOW)) - ENDIF - ENDDO - ! - HST(ITAB,1) = HSP(IPNOW) - TPT(ITAB,1) = TPP(IPNOW) - DMT(ITAB,1) = DMP(IPNOW) + ! + DO IFLD=1,NPTAB + IF(ITAB.EQ.IFLD)THEN + IYY(IFLD)=.TRUE. + HSD(IFLD)=HSP(IPNOW) + TPD(IFLD)=TPP(IPNOW) + WDD(IFLD)=NINT(DMP(IPNOW)) + ENDIF + ENDDO + ! + HST(ITAB,1) = HSP(IPNOW) + TPT(ITAB,1) = TPP(IPNOW) + DMT(ITAB,1) = DMP(IPNOW) - ! - ! 5.h No slot in table found, write - ! - ELSE - ! - INOTAB = INOTAB + 1 - WRITE (ASCBLINE(19:19),'(I1)') INOTAB - ! - ENDIF - ! - FLAG(IPNOW) = .FALSE. - GOTO 601 + ! + ! 5.h No slot in table found, write + ! + ELSE + ! + INOTAB = INOTAB + 1 + WRITE (ASCBLINE(19:19),'(I1)') INOTAB + ! + ENDIF + ! + FLAG(IPNOW) = .FALSE. + END DO + END IF ! ! 5.i End of processing, write line in table ! -699 CONTINUE - ! DO IFLD=1,NPTAB IF(IYY(IFLD))THEN ILEN(IFLD)=ILEN(IFLD)+1 diff --git a/model/src/w3canomd.F90 b/model/src/w3canomd.F90 index 5395853f27..7c88c145d9 100644 --- a/model/src/w3canomd.F90 +++ b/model/src/w3canomd.F90 @@ -32,6 +32,7 @@ MODULE W3CANOMD !/ XX-Jul-2010 : Origination by PAEM JANSSEN !/ 18-Oct-2012 : Adapted to WAVEWATCH III: F. Ardhuin( version 4.07 ) !/ 21-Aug-2014 : Bug corrected: only first call wasOK( version 5.01 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 0. Note by F. Ardhuin: ! In adapting the orginal program to be a WAVEWATCH module, I @@ -2807,26 +2808,25 @@ REAL FUNCTION AKI(OM,BETA) !--------------------------------------------------------------------- ! IMPLICIT NONE - REAL OM,BETA,G,EBS,AKM1,AKM2,AO,AKP,BO,TH,STH + REAL OM,BETA,G,EBS,AKM1,AKM2,AKP,BO,TH,STH G =9.806 EBS=0.0001 AKM1=OM**2/(4.*G ) AKM2=OM/(2.*SQRT(G*BETA)) - AO=MAX(AKM1,AKM2) -10 CONTINUE - AKP=AO - BO=BETA*AO - ! IF (BO.GT.10) GO TO 20 - IF (BO.GT.20.) GO TO 20 - TH=G*AO*TANH(BO) - STH=SQRT(TH) - AO=AO+(OM-STH)*STH*2./(TH/AO+G*BO/COSH(BO)**2) - IF (ABS(AKP-AO).GT.EBS*AO) GO TO 10 - AKI=AO - RETURN -20 CONTINUE - AKI=OM**2/G + AKI=MAX(AKM1,AKM2) + DO + AKP=AKI + BO=BETA*AKI + IF (BO.GT.20.) THEN + AKI=OM**2/G + EXIT + END IF + TH=G*AKI*TANH(BO) + STH=SQRT(TH) + AKI=AKI+(OM-STH)*STH*2./(TH/AKI+G*BO/COSH(BO)**2) + IF (ABS(AKP-AKI).LE.EBS*AKI) EXIT + END DO RETURN END FUNCTION AKI ! diff --git a/model/src/w3dispmd.F90 b/model/src/w3dispmd.F90 index f925174bf1..940b5bdfa8 100644 --- a/model/src/w3dispmd.F90 +++ b/model/src/w3dispmd.F90 @@ -13,6 +13,7 @@ MODULE W3DISPMD !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 10-Mar-2016 : Added Liu & Mollo-Christensen !/ dispersion with ice (E. Rogers) ( version 5.10 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -308,7 +309,7 @@ SUBROUTINE WAVNU2 (W,H,K,CG,EPS,NMAX,ICON) END IF IF (DIF .LT. EPS .AND. RDIF .LT. EPS) THEN ICON = 1 - GOTO 100 + EXIT ELSE KOLD = K F = GRAV*KOLD*TANH(KOLD*H)-W0**2 @@ -321,10 +322,11 @@ SUBROUTINE WAVNU2 (W,H,K,CG,EPS,NMAX,ICON) END IF END DO ! - DIF = ABS(K-KOLD) - RDIF = DIF/K - IF (DIF .LT. EPS .AND. RDIF .LT. EPS) ICON = 1 -100 CONTINUE + IF (ICON==0) THEN + DIF = ABS(K-KOLD) + RDIF = DIF/K + IF (DIF .LT. EPS .AND. RDIF .LT. EPS) ICON = 1 + END IF IF (2*K*H.GT.25) THEN CG = W0/K * 0.5 ELSE diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index fdd5ad2304..1a7ca926d8 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -175,7 +175,6 @@ SUBROUTINE W3FLD1( ASPC, FPI, WNDX,WNDY, ZWND, & USE CONSTANTS, ONLY: GRAV, DWAT, TPI, PI, KAPPA USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, XFR, TH USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -839,7 +838,6 @@ SUBROUTINE INFLD !/ ------------------------------------------------------------------- / USE W3ODATMD, ONLY: NDSE USE W3GDATMD, ONLY: TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -939,7 +937,6 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) USE CONSTANTS, ONLY: TPI, PI USE W3GDATMD, ONLY: NTH, TH, DTH USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3fld2md.F90 b/model/src/w3fld2md.F90 index 83e44c0215..403cc191f8 100644 --- a/model/src/w3fld2md.F90 +++ b/model/src/w3fld2md.F90 @@ -145,7 +145,6 @@ SUBROUTINE W3FLD2( ASPC,FPI, WNDX,WNDY, ZWND, & USE CONSTANTS, ONLY: DWAT, GRAV, TPI, PI, KAPPA USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, XFR, TH USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE USE W3FLD1MD, ONLY: APPENDTAIL,sig2wn,wnd2z0m,infld,tail_choice,& tail_level, tail_transition_ratio1, & tail_transition_ratio2 diff --git a/model/src/w3fldsmd.F90 b/model/src/w3fldsmd.F90 index fa26467bb5..639bfa807f 100644 --- a/model/src/w3fldsmd.F90 +++ b/model/src/w3fldsmd.F90 @@ -34,6 +34,7 @@ MODULE W3FLDSMD !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 ) !/ 05-Jun-2018 : adds DEBUGFLS ( version 6.04 ) !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -261,7 +262,11 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & TIDEFLAG = 0 END IF - IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 + IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT + IERR = 1 + RETURN + END IF IF ( IDFLD.NE.'IC1' .AND. IDFLD.NE.'IC2' .AND. & IDFLD.NE.'IC3' .AND. IDFLD.NE.'IC4' .AND. & IDFLD.NE.'IC5' .AND. IDFLD.NE.'MDN' .AND. & @@ -271,7 +276,11 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & IDFLD.NE.'ICE' .AND. IDFLD.NE.'TAU' .AND. & IDFLD.NE.'RHO' .AND. IDFLD.NE.'DT0' .AND. & IDFLD.NE.'DT1' .AND. IDFLD.NE.'DT2' .AND. & - IDFLD.NE.'ISI' ) GOTO 802 + IDFLD.NE.'ISI' ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD + IERR = 2 + RETURN + END IF ! IF ( PRESENT(FEXT) ) THEN TEMPXT = FEXT @@ -351,20 +360,25 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & IF ( WRITE ) THEN IF ( PRESENT(FPRE) ) THEN OPEN (NDS,FILE=FPRE//FNAME(:I),FORM=FORM, convert=file_endian, & - ERR=803, IOSTAT=IERR) + IOSTAT=IERR) ELSE OPEN (NDS,FILE=FNAME(:I),FORM=FORM,convert=file_endian, & - ERR=803,IOSTAT=IERR) + IOSTAT=IERR) END IF ELSE IF ( PRESENT(FPRE) ) THEN OPEN (NDS,FILE=FPRE//FNAME(:I),FORM=FORM,convert=file_endian, & - STATUS='OLD',ERR=803,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDS,FILE=FNAME(:I),FORM=FORM,convert=file_endian, & - STATUS='OLD',ERR=803,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) IDFLD, IERR + IERR = 3 + RETURN + END IF ! ! Process test data -------------------------------------------------- * ! @@ -375,27 +389,48 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & ! The "filler" was added for compatibility with old binary forcing files ! It is now also used for tidal info ... ! - WRITE (NDS,ERR=804,IOSTAT=IERR) & + WRITE (NDS,IOSTAT=IERR) & IDSTR, IDFLD, NX, NY, GTYPE, FILLER(1:2), TIDEFLAG ELSE - WRITE (NDS,900,ERR=804,IOSTAT=IERR) & + WRITE (NDS,900,IOSTAT=IERR) & IDSTR, IDFLD, NX, NY, GTYPE, FILLER(1:2), TIDEFLAG END IF + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR + IERR = 4 + RETURN + END IF END IF ELSE IF ( FORM .EQ. 'UNFORMATTED' ) THEN - READ (NDS,END=806,ERR=805,IOSTAT=IERR) & + READ (NDS,IOSTAT=IERR) & TSSTR, TSFLD, NXT, NYT, GTYPET, FILLER(1:2), TIDEFLAG ELSE - READ (NDS,900,END=806,ERR=805,IOSTAT=IERR) & + READ (NDS,900,IOSTAT=IERR) & TSSTR, TSFLD, NXT, NYT, GTYPET, FILLER(1:2), TIDEFLAG END IF + IF (IERR.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD + IERR = 6 + RETURN + ELSE IF (IERR.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR + IERR = 5 + RETURN + END IF IF ((FILLER(1).NE.0.OR.FILLER(2).NE.0).AND.TIDEFLAG.GE.0) TIDEFLAG=0 IF (TIDEFLAG.NE.0.AND.(.NOT.TIDEOK)) THEN - GOTO 810 + IF ( NDSE .GE. 0 ) WRITE (NDSE,1010) & + FILLER(1:2),TIDEFLAG + IERR = 10 + RETURN END IF ! - IF ( IDSTR .NE. TSSTR ) GOTO 807 + IF ( IDSTR .NE. TSSTR ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) TSSTR, IDSTR + IERR = 7 + RETURN + END IF IF (( IDFLD.EQ.'WND' .AND. TSFLD.EQ.'WNS') .OR. & ( IDFLD.EQ.'ICE' .AND. TSFLD.EQ.'ISI') ) THEN IDFLD = TSFLD @@ -403,10 +438,18 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & WRITE (NDST,9002) IDFLD #endif END IF - IF ( IDFLD .NE. TSFLD ) GOTO 808 + IF ( IDFLD .NE. TSFLD ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1008) TSFLD, IDFLD + IERR = 8 + RETURN + END IF IF ( IDFLD(1:2) .NE. 'DT' ) THEN IF ( NX.NE.NXT .OR. NY.NE.NYT ) THEN - GOTO 809 + IF ( NDSE .GE. 0 ) WRITE (NDSE,1009) & + NXT, NYT, GTYPET, & + NX , NY , GTYPE + IERR = 9 + RETURN ELSE NX = NXT IF (GTYPE.LE.4) GTYPE = GTYPET @@ -421,61 +464,6 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & TIDEFLAGIN = TIDEFLAG END IF - RETURN - ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT - IERR = 1 - RETURN - ! -802 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD - IERR = 2 - RETURN - ! -803 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) IDFLD, IERR - IERR = 3 - RETURN - ! -804 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR - IERR = 4 - RETURN - ! -805 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR - IERR = 5 - RETURN - ! -806 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD - IERR = 6 - RETURN - ! -807 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) TSSTR, IDSTR - IERR = 7 - RETURN - ! -808 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1008) TSFLD, IDFLD - IERR = 8 - RETURN - ! -809 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1009) & - NXT, NYT, GTYPET, & - NX , NY , GTYPE - IERR = 9 - RETURN - ! -810 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1010) & - FILLER(1:2),TIDEFLAG - IERR = 10 RETURN ! ! Formats @@ -645,22 +633,42 @@ SUBROUTINE W3FLDTIDE1 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR ) ! ! test input parameters ---------------------------------------------- * ! - IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 + IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT + IERR = 1 + RETURN + END IF IF ( IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & IDFLD.NE.'ICE' .AND. IDFLD.NE.'TAU' .AND. & IDFLD.NE.'RHO' .AND. IDFLD.NE.'DT0' .AND. & IDFLD.NE.'DT1' .AND. IDFLD.NE.'DT2' .AND. & - IDFLD.NE.'ISI' ) GOTO 802 + IDFLD.NE.'ISI' ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD + IERR = 2 + RETURN + END IF WRITE = INXOUT .EQ. 'WRITE' #ifdef W3_TIDE IF ( WRITE ) THEN - WRITE (NDS,ERR=804,IOSTAT=IERR) & - TIDE_MF + WRITE (NDS,IOSTAT=IERR) TIDE_MF + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR + IERR = 4 + RETURN + END IF ELSE - READ (NDS,END=806,ERR=805,IOSTAT=IERR) & - TIDE_MF + READ (NDS,IOSTAT=IERR) TIDE_MF + IF (IERR.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD + IERR = 6 + RETURN + ELSE IF (IERR.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR + IERR = 5 + RETURN + END IF NTIDE = TIDE_MF END IF #endif @@ -671,33 +679,6 @@ SUBROUTINE W3FLDTIDE1 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR ) IERR = 0 RETURN ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT - IERR = 1 - RETURN - ! -802 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD - IERR = 2 - RETURN - ! -804 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR - IERR = 4 - RETURN - ! -805 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR - IERR = 5 - RETURN - ! -806 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD - IERR = 6 - RETURN - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE1 : '/ & @@ -837,32 +818,60 @@ SUBROUTINE W3FLDTIDE2 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR ) ! ! test input parameters ---------------------------------------------- * ! - IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 + IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT + IERR = 1 + RETURN + END IF IF ( IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & IDFLD.NE.'ICE' .AND. IDFLD.NE.'TAU' .AND. & IDFLD.NE.'RHO' .AND. IDFLD.NE.'DT0' .AND. & IDFLD.NE.'DT1' .AND. IDFLD.NE.'DT2' .AND. & - IDFLD.NE.'ISI' ) GOTO 802 + IDFLD.NE.'ISI' ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD + IERR = 2 + RETURN + END IF WRITE = INXOUT .EQ. 'WRITE' #ifdef W3_TIDE IF ( WRITE ) THEN - WRITE (NDS,ERR=804,IOSTAT=IERR) & + WRITE (NDS,IOSTAT=IERR) & TIDE_FREQC(:),TIDECON_NAME(:),TIDAL_CONST(:,:,:,:,:) + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR + IERR = 4 + RETURN + END IF ELSE IF (.NOT. ALLOCATED(TIDAL_CONST)) ALLOCATE(TIDAL_CONST(NX,NY,TIDE_MF,2,2)) IF (.NOT. ALLOCATED(TIDE_FREQC)) ALLOCATE(TIDE_FREQC(TIDE_MF)) IF (.NOT. ALLOCATED(TIDECON_NAMEI)) ALLOCATE(TIDECON_NAMEI(TIDE_MF)) - READ (NDS,END=806,ERR=805,IOSTAT=IERR) & + READ (NDS,IOSTAT=IERR) & TIDE_FREQC,TIDECON_NAMEI(:),TIDAL_CONST(:,:,:,:,:) + IF (IERR.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD + IERR = 6 + RETURN + ELSE IF (IERR.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR + IERR = 5 + RETURN + END IF LIST(:)='' TIDE_MF1=TIDE_MF DO I=1,TIDE_MF LIST(I)=TIDECON_NAMEI(I) END DO CALL TIDE_FIND_INDICES_ANALYSIS(LIST) - IF (TIDE_MF1.NE.TIDE_MF) GOTO 807 + IF (TIDE_MF1.NE.TIDE_MF) THEN +#ifdef W3_TIDE + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) TIDECON_NAMEI(:) +#endif + IERR = 7 + RETURN + END IF CALL TIDE_SET_INDICES IF(IDFLD.EQ.'LEV') THEN IF (IDAT.EQ.1) WLTIDE(:,:,:,:)=TIDAL_CONST(:,:,:,1,:) @@ -895,40 +904,6 @@ SUBROUTINE W3FLDTIDE2 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR ) IERR = 0 RETURN ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT - IERR = 1 - RETURN - ! -802 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD - IERR = 2 - RETURN - ! -804 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) IDFLD, IERR - IERR = 4 - RETURN - ! -805 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) IDFLD, IERR - IERR = 5 - RETURN - ! -806 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) IDFLD - IERR = 6 - RETURN - ! -807 CONTINUE -#ifdef W3_TIDE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) TIDECON_NAMEI(:) -#endif - IERR = 7 - RETURN - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ & @@ -1115,7 +1090,7 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & #endif REAL :: DTTST LOGICAL :: WRITE, FL2D, FLFRST, FLBE, FLST, & - FLINTERP, FLCOUPL + FLINTERP, FLCOUPL LOGICAL, PARAMETER :: FLAGSC_DEFAULT = .FALSE. !/ !/ ------------------------------------------------------------------- / @@ -1133,7 +1108,11 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & ! ! test input parameters ---------------------------------------------- * ! - IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') GOTO 801 + IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE') THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT + IERR = 1 + RETURN + END IF IF ( IDFLD.NE.'IC1' .AND. IDFLD.NE.'IC2' .AND. & IDFLD.NE.'IC3' .AND. IDFLD.NE.'IC4' .AND. & IDFLD.NE.'IC5' .AND. IDFLD.NE.'MDN' .AND. & @@ -1141,7 +1120,11 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & IDFLD.NE.'LEV' .AND. IDFLD.NE.'CUR' .AND. & IDFLD.NE.'WND' .AND. IDFLD.NE.'WNS' .AND. & IDFLD.NE.'ICE' .AND. IDFLD.NE.'ISI' .AND. & - IDFLD.NE.'TAU' .AND. IDFLD.NE.'RHO' ) GOTO 802 + IDFLD.NE.'TAU' .AND. IDFLD.NE.'RHO' ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD + IERR = 2 + RETURN + END IF ! ! Set internal variables --------------------------------------------- * ! @@ -1216,21 +1199,44 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & #ifdef W3_T WRITE (NDST,9030) TF0 #endif - WRITE (NDS,ERR=803,IOSTAT=ISTAT) TF0 + WRITE (NDS,IOSTAT=ISTAT) TF0 + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) ISTAT + IERR = 3 + RETURN + END IF IF ( .NOT. FL2D ) THEN J = 1 - WRITE (NDS,ERR=804,IOSTAT=ISTAT) & - ((FA0(IX,IY),IX=1,NX),IY=1,NY) + WRITE (NDS,IOSTAT=ISTAT) ((FA0(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) J, ISTAT + IERR = 4 + RETURN + END IF ELSE J = 1 - WRITE (NDS,ERR=804,IOSTAT=ISTAT) & - ((FX0(IX,IY),IX=1,NX),IY=1,NY) + WRITE (NDS,IOSTAT=ISTAT) ((FX0(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) J, ISTAT + IERR = 4 + RETURN + END IF J = 2 - WRITE (NDS,ERR=804,IOSTAT=ISTAT) & - ((FY0(IX,IY),IX=1,NX),IY=1,NY) + WRITE (NDS,IOSTAT=ISTAT) ((FY0(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) J, ISTAT + IERR = 4 + RETURN + END IF J = 3 - IF ( FLST ) WRITE (NDS,ERR=804,IOSTAT=ISTAT) & - ((FA0(IX,IY),IX=1,NX),IY=1,NY) + IF ( FLST ) THEN + WRITE (NDS,IOSTAT=ISTAT) ((FA0(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) J, ISTAT + IERR = 4 + RETURN + END IF + END IF END IF ! EXIT @@ -1271,7 +1277,27 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & END IF ELSE #endif - READ (NDS,END=800,ERR=805,IOSTAT=ISTAT) TFN + READ (NDS,IOSTAT=ISTAT) TFN + ! + IF (ISTAT .GT. 0) THEN + ! Error reading the file + IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) ISTAT + IERR = 5 + RETURN + ELSE IF (ISTAT .LT. 0) THEN + ! Reached end of file + IERR = -1 + ! + IF ( FLINTERP ) THEN + TFN(1) = TN(1) + TFN(2) = TN(2) + CALL TICK21 ( TFN , 1. ) + END IF +#ifdef W3_T + WRITE (NDST,9032) TFN, IERR +#endif + EXIT + END IF #ifdef W3_T WRITE (NDST,9031) TFN #endif @@ -1279,15 +1305,39 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & ! note: "J" here does *not* refer to data type, wlev etc. ! It refers to the dimension. J = 1 - READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & - ((FAN(IX,IY),IX=1,NX),IY=1,NY) + READ (NDS,IOSTAT=ISTAT) ((FAN(IX,IY),IX=1,NX),IY=1,NY) + IF (ISTAT.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) J, ISTAT + IERR = 6 + RETURN + ELSE IF (ISTAT.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) J, ISTAT + IERR = 7 + RETURN + END IF ELSE J = 1 - READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & - ((FXN(IX,IY),IX=1,NX),IY=1,NY) + READ (NDS,IOSTAT=ISTAT) ((FXN(IX,IY),IX=1,NX),IY=1,NY) + IF (ISTAT.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) J, ISTAT + IERR = 6 + RETURN + ELSE IF (ISTAT.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) J, ISTAT + IERR = 7 + RETURN + END IF J = 2 - READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & - ((FYN(IX,IY),IX=1,NX),IY=1,NY) + READ (NDS,IOSTAT=ISTAT) ((FYN(IX,IY),IX=1,NX),IY=1,NY) + IF (ISTAT.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) J, ISTAT + IERR = 6 + RETURN + ELSE IF (ISTAT.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) J, ISTAT + IERR = 7 + RETURN + END IF ! this was added for ISI files to store ICE in FAN and BERG in FYN @@ -1296,8 +1346,18 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & ! this was added for WNS files to store WND in FXN & FYN and AST in FAN J = 3 - IF ( FLST ) READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) & - ((FAN(IX,IY),IX=1,NX),IY=1,NY) + IF ( FLST ) THEN + READ (NDS,IOSTAT=ISTAT) ((FAN(IX,IY),IX=1,NX),IY=1,NY) + IF (ISTAT.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) J, ISTAT + IERR = 6 + RETURN + ELSE IF (ISTAT.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) J, ISTAT + IERR = 7 + RETURN + END IF + END IF END IF #ifdef W3_OASIS END IF @@ -1321,11 +1381,8 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & ! ! Branch point for EOF and interpolated fields (forcing current, wind or winds) ! -300 CONTINUE - ! If the field is interpolated in time and the start time of interpolation is not set ! save the time and field values at the start time and field of interpolation - IF ( .NOT.WRITE .AND. FLINTERP .AND. TF0(1) .EQ. -1 ) THEN ! #ifdef W3_T @@ -1350,8 +1407,6 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & ! ! Branch point for EOF and not interpolated fields (coupled fields, ice, lev, ...) ! -500 CONTINUE - ! #ifdef W3_T IF ( FLINTERP ) THEN WRITE (NDST,9041) TF0, TFN @@ -1364,64 +1419,6 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & ! RETURN ! - ! EOF escape location (have read to end of file) - ! -800 CONTINUE - IERR = -1 - ! - IF ( FLINTERP ) THEN - TFN(1) = TN(1) - TFN(2) = TN(2) - CALL TICK21 ( TFN , 1. ) - END IF -#ifdef W3_T - WRITE (NDST,9032) TFN, IERR -#endif - ! - IF ( FLINTERP ) THEN - GOTO 300 - ELSE - GOTO 500 - END IF - ! - ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT - IERR = 1 - RETURN - ! -802 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD - IERR = 2 - RETURN - ! -803 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) ISTAT - IERR = 3 - RETURN - ! -804 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) J, ISTAT - IERR = 4 - RETURN - ! -805 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) ISTAT - IERR = 5 - RETURN - ! -806 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) J, ISTAT - IERR = 6 - RETURN - ! -807 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) J, ISTAT - IERR = 7 - RETURN - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ & @@ -1606,9 +1603,17 @@ SUBROUTINE W3FLDD (INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, & ! test input parameters ---------------------------------------------- * ! IF ( INXOUT.NE.'READ' .AND. INXOUT.NE.'WRITE' .AND. & - INXOUT.NE.'SIZE' ) GOTO 801 + INXOUT.NE.'SIZE' ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT + IERR = 1 + RETURN + END IF IF ( IDFLD.NE.'DT0' .AND. IDFLD.NE.'DT1' .AND. & - IDFLD.NE.'DT2' ) GOTO 802 + IDFLD.NE.'DT2' ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD + IERR = 2 + RETURN + END IF ! ! Set internal variables --------------------------------------------- * ! @@ -1626,32 +1631,74 @@ SUBROUTINE W3FLDD (INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, & #ifdef W3_T WRITE (NDST,9020) TD, ND #endif - WRITE (NDS,ERR=803,IOSTAT=ISTAT) TD, ND - WRITE (NDS,ERR=804,IOSTAT=ISTAT) DATA + WRITE (NDS,IOSTAT=ISTAT) TD, ND + IF (ISTAT.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) ISTAT + IERR = 3 + RETURN + END IF + WRITE (NDS,IOSTAT=ISTAT) DATA + IF (ISTAT.NE.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) ISTAT + IERR = 4 + RETURN + END IF ! ! Process fields, read size ----------------------------------------- * ! ELSE IF ( SIZE ) THEN ! -100 CONTINUE - READ (NDS,END=800,ERR=805,IOSTAT=ISTAT) TD, NDOUT + DO + READ (NDS,IOSTAT=ISTAT) TD, NDOUT + ! + IF (ISTAT .GT. 0) THEN + ! Error reading the file + IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) ISTAT + IERR = 5 + RETURN + ELSE IF (ISTAT .LT. 0) THEN + ! Reached end of file + IERR = -1 + RETURN + END IF + #ifdef W3_T - WRITE (NDST,9021) TD, NDOUT + WRITE (NDST,9021) TD, NDOUT #endif - ! - ! Check time, read and branch back if necessary - ! - DTTST = DSEC21 ( TIME , TD ) - IF ( DTTST.LT.0. .OR. NDOUT.EQ.0 ) THEN - IF (NDOUT.GT.0) READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) - GOTO 100 - END IF + ! + ! Check time, read and branch back if necessary + ! + DTTST = DSEC21 ( TIME , TD ) + IF ( DTTST.LT.0. .OR. NDOUT.EQ.0 ) THEN + IF (NDOUT.GT.0) READ (NDS,IOSTAT=ISTAT) + IF (ISTAT.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) ISTAT + IERR = 6 + RETURN + ELSE IF (ISTAT.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) ISTAT + IERR = 7 + RETURN + END IF + ELSE + EXIT + END IF + END DO ! ! Process fields, read data ----------------------------------------- * ! ELSE ! - READ (NDS,END=806,ERR=807,IOSTAT=ISTAT) DATA + READ (NDS,IOSTAT=ISTAT) DATA + IF (ISTAT.LT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) ISTAT + IERR = 6 + RETURN + ELSE IF (ISTAT.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) ISTAT + IERR = 7 + RETURN + END IF #ifdef W3_T WRITE (NDST,9030) TD #endif @@ -1661,49 +1708,6 @@ SUBROUTINE W3FLDD (INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, & ! RETURN ! - ! EOF escape location - ! -800 CONTINUE - IERR = -1 - RETURN - ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) INXOUT - IERR = 1 - RETURN - ! -802 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1002) IDFLD - IERR = 2 - RETURN - ! -803 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1003) ISTAT - IERR = 3 - RETURN - ! -804 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1004) ISTAT - IERR = 4 - RETURN - ! -805 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1005) ISTAT - IERR = 5 - RETURN - ! -806 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1006) ISTAT - IERR = 6 - RETURN - ! -807 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1007) ISTAT - IERR = 7 - RETURN - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ & @@ -2288,7 +2292,11 @@ SUBROUTINE W3FLDH (J, NDST, NDSE, MX, MY, NX, NY, T0, TN, & ! ! Test field ID number for validity ! - IF ( J.LT.-7 .OR. J .GT.10 ) GOTO 801 + IF ( J.LT.-7 .OR. J .GT.10 ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) J + IERR = 1 + RETURN + END IF FLFRST = TFN(1) .EQ. -1 ! #ifdef W3_T @@ -2458,13 +2466,6 @@ SUBROUTINE W3FLDH (J, NDST, NDSE, MX, MY, NX, NY, T0, TN, & ! RETURN ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) J - IERR = 1 - RETURN - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDH : '/ & @@ -2615,7 +2616,11 @@ SUBROUTINE W3FLDM (J, NDST, NDSE, T0, TN, NH, NHM, THO, HA, HD, & ! ! Test field ID number for validity ! - IF ( J .NE. 4 ) GOTO 801 + IF ( J .NE. 4 ) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) J + IERR = 1 + RETURN + END IF FLFRST = TFN(1) .EQ. -1 ! #ifdef W3_T @@ -2624,62 +2629,63 @@ SUBROUTINE W3FLDM (J, NDST, NDSE, T0, TN, NH, NHM, THO, HA, HD, & ! ! Backward branch point ============================================= * ! -100 CONTINUE - ! - ! Shift data - ! - TF0(1) = TFN(1) - TF0(2) = TFN(2) - IF ( TFN(1) .NE. -1 ) THEN - A0 = AN - D0 = DN -#ifdef W3_T - WRITE (NDST,9020) - ELSE - WRITE (NDST,9021) -#endif - END IF - ! - ! New field - ! - IF ( NH .NE. 0. ) THEN - TFN(1) = THO(1,J,1) - TFN(2) = THO(2,J,1) - AN = HA(1,J) - DN = ( 90. - HD(1,J) ) * DERA -#ifdef W3_T - WRITE (NDST,9050) AN, DN -#endif + DO ! - ! Shift data arrays + ! Shift data ! - DO I=1, NH-1 - THO(1,J,I) = THO(1,J,I+1) - THO(2,J,I) = THO(2,J,I+1) - HA(I,J) = HA(I+1,J) - HD(I,J) = HD(I+1,J) - END DO - NH = NH - 1 + TF0(1) = TFN(1) + TF0(2) = TFN(2) + IF ( TFN(1) .NE. -1 ) THEN + A0 = AN + D0 = DN #ifdef W3_T - WRITE (NDST,9051) TFN + WRITE (NDST,9020) + ELSE + WRITE (NDST,9021) #endif + END IF ! - ELSE + ! New field ! - TFN(1) = TN(1) - TFN(2) = TN(2) - CALL TICK21 ( TFN , 1. ) - IERR = -1 + IF ( NH .NE. 0. ) THEN + TFN(1) = THO(1,J,1) + TFN(2) = THO(2,J,1) + AN = HA(1,J) + DN = ( 90. - HD(1,J) ) * DERA #ifdef W3_T - WRITE (NDST,9052) TFN, IERR + WRITE (NDST,9050) AN, DN #endif + ! + ! Shift data arrays + ! + DO I=1, NH-1 + THO(1,J,I) = THO(1,J,I+1) + THO(2,J,I) = THO(2,J,I+1) + HA(I,J) = HA(I+1,J) + HD(I,J) = HD(I+1,J) + END DO + NH = NH - 1 +#ifdef W3_T + WRITE (NDST,9051) TFN +#endif + ! + ELSE + ! + TFN(1) = TN(1) + TFN(2) = TN(2) + CALL TICK21 ( TFN , 1. ) + IERR = -1 +#ifdef W3_T + WRITE (NDST,9052) TFN, IERR +#endif + ! + END IF ! - END IF - ! - ! Check time - ! - DTTST = DSEC21 ( T0 , TFN ) - IF ( DTTST .LE. 0. ) GOTO 100 + ! Check time + ! + DTTST = DSEC21 ( T0 , TFN ) + IF ( DTTST .GT. 0. ) EXIT + END DO ! ! Check if first field ! @@ -2699,13 +2705,6 @@ SUBROUTINE W3FLDM (J, NDST, NDSE, T0, TN, NH, NHM, THO, HA, HD, & ! RETURN ! - ! Error escape locations - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,1001) J - IERR = 1 - RETURN - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDM : '/ & diff --git a/model/src/w3flx2md.F90 b/model/src/w3flx2md.F90 index 38f4bcc942..5802a87002 100644 --- a/model/src/w3flx2md.F90 +++ b/model/src/w3flx2md.F90 @@ -156,7 +156,6 @@ SUBROUTINE W3FLX2 ( ZWIND, DEPTH, FP, U, UDIR, UST, USTD, Z0, CD ) USE CONSTANTS USE W3GDATMD, ONLY: NITTIN, CINXSI USE W3ODATMD, ONLY: NDSE, IAPROC, NAPERR - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3flx3md.F90 b/model/src/w3flx3md.F90 index 5290021285..097758b6eb 100644 --- a/model/src/w3flx3md.F90 +++ b/model/src/w3flx3md.F90 @@ -163,7 +163,6 @@ SUBROUTINE W3FLX3 ( ZWIND, DEPTH, FP, U, UDIR, UST, USTD, Z0, CD ) USE CONSTANTS USE W3GDATMD, ONLY: NITTIN, CINXSI, CD_MAX, CAP_ID USE W3ODATMD, ONLY: NDSE, IAPROC, NAPERR - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 7ccd66427c..30eb951f0a 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -116,6 +116,7 @@ MODULE W3GRIDMD !/ 28-Feb-2023 : GQM as an alternative for NL1 ( version 7.15 ) !/ 11-Jan-2024 : New namelist parameters for IC4 ( version 7.15 ) !/ 03-May-2024 : New CAPCHNK parameters for SIN4 ( version 7.15 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -167,6 +168,8 @@ MODULE W3GRIDMD ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input file + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! DISTAB Subr. W3DISPMD Make tables for solution of the ! dispersion relation. @@ -507,7 +510,7 @@ MODULE W3GRIDMD USE W3GSRUMD, ONLY: W3GRMP USE W3ODATMD, ONLY: W3NOUT, W3SETO, W3DMO5 USE W3IOGRMD, ONLY: W3IOGR - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_RTD USE W3SERVMD, ONLY: W3EQTOLL, W3LLTOEQ #endif @@ -1188,8 +1191,8 @@ SUBROUTINE W3GRID() NML_EXCL_POINT, NML_EXCL_BODY, & NML_OUTBND_COUNT, NML_OUTBND_LINE, IERR) ELSE - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_grid.inp',STATUS='OLD', & - ERR=2000,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_grid.inp',STATUS='OLD', IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF ! NDSTRC = 6 @@ -1229,17 +1232,20 @@ SUBROUTINE W3GRID() ELSE - READ (NDSI,'(A)',END=2001,ERR=2002,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR CALL NEXTLN ( COMSTR , NDSI , NDSE ) ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) GNAME + READ (NDSI,*,IOSTAT=IERR) GNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) WRITE (NDSO,902) GNAME ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) RXFR, RFR1, NKI, NTHI, RTH0 + READ (NDSI,*,IOSTAT=IERR) RXFR, RFR1, NKI, NTHI, RTH0 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF @@ -1338,8 +1344,8 @@ SUBROUTINE W3GRID() FLSOU=NML_RUN%FLSOU ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) & - FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU + READ (NDSI,*,IOSTAT=IERR) FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IYN = 2 @@ -1364,7 +1370,8 @@ SUBROUTINE W3GRID() DTMIN=NML_TIMESTEPS%DTMIN ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) DTMAX, DTCFL, DTCFLI, DTMIN + READ (NDSI,*,IOSTAT=IERR) DTMAX, DTCFL, DTCFLI, DTMIN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF #ifdef W3_SEC1 IF (DTMAX.LT.1.) THEN @@ -1606,7 +1613,8 @@ SUBROUTINE W3GRID() OPEN (NDSS,FILE=TRIM(FNMPRE)//'ww3_grid.scratch',FORM='FORMATTED') DO CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,'(A)',END=2001,ERR=2002) LINE + READ (NDSI,'(A)',IOSTAT=IERR) LINE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) IF ( LINE(1:16) .EQ. 'END OF NAMELISTS' ) THEN EXIT ELSE @@ -3159,7 +3167,10 @@ SUBROUTINE W3GRID() ! IF (TRIM(CALTYPE) .NE. 'standard' .AND. & TRIM(CALTYPE) .NE. '360_day' .AND. & - TRIM(CALTYPE) .NE. '365_day' ) GOTO 2003 + TRIM(CALTYPE) .NE. '365_day' ) THEN + WRITE (NDSE,1003) + CALL EXTCDE ( 64 ) + END IF WRITE (NDST,1973) CALTYPE WRITE (NDSO,*) ! @@ -3525,7 +3536,8 @@ SUBROUTINE W3GRID() CSTRG=TRIM(NML_GRID%CLOS) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) GSTRG, FLAGLL, CSTRG + READ (NDSI,*,IOSTAT=IERR) GSTRG, FLAGLL, CSTRG + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) CALL NEXTLN ( COMSTR , NDSI , NDSE ) END IF @@ -3621,7 +3633,8 @@ SUBROUTINE W3GRID() ELSE IF ( GTYPE.NE.UNGTYPE) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NX, NY + READ (NDSI,*,IOSTAT=IERR) NX, NY + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) NX = MAX ( 3 , NX ) NY = MAX ( 3 , NY ) WRITE (NDSO,3003) NX, NY @@ -3738,9 +3751,11 @@ SUBROUTINE W3GRID() VSC0 = NML_RECT%SF0 ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) SX, SY, VSC + READ (NDSI,*,IOSTAT=IERR) SX, SY, VSC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) X0, Y0, VSC0 + READ (NDSI,*,IOSTAT=IERR) X0, Y0, VSC0 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! VSC = MAX ( 1.E-7 , VSC ) @@ -3788,8 +3803,9 @@ SUBROUTINE W3GRID() FNAME = TRIM(NML_CURV%XCOORD%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSG, VSC, VOF, & + READ (NDSI,*,IOSTAT=IERR) NDSG, VSC, VOF, & IDLA, IDFM, RFORM, FROM, FNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IF (IDLA.LT.1 .OR. IDLA.GT.4) IDLA = 1 @@ -3814,21 +3830,22 @@ SUBROUTINE W3GRID() IF (FROM.EQ.'NAME') THEN OPEN (NDSG,FILE=TRIM(FNMPRE)//TRIM(FNAME),& form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSG, & form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSG,FILE=TRIM(FNMPRE)//TRIM(FNAME),& - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSG, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF !IDFM + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF !NDSG ! CALL INA2R ( XGRDIN, NX, NY, 1, NX, 1, NY, NDSG, NDST, NDSE, & @@ -3847,8 +3864,9 @@ SUBROUTINE W3GRID() FNAME = TRIM(NML_CURV%YCOORD%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSG, VSC, VOF, & + READ (NDSI,*,IOSTAT=IERR) NDSG, VSC, VOF, & IDLA, IDFM, RFORM, FROM, FNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IF (IDLA.LT.1 .OR. IDLA.GT.4) IDLA = 1 @@ -3873,21 +3891,22 @@ SUBROUTINE W3GRID() IF (FROM.EQ.'NAME') THEN OPEN (NDSG,FILE=TRIM(FNMPRE)//TRIM(FNAME),& form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSG, & form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSG,FILE=TRIM(FNMPRE)//TRIM(FNAME),& - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSG, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF !IDFM + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF !NDSG ! CALL INA2R ( YGRDIN, NX, NY, 1, NX, 1, NY, NDSG, NDST, NDSE, & @@ -3949,8 +3968,9 @@ SUBROUTINE W3GRID() END IF ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) ZLIM, DMIN, NDSG, VSC, IDLA, & + READ (NDSI,*,IOSTAT=IERR) ZLIM, DMIN, NDSG, VSC, IDLA, & IDFM, RFORM, FROM, FNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! DMIN = MAX ( 1.E-3 , DMIN ) @@ -3998,20 +4018,21 @@ SUBROUTINE W3GRID() IF (FROM.EQ.'NAME') THEN OPEN (NDSG,FILE=TRIM(FNMPRE)//TRIM(FNAME), & form='UNFORMATTED', convert=file_endian,& - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSG, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSG,FILE=TRIM(FNMPRE)//TRIM(FNAME), & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSG, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF !( NDSG .EQ. NDSI ) ! CALL INA2R ( ZBIN, NX, NY, 1, NX, 1, NY, NDSG, NDST, NDSE, & @@ -4080,8 +4101,9 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_OBST%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & + READ (NDSI,*,IOSTAT=IERR) NDSTR, VSC, IDLA, IDFT, RFORM, & FROM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IF ( ABS(VSC) .LT. 1.E-7 ) VSC = 1. @@ -4111,21 +4133,22 @@ SUBROUTINE W3GRID() IF ( IDFT .EQ. 3 ) THEN IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=2000, & + form='UNFORMATTED', convert=file_endian,STATUS='OLD', & IOSTAT=IERR) ELSE OPEN (NDSTR, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSTR, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF ! ! 7.g.3 Read the data @@ -4203,10 +4226,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%MCELS%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) ALLOCATE ( NLvCelsk( 0:NRLv ) ) READ (NDSTR,*) NLvCelsk NCel=NLvCelsk(0) @@ -4235,10 +4260,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%ISIDE%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) ALLOCATE ( NLvUFcsk( 0:NRLv ) ) READ (NDSTR,*) NLvUFcsk NUFc = NLvUFcsk(0) @@ -4266,10 +4293,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%JSIDE%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) ALLOCATE ( NLvVFcsk( 0:NRLv ) ) READ (NDSTR,*) NLvVFcsk NVFc= NLvVFcsk(0) @@ -4298,10 +4327,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%SUBTR%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) READ (NDSTR,*) NCObst, JObs WRITE (NDSO,4110) NCObst, JObs @@ -4325,10 +4356,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%BUNDY%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) ALLOCATE ( NBICelin( NBISMC ) ) CALL INA2I ( NBICelin, 1, NBISMC, 1, 1, 1, NBISMC, NDSTR, NDST, & NDSE, IDFM, RFORM, IDLA, 1, 0) @@ -4351,10 +4384,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%MBARC%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) READ (NDSTR,*) NARC, NBGL, NBAC WRITE (NDSO,4015) NARC, NBGL, NBAC @@ -4379,10 +4414,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%AISID%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) READ (NDSTR,*) NAUI WRITE (NDSO,4017) NAUI @@ -4413,10 +4450,12 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SMC%AJSID%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFM, RFORM, TNAME + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFM, RFORM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - FORM='FORMATTED',STATUS='OLD',ERR=2000) + FORM='FORMATTED',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) READ (NDSTR,*) NAVJ WRITE (NDSO,4019) NAVJ @@ -4477,8 +4516,9 @@ SUBROUTINE W3GRID() IF (TNAME.EQ.'unset' .OR. TNAME.EQ.'UNSET') FROM='PART' ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, IDLA, IDFT, RFORM, & + READ (NDSI,*,IOSTAT=IERR) NDSTR, IDLA, IDFT, RFORM, & FROM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! ! ... Data to be read in parts @@ -4531,7 +4571,8 @@ SUBROUTINE W3GRID() END IF ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) IX, IY, CONNCT + READ (NDSI,*,IOSTAT=IERR) IX, IY, CONNCT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! ! ... Check if last point reached. @@ -4611,7 +4652,8 @@ SUBROUTINE W3GRID() END IF ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) IX, IY + READ (NDSI,*,IOSTAT=IERR) IX, IY + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! ! ... Check if last point reached. @@ -4738,21 +4780,22 @@ SUBROUTINE W3GRID() IF ( IDFT .EQ. 3 ) THEN IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=2000, & + form='UNFORMATTED', convert=file_endian,STATUS='OLD', & IOSTAT=IERR) ELSE OPEN (NDSTR, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSTR, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF ! ALLOCATE ( READMP(NX,NY) ) @@ -5430,8 +5473,9 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SLOPE%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & + READ (NDSI,*,IOSTAT=IERR) NDSTR, VSC, IDLA, IDFT, RFORM, & FROM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IF ( ABS(VSC) .LT. 1.E-7 ) VSC = 1. @@ -5461,21 +5505,22 @@ SUBROUTINE W3GRID() IF ( IDFT .EQ. 3 ) THEN IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=2000, & + form='UNFORMATTED', convert=file_endian,STATUS='OLD', & IOSTAT=IERR) ELSE OPEN (NDSTR, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSTR, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF !end of (FROM.EQ.'NAME') END IF !end of ( IDFT .EQ. 3 ) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF !end of ( NDSTR .EQ. NDSG ) ! ! 9.d Read the data @@ -5545,8 +5590,9 @@ SUBROUTINE W3GRID() TNAME = TRIM(NML_SED%FILENAME) ELSE CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NDSTR, VSC, IDLA, IDFT, RFORM, & + READ (NDSI,*,IOSTAT=IERR) NDSTR, VSC, IDLA, IDFT, RFORM, & FROM, TNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IF ( ABS(VSC) .LT. 1.E-7 ) THEN @@ -5580,21 +5626,22 @@ SUBROUTINE W3GRID() IF ( IDFT .EQ. 3 ) THEN IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=2000, & + form='UNFORMATTED', convert=file_endian,STATUS='OLD', & IOSTAT=IERR) ELSE OPEN (NDSTR, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROM.EQ.'NAME') THEN OPEN (NDSTR,FILE=TRIM(FNMPRE)//TNAME, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSTR, & - STATUS='OLD',ERR=2000,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRID','INPUT',60) END IF ! ! 9.e.3 Read the data @@ -5672,7 +5719,8 @@ SUBROUTINE W3GRID() END IF ELSE CALL NEXTLN ( COMSTR , NDSI2 , NDSE ) - READ (NDSI2,*,END=2001,ERR=2002) XO0, YO0, DXO, DYO, NPO + READ (NDSI2,*,IOSTAT=IERR) XO0, YO0, DXO, DYO, NPO + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRID','INPUT',61) END IF ! IF ( .NOT. FLGNML .AND. ILOOP .EQ. 1 ) THEN @@ -6004,27 +6052,6 @@ SUBROUTINE W3GRID() CLOSE (NDSMA) #endif ! - GOTO 2222 - ! - ! Escape locations read errors : - ! -2000 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 60 ) - ! -2001 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 61 ) - ! -2002 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 62 ) - ! -2003 CONTINUE - WRITE (NDSE,1003) - CALL EXTCDE ( 64 ) - ! -2222 CONTINUE IF ( GTYPE .NE. UNGTYPE) THEN IF ( NX*NY .NE. NSEA ) THEN WRITE (NDSO,9997) NX, NY, NX*NY, NSEA, & @@ -6128,8 +6155,6 @@ SUBROUTINE W3GRID() IERR = NF90_PUT_VAR(NCID,grid_dims_varid,GRID1_DIMS) IERR = NF90_CLOSE(NCID) #endif - - ! ! Formats ! @@ -7023,17 +7048,6 @@ SUBROUTINE W3GRID() ! 999 FORMAT (/' Writing model definition file ...'/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRID : '/ & ' INVALID CALENDAR TYPE: SELECT ONE OF:', & ' standard, 360_day, or 365_day '/) @@ -7270,7 +7284,8 @@ SUBROUTINE READNL ( NDS, NAME, STATUS ) STATUS = '(default values) : ' ! DO - READ (NDS,'(A)',END=800,ERR=800,IOSTAT=IERR) LINE + READ (NDS,'(A)',IOSTAT=IERR) LINE + IF (IERR.NE.0) RETURN DO I=1, 70 IF ( LINE(I:I) .NE. ' ' ) THEN IF ( LINE(I:I) .EQ. '&' ) THEN @@ -7279,177 +7294,187 @@ SUBROUTINE READNL ( NDS, NAME, STATUS ) SELECT CASE(NAME) #ifdef W3_FLD1 CASE('FLD1') - READ (NDS,NML=FLD1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=FLD1,IOSTAT=J) #endif #ifdef W3_FLD2 CASE('FLD2') - READ (NDS,NML=FLD2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=FLD2,IOSTAT=J) #endif #ifdef W3_FLX3 CASE('FLX3') - READ (NDS,NML=FLX3,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=FLX3,IOSTAT=J) #endif #ifdef W3_FLX4 CASE('FLX4') - READ (NDS,NML=FLX4,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=FLX4,IOSTAT=J) #endif #ifdef W3_LN1 CASE('SLN1') - READ (NDS,NML=SLN1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SLN1,IOSTAT=J) #endif #ifdef W3_ST1 CASE('SIN1') - READ (NDS,NML=SIN1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIN1,IOSTAT=J) #endif #ifdef W3_ST2 CASE('SIN2') - READ (NDS,NML=SIN2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIN2,IOSTAT=J) #endif #ifdef W3_ST3 CASE('SIN3') - READ (NDS,NML=SIN3,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIN3,IOSTAT=J) #endif #ifdef W3_ST4 CASE('SIN4') - READ (NDS,NML=SIN4,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIN4,IOSTAT=J) #endif #ifdef W3_ST6 CASE('SIN6') - READ (NDS,NML=SIN6,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIN6,IOSTAT=J) #endif #ifdef W3_NL1 CASE('SNL1') - READ (NDS,NML=SNL1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SNL1,IOSTAT=J) #endif #ifdef W3_NL2 CASE('SNL2') - READ (NDS,NML=SNL2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SNL2,IOSTAT=J) CASE('ANL2') - IF ( NDEPTH .GT. 100 ) GOTO 804 + IF ( NDEPTH .GT. 100 ) THEN + WRITE (NDSE,1004) NDEPTH + CALL EXTCDE(4) + END IF DEPTHS(1:NDEPTH) = DPTHNL - READ (NDS,NML=ANL2,END=801,ERR=802,IOSTAT=J) - DPTHNL = DEPTHS(1:NDEPTH) + READ (NDS,NML=ANL2,IOSTAT=J) + IF (J.NE.0) DPTHNL = DEPTHS(1:NDEPTH) #endif #ifdef W3_NL3 CASE('SNL3') - READ (NDS,NML=SNL3,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SNL3,IOSTAT=J) CASE('ANL3') - IF ( NQDEF .GT. 100 ) GOTO 804 - READ (NDS,NML=ANL3,END=801,ERR=802,IOSTAT=J) + IF ( NQDEF .GT. 100 ) THEN + WRITE (NDSE,1004) NQDEF + CALL EXTCDE(4) + END IF + READ (NDS,NML=ANL3,IOSTAT=J) #endif #ifdef W3_NL4 CASE('SNL4') - READ (NDS,NML=SNL4,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SNL4,IOSTAT=J) #endif #ifdef W3_NL5 CASE('SNL5') - READ (NDS,NML=SNL5,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SNL5,IOSTAT=J) #endif #ifdef W3_NLS CASE('SNLS') - READ (NDS,NML=SNLS,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SNLS,IOSTAT=J) #endif #ifdef W3_ST1 CASE('SDS1') - READ (NDS,NML=SDS1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SDS1,IOSTAT=J) #endif #ifdef W3_ST2 CASE('SDS2') - READ (NDS,NML=SDS2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SDS2,IOSTAT=J) #endif #ifdef W3_ST3 CASE('SDS3') - READ (NDS,NML=SDS3,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SDS3,IOSTAT=J) #endif #ifdef W3_ST4 CASE('SDS4') - READ (NDS,NML=SDS4,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SDS4,IOSTAT=J) #endif #ifdef W3_ST6 CASE('SDS6') - READ (NDS,NML=SDS6,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SDS6,IOSTAT=J) CASE('SWL6') - READ (NDS,NML=SWL6,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SWL6,IOSTAT=J) #endif #ifdef W3_BT1 CASE('SBT1') - READ (NDS,NML=SBT1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SBT1,IOSTAT=J) #endif #ifdef W3_BT4 CASE('SBT4') - READ (NDS,NML=SBT4,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SBT4,IOSTAT=J) #endif #ifdef W3_IS1 CASE('SIS1') - READ (NDS,NML=SIS1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIS1,IOSTAT=J) #endif #ifdef W3_IS2 CASE('SIS2') - READ (NDS,NML=SIS2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIS2,IOSTAT=J) #endif #ifdef W3_DB1 CASE('SDB1') - READ (NDS,NML=SDB1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SDB1,IOSTAT=J) #endif #ifdef W3_UOST CASE('UOST') - READ (NDS,NML=UOST,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=UOST,IOSTAT=J) #endif #ifdef W3_PR1 CASE('PRO1') - READ (NDS,NML=PRO1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=PRO1,IOSTAT=J) #endif #ifdef W3_PR2 CASE('PRO2') - READ (NDS,NML=PRO2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=PRO2,IOSTAT=J) #endif #ifdef W3_SMC CASE('PSMC') - READ (NDS,NML=PSMC,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=PSMC,IOSTAT=J) #endif #ifdef W3_PR3 CASE('PRO3') - READ (NDS,NML=PRO3,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=PRO3,IOSTAT=J) #endif #ifdef W3_RTD CASE('ROTD') - READ (NDS,NML=ROTD,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=ROTD,IOSTAT=J) CASE('ROTB') - READ (NDS,NML=ROTB,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=ROTB,IOSTAT=J) #endif #ifdef W3_REF1 CASE('REF1') - READ (NDS,NML=REF1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=REF1,IOSTAT=J) #endif #ifdef W3_IG1 CASE('SIG1') - READ (NDS,NML=SIG1,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIG1,IOSTAT=J) #endif #ifdef W3_IC2 CASE('SIC2') - READ (NDS,NML=SIC2,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIC2,IOSTAT=J) #endif #ifdef W3_IC3 CASE('SIC3') - READ (NDS,NML=SIC3,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIC3,IOSTAT=J) #endif #ifdef W3_IC4 CASE('SIC4 ') - READ (NDS,NML=SIC4,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIC4,IOSTAT=J) #endif #ifdef W3_IC5 CASE('SIC5 ') - READ (NDS,NML=SIC5,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=SIC5,IOSTAT=J) #endif CASE('UNST') - READ (NDS,NML=UNST,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=UNST,IOSTAT=J) CASE('OUTS') - READ (NDS,NML=OUTS,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=OUTS,IOSTAT=J) CASE('MISC') - READ (NDS,NML=MISC,END=801,ERR=802,IOSTAT=J) + READ (NDS,NML=MISC,IOSTAT=J) CASE DEFAULT - GOTO 803 + WRITE (NDSE,1003) NAME + CALL EXTCDE(3) END SELECT + ! + IF (J.NE.0) CALL EXTIOF(NDSE,J,'READNL','',1,FIELD=NAME) + ! STATUS = '(user def. values) :' RETURN END IF @@ -7460,44 +7485,8 @@ SUBROUTINE READNL ( NDS, NAME, STATUS ) END DO END DO ! -800 CONTINUE - RETURN - ! -801 CONTINUE - WRITE (NDSE,1001) NAME - CALL EXTCDE(1) - RETURN - ! -802 CONTINUE - WRITE (NDSE,1002) NAME, J - CALL EXTCDE(2) - RETURN - ! -803 CONTINUE - WRITE (NDSE,1003) NAME - CALL EXTCDE(3) - RETURN - ! -#ifdef W3_NL2 -804 CONTINUE - WRITE (NDSE,1004) NDEPTH - CALL EXTCDE(4) - RETURN -#endif - ! -#ifdef W3_NL3 -804 CONTINUE - WRITE (NDSE,1004) NQDEF - CALL EXTCDE(4) - RETURN -#endif - ! ! Formats ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/ & - ' PREMATURE END OF FILE IN READING ',A/) -1002 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/ & - ' ERROR IN READING ',A,' IOSTAT =',I8/) 1003 FORMAT (/' *** WAVEWATCH III ERROR IN READNL : '/ & ' NAMELIST NAME ',A,' NOT RECOGNIZED'/) #ifdef W3_NL2 diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index fbefffc843..c72bd502d4 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -71,6 +71,7 @@ MODULE W3INITMD !/ 25-Sep-2020 : Extra fields for coupling restart ( version 7.10 ) !/ 22-Mar-2021 : Extra coupling fields ( version 7.13 ) !/ 22-Jun-2021 : GKE NL5 (Q. Liu) ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -283,6 +284,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, ! W3DMO5 Subr. Id. Set array sizes in data structure. ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. + ! EXTOPN Subr. Id. Program abort if open file fails. ! EXTCDE Subr. Id. Program abort. ! WWDATE Subr. Id. System date. ! WWTIME Subr. Id. System time. @@ -379,7 +381,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, USE W3IOGRMD, ONLY: W3IOGR USE W3IORSMD, ONLY: W3IORS USE W3IOPOMD, ONLY: W3IOPP - USE W3SERVMD, ONLY: ITRACE, EXTCDE, WWDATE, WWTIME + USE W3SERVMD, ONLY: ITRACE, EXTCDE, EXTOPN, WWDATE, WWTIME #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -678,13 +680,17 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, IFT = LEN_TRIM(TFILE) J = LEN_TRIM(FNMPRE) ! - IF ( OUTPTS(IMOD)%IAPROC .EQ. OUTPTS(IMOD)%NAPLOG ) & - OPEN (MDS(1), FILE=FNMPRE(:J)//LFILE(:IFL),ERR=888,IOSTAT=IERR) + IF ( OUTPTS(IMOD)%IAPROC .EQ. OUTPTS(IMOD)%NAPLOG ) THEN + OPEN (MDS(1), FILE=FNMPRE(:J)//LFILE(:IFL),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3INIT','LOG',1) + END IF ! IF ( MDS(3).NE.MDS(1) .AND. MDS(3).NE.MDS(4) .AND. TSTOUT ) THEN INQUIRE (MDS(3),OPENED=OPENED) - IF ( .NOT. OPENED ) OPEN (MDS(3),FILE=FNMPRE(:J)//TFILE(:IFT), ERR=889, & - IOSTAT=IERR) + IF ( .NOT. OPENED ) THEN + OPEN (MDS(3),FILE=FNMPRE(:J)//TFILE(:IFT),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3INIT','TEST',2) + END IF END IF ! ! 1.d Dataset unit numbers @@ -797,9 +803,15 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, NSEALM = NSEALMout call print_memcheck(memunit, 'memcheck_____:'//' WW3_INIT SECTION 2f') #ifdef W3_DIST - IF ( NSEA .LT. NAPROC ) GOTO 820 + IF ( NSEA .LT. NAPROC ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8020) NSEA, NAPROC + CALL EXTCDE ( 820 ) + END IF IF (LPDLIB .eqv. .FALSE.) THEN - IF ( NSPEC .LT. NAPROC ) GOTO 821 + IF ( NSPEC .LT. NAPROC ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8021) NSPEC, NAPROC + CALL EXTCDE ( 821 ) + END IF END IF #endif @@ -942,7 +954,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_DIST IF (LPDLIB .eqv. .FALSE.) THEN DO ISP=1, NSPEC - IF ( IAPPRO(ISP) .EQ. -1. ) GOTO 829 + IF ( IAPPRO(ISP) .EQ. -1. ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8029) + CALL EXTCDE ( 829 ) + END IF END DO END IF #endif @@ -1533,32 +1548,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #endif RETURN ! - ! Escape locations read errors : - ! -#ifdef W3_DIST -820 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8020) NSEA, NAPROC - CALL EXTCDE ( 820 ) - ! -821 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8021) NSPEC, NAPROC - CALL EXTCDE ( 821 ) - ! -829 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8029) - CALL EXTCDE ( 829 ) -#endif - - ! -888 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,8000) IERR - CALL EXTCDE ( 1 ) - ! -889 CONTINUE - ! === no process number filtering for test file !!! === - WRITE (NDSE,8001) IERR - CALL EXTCDE ( 2 ) - ! ! Formats ! 900 FORMAT ( ' WAVEWATCH III log file ', & @@ -1618,12 +1607,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, 987 FORMAT (/' Coupling output fields : '/ & '--------------------------------------------------') ! -8000 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/ & - ' ERROR IN OPENING LOG FILE'/ & - ' IOSTAT =',I5/) -8001 FORMAT (/' *** WAVEWATCH III ERROR IN W3INIT : '/ & - ' ERROR IN OPENING TEST FILE'/ & - ' IOSTAT =',I5/) 8002 FORMAT (/' *** WAVEWATCH III WARNING IN W3INIT : '/ & ' SIGNIFICANT PART OF RESOURCES RESERVED FOR', & ' OUTPUT :',F6.1,'%'/) diff --git a/model/src/w3iobcmd.F90 b/model/src/w3iobcmd.F90 index f1da6a18db..9dd3c9e3db 100644 --- a/model/src/w3iobcmd.F90 +++ b/model/src/w3iobcmd.F90 @@ -55,6 +55,8 @@ MODULE W3IOBCMD ! W3CSPC Subr. W3CSPCMD Spectral grid conversion. ! W3LLTOEQ Subr. W3CSPCMD Standard to rotated lat/lon conversion. ! STRACE Subr. W3SERVMD Subroutine tracing. + ! EXTIOF Subr. W3SERVMD Abort if error when I/O file. + ! EXTOPN Subr. W3SERVMD Abort if error when opening file. ! EXTCDE Subr. W3SERVMD Abort program with exit code. ! ---------------------------------------------------------------- ! @@ -132,6 +134,7 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) !/ of input spectra for rotated grids ( version 6.02 ) !/ 07-Oct-2019 : RTD option with standard lat-lon !/ grid when nesting to rotated grid ( version 7.11 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -237,7 +240,7 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) FILED, SPCONV, FNMPRE USE W3GSRUMD ! - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -327,7 +330,13 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) WRITE (NDST,9001) FILEN(:5+I), NDSB #endif OPEN (NDSB,FILE=FNMPRE(:J)//FILEN(:5+I),form='UNFORMATTED', convert=file_endian, & - ERR=801,IOSTAT=IERR,STATUS='OLD') + IOSTAT=IERR,STATUS='OLD') + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) IMOD + IOTST = 1 + FLBPI = .FALSE. + RETURN + END IF END IF ! IF ( INXOUT.EQ.'WRITE' .AND. FILEW ) THEN @@ -339,7 +348,8 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) WRITE (NDST,9001) FILEN(:6+I), NDSL(IFILE) #endif OPEN (NDSL(IFILE),FILE=FNMPRE(:J)//FILEN(:6+I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOBC','',40,NAMEF=FILEN) END DO END IF ! @@ -349,7 +359,8 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) WRITE (NDST,9001) FILEN(:5+I), NDSB #endif OPEN (NDSB,FILE=FNMPRE(:J)//FILEN(:5+I),form='UNFORMATTED', convert=file_endian, & - ERR=800,IOSTAT=IERR) + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOBC','',40,NAMEF=FILEN) END IF ! ! test info ---------------------------------------------------------- * @@ -421,8 +432,9 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ! IF ( INXOUT.EQ.'READ' .AND. FILER ) THEN ! - READ (NDSB,ERR=803,IOSTAT=IERR) & + READ (NDSB,IOSTAT=IERR) & IDTST, VERTST, NKI, NTHI, XFRI, FR1I, TH1I, NBI + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3IOBC','',41) ! #ifdef W3_T WRITE (NDST,9002) 1, NDSB, IDTST, VERTST, NBI @@ -448,10 +460,11 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ! CALL W3DMO5 ( IGRD, NDSE, NDST, 1 ) ! - READ (NDSB,ERR=803,IOSTAT=IERR) & - (XBPI(I),I=1,NBI), (YBPI(I),I=1,NBI), & - ((IPBPI(I,J),I=1,NBI),J=1,4), & + READ (NDSB,IOSTAT=IERR) & + (XBPI(I),I=1,NBI), (YBPI(I),I=1,NBI), & + ((IPBPI(I,J),I=1,NBI),J=1,4), & ((RDBPI(I,J),I=1,NBI),J=1,4) + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3IOBC','',41) ! #ifdef W3_RTD ! All boundary conditions position arrays XBPI, YBPI are defined @@ -546,7 +559,28 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ! ! Read first time and allocate ABPI0/N ! - READ (NDSB,END=810,ERR=810) TIME2, NBI2 + READ (NDSB,IOSTAT=IERR) TIME2, NBI2 + IF (IERR.NE.0) THEN + IF ( FILER ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) + CALL EXTCDE ( 43 ) + END IF + ! +#ifdef W3_T + WRITE (NDST,9022) +#endif + TIME1(1) = TIME2(1) + TIME1(2) = TIME2(2) + DO IP=0, NBI2 + DO ISP=1, NSPEC + ABPI0(ISP,IP) = ABPIN(ISP,IP) + END DO + END DO + ! + IOTST = -1 + FLBPI = .FALSE. + RETURN + END IF BACKSPACE (NDSB) #ifdef W3_T WRITE (NDST,9012) NDSB, TIME2, NBI2 @@ -585,7 +619,28 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) END IF ! IF ( INXOUT .EQ. 'READ' ) THEN - READ (NDSB,ERR=810,END=810) TIME2, NBI2 + READ (NDSB,IOSTAT=IERR) TIME2, NBI2 + IF (IERR.NE.0) THEN + IF ( FILER ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) + CALL EXTCDE ( 43 ) + END IF + ! +#ifdef W3_T + WRITE (NDST,9022) +#endif + TIME1(1) = TIME2(1) + TIME1(2) = TIME2(2) + DO IP=0, NBI2 + DO ISP=1, NSPEC + ABPI0(ISP,IP) = ABPIN(ISP,IP) + END DO + END DO + ! + IOTST = -1 + FLBPI = .FALSE. + RETURN + END IF #ifdef W3_T WRITE (NDST,9011) NDSB, TIME2, NBI2 #endif @@ -664,7 +719,8 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ! IF ( .NOT. SPCONV ) THEN DO IP=1, NBI2 - READ (NDSB,ERR=803,IOSTAT=IERR) ABPIN(:,IP) + READ (NDSB,IOSTAT=IERR) ABPIN(:,IP) + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3IOBC','',41) END DO ELSE ! @@ -674,7 +730,8 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ! ALLOCATE ( TMPSPC(NKI*NTHI,NBI2) ) DO IP=1, NBI2 - READ (NDSB,ERR=803,IOSTAT=IERR) TMPSPC(:,IP) + READ (NDSB,IOSTAT=IERR) TMPSPC(:,IP) + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3IOBC','',41) END DO CALL W3CSPC ( TMPSPC , NKI, NTHI, XFRI, FR1I, TH1I, & ABPIN(:,1:NBI2),NK, NTH, XFR, FR1, TH(1),& @@ -721,47 +778,6 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ! RETURN ! - ! Escape locations IO errors - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) FILEN, IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) IMOD - IOTST = 1 - FLBPI = .FALSE. - RETURN - ! -802 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) - CALL EXTCDE ( 41 ) - ! -803 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) IERR - CALL EXTCDE ( 42 ) - ! -810 CONTINUE - IF ( FILER ) THEN - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) - CALL EXTCDE ( 43 ) - END IF - ! -#ifdef W3_T - WRITE (NDST,9022) -#endif - TIME1(1) = TIME2(1) - TIME1(2) = TIME2(2) - DO IP=0, NBI2 - DO ISP=1, NSPEC - ABPI0(ISP,IP) = ABPIN(ISP,IP) - END DO - END DO - ! - IOTST = -1 - FLBPI = .FALSE. - RETURN - ! ! Formats ! 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC :'/ & @@ -781,21 +797,11 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) ' WILL NOT BE UPDATED') 920 FORMAT (/' *** SMCTYPE mapped boundary cells:'/ ((I8,2F9.3)) ) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/ & - ' ERROR IN OPENING FILE ',A/ & - ' IOSTAT =',I5/) - ! ! Note: This 1001 error can occur when multi-grid time steps are not ! compatible. 1001 FORMAT (/' *** WAVEWATCH III WARNING IN W3IOBC : '/ & ' INPUT FILE WITH BOUNDARY CONDITIONS NOT FOUND'/ & ' BOUNDARY CONDITIONS WILL NOT BE UPDATED ',I5/) -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/ & - ' PREMATURE END OF FILE'/) -1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/ & - ' ERROR IN READING FROM FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOBC : '/ & ' NO DATA IN INPUT FILE'/) ! diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index cceafe4fa9..91a82f9001 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -75,6 +75,7 @@ MODULE W3IOGOMD !/ 21-Jul-2022 : Correct FP0 calc for peak energy in ( version 7.14 ) !/ min/max freq band (B. Pouliot, CMC) !/ 02-Mar-2024 : Add skweness and EM bias varaible ( version 7.xx ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2024 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -113,6 +114,7 @@ MODULE W3IOGOMD ! W3DIMW Subr. W3WDATMD Allocate data structure. ! W3DIMA Subr. W3ADATMD Allocate data structure. ! STRACE Subr. W3SERVMD Subroutine tracing. ( !/S ) + ! EXTOPN Subr. W3SERVMD Abort if error when opening file. ! EXTCDE Subr. W3SERVMD Program abort with exit code. ! ---------------------------------------------------------------- ! @@ -444,7 +446,14 @@ SUBROUTINE W3READFLGRD ( NDSI , NDSO, NDSS, NDSEN, COMSTR, & DO IFI=1,NOGRP ! Loop over field output groups ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002) AFLG + READ (NDSI,*,IOSTAT=IERR) AFLG + IF (IERR.LT.0) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN,1001) + RETURN + ELSE IF (IERR.GT.0) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1002) IFI, IERR + RETURN + END IF IF (AFLG.EQ.'T') THEN FLG1D(IFI)=.TRUE. ELSE IF (AFLG.EQ.'F') THEN @@ -454,12 +463,19 @@ SUBROUTINE W3READFLGRD ( NDSI , NDSO, NDSS, NDSEN, COMSTR, & EXIT ELSE IERR=1 - GOTO 2005 + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1005) AFLG + RETURN END IF IF ( FLG1D (IFI) ) THEN ! Skip if group not requested CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=2001,ERR=2006,IOSTAT=IERR) & - FLDOUT + READ (NDSI,'(A)',IOSTAT=IERR) FLDOUT + IF (IERR.LT.0) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN,1001) + RETURN + ELSE IF (IERR.GT.0) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1006) IFI,IERR + RETURN + END IF OUT_NAMES(:)='' CALL STRSPLIT(FLDOUT,OUT_NAMES) IFJ=0 @@ -477,7 +493,14 @@ SUBROUTINE W3READFLGRD ( NDSI , NDSO, NDSS, NDSEN, COMSTR, & ! 2. Reads and splits list of output field names ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=2001,ERR=2003,IOSTAT=IERR) FLDOUT + READ (NDSI,'(A)',IOSTAT=IERR) FLDOUT + IF (IERR.LT.0) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN,1001) + RETURN + ELSE IF (IERR.GT.0) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1003) IERR + RETURN + END IF OUT_NAMES(:)='' CALL STRSPLIT(FLDOUT,OUT_NAMES) IOUT=0 @@ -521,23 +544,6 @@ SUBROUTINE W3READFLGRD ( NDSI , NDSO, NDSS, NDSEN, COMSTR, & ! RETURN ! -2001 CONTINUE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN,1001) - RETURN -2002 CONTINUE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1002) IFI, IERR - RETURN -2003 CONTINUE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1003) IERR - RETURN - !2004 CONTINUE ! replaced by warning in code .... -2005 CONTINUE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1005) AFLG - RETURN -2006 CONTINUE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSEN, 1006) IFI,IERR - RETURN - ! 1945 FORMAT ( ' Fields : ',A) 1946 FORMAT ( ' ',A) ! @@ -2535,9 +2541,9 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & FNMPRE, FNMGRD, NOSWLL, NOEXTR !/ - USE W3SERVMD, ONLY: EXTCDE - USE W3ODATMD, only : IAPROC - USE W3ODATMD, ONLY : OFILES + USE W3SERVMD, ONLY: EXTCDE, EXTOPN, EXTIOF + USE W3ODATMD, only: IAPROC + USE W3ODATMD, ONLY: OFILES #ifdef W3_SETUP USE W3WDATMD, ONLY: ZETA_SETUP #endif @@ -2644,14 +2650,17 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & #endif IF ( WRITE ) THEN OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I), & - form ='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form ='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) #ifdef W3_ASCII OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I)//'.txt', & - form ='FORMATTED',ERR=800,IOSTAT=IERR) + form ='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) #endif ELSE OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR,STATUS='OLD') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) END IF ! REWIND ( NDSOG ) @@ -2664,16 +2673,17 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & UNDEF, NOSWLL #ifdef W3_ASCII - WRITE (NDSOA,*) & + WRITE (NDSOA,*) & 'IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & - UNDEF, NOSWLL:', & - IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & + UNDEF, NOSWLL:', & + IDSTR, VEROGR, GNAME, NOGRP, NGRPP, NSEA, NX, NY, & UNDEF, NOSWLL #endif ELSE - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOG,IOSTAT=IERR) & IDTST, VERTST, TNAME, MOGRP, MGRPP, NSEA, NX, NY, & UNDEF, MOSWLL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) ! IF ( IDTST .NE. IDSTR ) THEN WRITE (NDSE,902) IDTST, IDSTR @@ -2729,14 +2739,17 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & #endif IF ( WRITE ) THEN OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_grd.' & - //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + //FILEXT(:I),form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) #ifdef W3_ASCII OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_grd.' & - //FILEXT(:I)//'.txt',form='FORMATTED',ERR=800,IOSTAT=IERR) + //FILEXT(:I)//'.txt',form='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) #endif ELSE OPEN (NDSOG,FILE=FNMPRE_LOCAL(:J)//'out_grd.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR,STATUS='OLD') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) END IF ! REWIND ( NDSOG ) @@ -2756,9 +2769,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & UNDEF, NOSWLL #endif ELSE - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOG,IOSTAT=IERR) & IDTST, VERTST, TNAME, MOGRP, MGRPP, NSEA, NX, NY, & UNDEF, MOSWLL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) ! IF ( IDTST .NE. IDSTR ) THEN WRITE (NDSE,902) IDTST, IDSTR @@ -2798,7 +2812,16 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & TIME, FLOGRD #endif ELSE - READ (NDSOG,END=803,ERR=802,IOSTAT=IERR) TIME, FLOGRD + READ (NDSOG,IOSTAT=IERR) TIME, FLOGRD + IF (IERR.LT.0) THEN + IOTST = -1 +#ifdef W3_T + WRITE (NDST,9020) +#endif + RETURN + ELSE IF (IERR.GT.0) THEN + CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + END IF END IF ! #ifdef W3_T @@ -2817,8 +2840,9 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) #endif ELSE - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOG,IOSTAT=IERR) & ((MAPTMP(IY,IX),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) MAPSTA = MOD(MAPTMP+2,8) - 2 MAPST2 = (MAPTMP-MAPSTA) / 8 END IF @@ -3706,343 +3730,285 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! Section 1) ! IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) DW(1:NSEA) + READ (NDSOG,IOSTAT=IERR) DW(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) CX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) CY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) CX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) CY(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) UA(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) UD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) UA(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) UD(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) AS(1:NSEA) + READ (NDSOG,IOSTAT=IERR) AS(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) WLV(1:NSEA) + READ (NDSOG,IOSTAT=IERR) WLV(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) ICE(1:NSEA) + READ (NDSOG,IOSTAT=IERR) ICE(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) BERG(1:NSEA) + READ (NDSOG,IOSTAT=IERR) BERG(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 8 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) TAUA(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) TAUADIR(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TAUA(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUADIR(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 9 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) RHOAIR(1:NSEA) + READ (NDSOG,IOSTAT=IERR) RHOAIR(1:NSEA) #ifdef W3_BT4 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 10 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) SED_D50(1:NSEA) + READ (NDSOG,IOSTAT=IERR) SED_D50(1:NSEA) #endif #ifdef W3_IS2 ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 11 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) ICEH(1:NSEA) + READ (NDSOG,IOSTAT=IERR) ICEH(1:NSEA) ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 12 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) ICEF(1:NSEA) + READ (NDSOG,IOSTAT=IERR) ICEF(1:NSEA) #endif #ifdef W3_SETUP ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 13 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) ZETA_SETUP(1:NSEA) + READ (NDSOG,IOSTAT=IERR) ZETA_SETUP(1:NSEA) #endif ! ! Section 2) ! ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) HS(1:NSEA) + READ (NDSOG,IOSTAT=IERR) HS(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) WLM(1:NSEA) + READ (NDSOG,IOSTAT=IERR) WLM(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) T02(1:NSEA) + READ (NDSOG,IOSTAT=IERR) T02(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) T0M1(1:NSEA) + READ (NDSOG,IOSTAT=IERR) T0M1(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) T01(1:NSEA) + READ (NDSOG,IOSTAT=IERR) T01(1:NSEA) ELSE IF ( (IFI .EQ. 2 .AND. IFJ .EQ. 6) .OR. & (IFI .EQ. 2 .AND. IFJ .EQ. 18) ) THEN ! Note: TP output is derived from FP field. - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) FP0(1:NSEA) + READ (NDSOG,IOSTAT=IERR) FP0(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) THM(1:NSEA) + READ (NDSOG,IOSTAT=IERR) THM(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) THS(1:NSEA) + READ (NDSOG,IOSTAT=IERR) THS(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - THP0(1:NSEA) + READ (NDSOG,IOSTAT=IERR) THP0(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 10 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - HSIG(1:NSEA) + READ (NDSOG,IOSTAT=IERR) HSIG(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 11 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - STMAXE(1:NSEA) + READ (NDSOG,IOSTAT=IERR) STMAXE(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 12 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - STMAXD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) STMAXD(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 13 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - HMAXE(1:NSEA) + READ (NDSOG,IOSTAT=IERR) HMAXE(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 14 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - HCMAXE(1:NSEA) + READ (NDSOG,IOSTAT=IERR) HCMAXE(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 15 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - HMAXD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) HMAXD(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 16 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - HCMAXD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) HCMAXD(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 17 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) WBT(1:NSEA) + READ (NDSOG,IOSTAT=IERR) WBT(1:NSEA) ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 19 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WNMEAN(1:NSEA) + READ (NDSOG,IOSTAT=IERR) WNMEAN(1:NSEA) ! ! Section 3) ! ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - EF(1:NSEA,E3DF(2,1):E3DF(3,1)) + READ (NDSOG,IOSTAT=IERR) EF(1:NSEA,E3DF(2,1):E3DF(3,1)) ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TH1M(1:NSEA,E3DF(2,2):E3DF(3,2)) + READ (NDSOG,IOSTAT=IERR) TH1M(1:NSEA,E3DF(2,2):E3DF(3,2)) ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - STH1M(1:NSEA,E3DF(2,3):E3DF(3,3)) + READ (NDSOG,IOSTAT=IERR) STH1M(1:NSEA,E3DF(2,3):E3DF(3,3)) ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TH2M(1:NSEA,E3DF(2,4):E3DF(3,4)) + READ (NDSOG,IOSTAT=IERR) TH2M(1:NSEA,E3DF(2,4):E3DF(3,4)) ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - STH2M(1:NSEA,E3DF(2,5):E3DF(3,5)) + READ (NDSOG,IOSTAT=IERR) STH2M(1:NSEA,E3DF(2,5):E3DF(3,5)) ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 6) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WN(1:NK,1:NSEA) + READ (NDSOG,IOSTAT=IERR) WN(1:NK,1:NSEA) ! ! Section 4) ! ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PHS(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PHS(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PTP(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PTP(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PLP(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PLP(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PDIR(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PDIR(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PSI(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PSI(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PWS(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PWS(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PTHP0(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PTHP0(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PQP(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PQP(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 9 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PPE(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PPE(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 10 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PGW(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PGW(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 11 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PSW(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PSW(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 12 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PTM1(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PTM1(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 13 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PT1(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PT1(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 14 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PT2(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PT2(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 15 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PEP(1:NSEA,0:NOSWLL) + READ (NDSOG,IOSTAT=IERR) PEP(1:NSEA,0:NOSWLL) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PWST(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PWST(1:NSEA) ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) PNR(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PNR(1:NSEA) ! ! Section 5) ! ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - UST(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - USTDIR(1:NSEA) + READ (NDSOG,IOSTAT=IERR) UST(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) USTDIR(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - CHARN(1:NSEA) + READ (NDSOG,IOSTAT=IERR) CHARN(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) CGE(1:NSEA) + READ (NDSOG,IOSTAT=IERR) CGE(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PHIAW(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PHIAW(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUWIX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUWIY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TAUWIX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUWIY(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUWNX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUWNY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TAUWNX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUWNY(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,1) + READ (NDSOG,IOSTAT=IERR) WHITECAP(1:NSEA,1) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,2) + READ (NDSOG,IOSTAT=IERR) WHITECAP(1:NSEA,2) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,3) + READ (NDSOG,IOSTAT=IERR) WHITECAP(1:NSEA,3) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,4) + READ (NDSOG,IOSTAT=IERR) WHITECAP(1:NSEA,4) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TWS(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TWS(1:NSEA) ! ! Section 6) ! ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) SXX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) SYY(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) SXY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) SXX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) SYY(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) SXY(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUOX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUOY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TAUOX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUOY(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - BHD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) BHD(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PHIOC(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PHIOC(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TUSX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TUSY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TUSX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TUSY(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - USSX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - USSY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) USSX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) USSY(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PRMS(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TPMS(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PRMS(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TPMS(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 8 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - US3D(1:NSEA,US3DF(2):US3DF(3)) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) + READ (NDSOG,IOSTAT=IERR) US3D(1:NSEA,US3DF(2):US3DF(3)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) + READ (NDSOG,IOSTAT=IERR) P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUICE(1:NSEA,1) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUICE(1:NSEA,2) + READ (NDSOG,IOSTAT=IERR) TAUICE(1:NSEA,1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUICE(1:NSEA,2) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PHICE(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PHICE(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - USSP(1:NSEA,1:USSPF(2)) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - USSP(1:NSEA,NK+1:NK+USSPF(2)) + READ (NDSOG,IOSTAT=IERR) USSP(1:NSEA,1:USSPF(2)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) USSP(1:NSEA,NK+1:NK+USSPF(2)) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUOCX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUOCY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) TAUOCX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUOCY(1:NSEA) ! ! Section 7) ! ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) ABA(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) ABD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) ABA(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) ABD(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) UBA(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) UBD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) UBA(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) UBD(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - BEDFORMS(1:NSEA,1) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - BEDFORMS(1:NSEA,2) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - BEDFORMS(1:NSEA,3) + READ (NDSOG,IOSTAT=IERR) BEDFORMS(1:NSEA,1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) BEDFORMS(1:NSEA,2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) BEDFORMS(1:NSEA,3) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - PHIBBL(1:NSEA) + READ (NDSOG,IOSTAT=IERR) PHIBBL(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUBBL(1:NSEA,1) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUBBL(1:NSEA,2) + READ (NDSOG,IOSTAT=IERR) TAUBBL(1:NSEA,1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) TAUBBL(1:NSEA,2) ! ! Section 8) ! ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - MSSX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - MSSY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) MSSX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) MSSY(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - MSCX(1:NSEA) - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - MSCY(1:NSEA) + READ (NDSOG,IOSTAT=IERR) MSCX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) + READ (NDSOG,IOSTAT=IERR) MSCY(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - MSSD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) MSSD(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - MSCD(1:NSEA) + READ (NDSOG,IOSTAT=IERR) MSCD(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QP(1:NSEA) + READ (NDSOG,IOSTAT=IERR) QP(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) QKK(1:NSEA) + READ (NDSOG,IOSTAT=IERR) QKK(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) SKEW(1:NSEA) + READ (NDSOG,IOSTAT=IERR) SKEW(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) EMBIA1(1:NSEA) + READ (NDSOG,IOSTAT=IERR) EMBIA1(1:NSEA) ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) EMBIA2(1:NSEA) + READ (NDSOG,IOSTAT=IERR) EMBIA2(1:NSEA) ! ! Section 9) ! ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - DTDYN(1:NSEA) + READ (NDSOG,IOSTAT=IERR) DTDYN(1:NSEA) ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - FCUT(1:NSEA) + READ (NDSOG,IOSTAT=IERR) FCUT(1:NSEA) ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - CFLXYMAX(1:NSEA) + READ (NDSOG,IOSTAT=IERR) CFLXYMAX(1:NSEA) ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - CFLTHMAX(1:NSEA) + READ (NDSOG,IOSTAT=IERR) CFLTHMAX(1:NSEA) ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - CFLKMAX(1:NSEA) + READ (NDSOG,IOSTAT=IERR) CFLKMAX(1:NSEA) ! ! Section 10) ! ELSE IF ( IFI .EQ. 10 ) THEN - READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - USERO(1:NSEA,IFJ) + READ (NDSOG,IOSTAT=IERR) USERO(1:NSEA,IFJ) END IF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGO','',42) ! ! End of test on WRITE/READ: ! @@ -4071,34 +4037,14 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & IF ( WRITE .AND. (OFILES(1).EQ.1) ) THEN NDSOGLOG = NDSOG OPEN (NDSOGLOG,FILE=FNMPRE_LOCAL(:J)//'log.'//TIMETAG//'.out_grd.'//FILEXT(:I)//'.txt', & - form ='FORMATTED',ERR=800,IOSTAT=IERR) + form ='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGO','',41) WRITE (NDSOGLOG,*) 'The '//TRIM(TIMETAG)//'.out_grd.'//TRIM(FILEXT(:I))// & ' file has been successfully written!' CALL FLUSH (NDSOGLOG) CLOSE (NDSOGLOG) ENDIF - RETURN - ! - ! Escape locations read errors - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 41 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 42 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 43 ) - ! -803 CONTINUE - IOTST = -1 -#ifdef W3_T - WRITE (NDST,9020) -#endif RETURN ! ! Formats @@ -4126,15 +4072,6 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! 999 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGO :'/ & ! ' PLEASE UPDATE FIELDS !!! '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGO : '/ & - ' ERROR IN OPENING FILE'/ & - ' IOSTAT =',I5/) -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGO : '/ & - ' PREMATURE END OF FILE'/) -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGO : '/ & - ' ERROR IN READING FROM FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST W3IOGO : IPASS =',I4,' INXOUT = ',A, & ' WRITE = ',L1,' UNIT =',I3/ & diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 338c8ef071..e8302d1dd6 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -66,6 +66,7 @@ MODULE W3IOGRMD ! INSNL5 Subr. W3SNL5MD Initialization of GKE. ! INSNLS Subr. W3SNLSMD Initialization of nonlinear `smoother'. ! STRACE Subr. W3SERVMD Subroutine tracing. + ! EXTIOF Subr. W3SERVMD Abort if error when I/O file. ! EXTCDE Subr. W3SERVMD Abort program with exit code. ! ---------------------------------------------------------------- ! @@ -190,6 +191,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & !/ 19-Oct-2020 : Add AIRCMIN, AIRGB parameters ( version 7.08 ) !/ 07-07-2021 : S_{nl} GKE NL5 (Q. Liu) ( version 7.12 ) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -302,7 +304,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & USE W3SIS2MD, ONLY: INSIS2 #endif USE W3TIMEMD, ONLY: CALTYPE - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -570,14 +572,17 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & !AR: ADD DEBUGFLAG WRITE(*,*) 'FILE=', FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT) IF ( WRITE ) THEN OPEN (NDSM,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),50) #ifdef W3_ASCII OPEN (NDSA,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT)//'.txt', & - form='FORMATTED',ERR=800,IOSTAT=IERR) + form='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),50) #endif ELSE OPEN (NDSM,FILE=FNMPRE(:IPRE)//'mod_def.'//FILEXT(:IEXT), & - form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=800,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),50) ENDIF ! REWIND ( NDSM ) @@ -631,17 +636,20 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & WRITE (NDST,9003) (NBO2(I),I=0,NFBPO) #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & IDTST, VERTST, NX, NY, NSEA, MTH, MK, & NBI, NFBPO, GNAME, FNAME0, FNAME1, FNAME2, FNAME3, & FNAME4, FNAME5, FNAME6, FNAMEP, FNAMEG, & FNAMEF, FNAMEI + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) ! #ifdef W3_SMC - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & NCel, NUFc, NVFc, NRLv, MRFct - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) + READ (NDSM,IOSTAT=IERR) & NGLO, NARC, NBGL, NBAC, NBSMC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif ! NK = MK @@ -734,8 +742,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & CALL EXTCDE ( 24 ) END IF ! - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & (NBO(I),I=0,NFBPO), (NBO2(I),I=0,NFBPO) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #ifdef W3_T WRITE (NDST,9002) (NBO(I),I=0,NFBPO) WRITE (NDST,9003) (NBO2(I),I=0,NFBPO) @@ -945,8 +954,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & ELSE call print_memcheck(memunit, 'memcheck_____:'//' WIOGR SECTION 4') - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - GTYPE, FLAGLL, ICLOSE + READ (NDSM,IOSTAT=IERR) GTYPE, FLAGLL, ICLOSE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) !!Li IF (.NOT.GINIT) CALL W3DIMX ( IGRD, NX, NY, NSEA, NDSE, NDST ) IF (.NOT.GINIT) CALL W3DIMX ( IGRD, NX, NY, NSEA, NDSE, NDST & #ifdef W3_SMC @@ -960,8 +969,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SELECT CASE ( GTYPE ) !!Li SMCTYPE shares info with RLGTYPE. JGLi12Oct2020 CASE ( RLGTYPE, SMCTYPE ) - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - SX, SY, X0, Y0 + READ (NDSM,IOSTAT=IERR) SX, SY, X0, Y0 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) DO IX=1,NX XGRD(:,IX) = REAL(X0 + REAL(IX-1)*SX) END DO @@ -970,8 +979,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & END DO CASE ( CLGTYPE ) ALLOCATE(XGRD4(NY,NX),YGRD4(NY,NX)); XGRD4 = 0.; YGRD4 = 0. - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - XGRD4, YGRD4 + READ (NDSM,IOSTAT=IERR) XGRD4, YGRD4 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) XGRD = XGRD4 YGRD = YGRD4 DEALLOCATE(XGRD4, YGRD4) @@ -979,7 +988,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & X0 = HUGE(X0); Y0 = HUGE(Y0) SX = HUGE(SX); SY = HUGE(SY) CASE (UNGTYPE) - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & FSBCCFL, FSREFRACTION, FSFREQSHIFT, FSSOURCE, & DO_CHANGE_WLV, SOLVERTHR_STP, CRIT_DEP_STP, & @@ -996,30 +1005,33 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & B_JGS_NORM_THR, & B_JGS_NLEVEL, & B_JGS_SOURCE_NONLINEAR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) IF (.NOT. GUGINIT) THEN CALL W3DIMUG ( IGRD, NTRI, NX, COUNTOT, NNZ, NDSE, NDST ) END IF call print_memcheck(memunit, 'memcheck_____:'//' WIOGR SECTION 5') - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) call print_memcheck(memunit, 'memcheck_____:'//' WIOGR SECTION 6') END SELECT !GTYPE ! IF (GTYPE.NE.UNGTYPE) CALL W3GNTX ( IGRD, NDSE, NDST ) - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & ZB, MAPTMP, MAPFS, MAPSF, TRFLAG + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) ! #ifdef W3_SMC IF( GTYPE .EQ. SMCTYPE ) THEN - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - NLvCel, NLvUFc, NLvVFc - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IJKCel, IJKUFc, IJKVFc, ISMCBP + READ (NDSM,IOSTAT=IERR) NLvCel, NLvUFc, NLvVFc + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) + READ (NDSM,IOSTAT=IERR) IJKCel, IJKUFc, IJKVFc, ISMCBP + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) DO J=lbound(IJKCel,2), ubound(IJKCel,2) IJKCel3(J) = IJKCel(3,J) IJKCel4(J) = IJKCel(4,J) @@ -1032,12 +1044,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & IJKUFc5(J) = IJKUFc(5,J) IJKUFc6(J) = IJKUFc(6,J) END DO - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - ICLBAC - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - ANGARC - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - CTRNX, CTRNY, CLATF + READ (NDSM,IOSTAT=IERR) ICLBAC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) + READ (NDSM,IOSTAT=IERR) ANGARC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) + READ (NDSM,IOSTAT=IERR) CTRNX, CTRNY, CLATF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) ENDIF #endif ! @@ -1045,7 +1057,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & MAPST2 = (MAPTMP-MAPSTA) / 8 MAPSF(:,3) = MAPSF(:,2) + (MAPSF(:,1)-1)*NY IF ( TRFLAG .NE. 0 ) THEN - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) TRNX, TRNY + READ (NDSM,IOSTAT=IERR) TRNX, TRNY + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #ifdef W3_UOST ! UOST (Unresolved Obstacles Source Term) is enabled. @@ -1054,7 +1067,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & TRNY = 1 #endif - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & DTCFL, DTCFLI, DTMAX, DTMIN, DMIN, CTMAX, & FICE0, FICEN, FICEL, PFMOVE, FLDRY, FLCX, FLCY, & FLCTH, FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, & @@ -1062,15 +1075,19 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & IICEDISP, ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, & IICEDDISP, IICEHDISP, IICEFDISP, BTBETA,IC_NUMERICS, & AAIRCMIN, AAIRGB + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) - READ(NDSM,END=801,ERR=802,IOSTAT=IERR)GRIDSHIFT + READ(NDSM,IOSTAT=IERR)GRIDSHIFT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #ifdef W3_SEC1 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) NITERSEC1 + READ (NDSM,IOSTAT=IERR) NITERSEC1 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif ! #ifdef W3_RTD !! Read rotated Polat/lon and AnglD from mod_def JGLi12Jun2012 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) PoLat, PoLon, AnglD, FLAGUNR + READ (NDSM,IOSTAT=IERR) PoLat, PoLon, AnglD, FLAGUNR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif ! @@ -1134,10 +1151,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif ELSE IF (.NOT.SINIT) CALL W3DIMS ( IGRD, NK, NTH, NDSE, NDST ) - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & MAPWN, MAPTH, DTH, TH, ESIN, ECOS, ES2, ESC, EC2, & XFR, FR1, SIG, SIG2, DSIP, DSII, DDEN, DDEN2, FTE, & FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! @@ -1160,8 +1178,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & E3DF, P2MSF, US3DF,USSPF, USSP_WN #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - E3DF, P2MSF, US3DF,USSPF, USSP_WN + READ (NDSM,IOSTAT=IERR) E3DF, P2MSF, US3DF,USSPF, USSP_WN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( INXOUT .EQ. 'GRID' ) THEN @@ -1182,8 +1200,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif ELSE CALL W3DMO5 ( IGRD, NDSE, NDST, 2 ) - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - XBPO, YBPO, RDBPO, IPBPO, ISBPO + READ (NDSM,IOSTAT=IERR) XBPO, YBPO, RDBPO, IPBPO, ISBPO + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! #ifdef W3_T @@ -1213,9 +1231,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & PTMETH, PTFCUT #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & IHMAX, HSPMIN, WSMULT, WSCUT, FLCOMB, NOSWLL, & PTMETH, PTFCUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! #ifdef W3_T @@ -1309,40 +1328,41 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & FACP, XREL, XFLT, FXFM, FXPM, XFT, XFC, FACSD, FHMAX, & FFACBERG, DELAB, FWTABLE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #ifdef W3_RWND - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - RWINDC + READ (NDSM,IOSTAT=IERR) RWINDC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_WCOR - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - WWCOR + READ (NDSM,,IOSTAT=IERR) WWCOR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_REF1 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - RREF, REFPARS, REFLC, REFLD + READ (NDSM,IOSTAT=IERR) RREF, REFPARS, REFLC, REFLD + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_IG1 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IGPARS(1:12) + READ (NDSM,IOSTAT=IERR) IGPARS(1:12) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_IC2 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IC2PARS(1:8) + READ (NDSM,IOSTAT=IERR) IC2PARS(1:8) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_IC3 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IC3PARS + READ (NDSM,IOSTAT=IERR) IC3PARS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_IC4 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IC4PARS,IC4_KI,IC4_FC,IC4_CN,IC4_FMIN,IC4_KIBK + READ (NDSM,IOSTAT=IERR) IC4PARS,IC4_KI,IC4_FC,IC4_CN,IC4_FMIN,IC4_KIBK + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif #ifdef W3_IC5 - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IC5PARS + READ (NDSM,IOSTAT=IERR) IC5PARS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) #endif END IF ! @@ -1366,7 +1386,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & NITTIN, CINXSI #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) NITTIN, CINXSI + READ (NDSM,IOSTAT=IERR) NITTIN, CINXSI + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9048) NITTIN, CINXSI #endif @@ -1381,8 +1402,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & NITTIN, CINXSI, CD_MAX, CAP_ID #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - NITTIN, CINXSI, CD_MAX, CAP_ID + READ (NDSM,IOSTAT=IERR) NITTIN, CINXSI, CD_MAX, CAP_ID + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9048) NITTIN, CAP_ID, CINXSI, CD_MAX #endif @@ -1395,7 +1416,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FLX4A0 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) FLX4A0 + READ (NDSM,IOSTAT=IERR) FLX4A0 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #endif ! @@ -1408,7 +1430,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SLNC1, FSPM, FSHF #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SLNC1, FSPM, FSHF + READ (NDSM,IOSTAT=IERR) SLNC1, FSPM, FSHF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9049) SLNC1, FSPM, FSHF #endif @@ -1421,7 +1444,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SINC1, SDSC1 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SINC1, SDSC1 + READ (NDSM,IOSTAT=IERR) SINC1, SDSC1 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9050) SINC1, SDSC1 #endif @@ -1445,11 +1469,12 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & ZWIND, FSWELL, & SHSTAB, OFSTAB, CCNG, CCPS, FFNG, FFPS, & CDSA0, CDSA1, CDSA2, SDSALN, & CDSB0, CDSB1, CDSB2, CDSB3, FPIMIN, XFH, XF1, XF2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) IF ( .NOT. FLINP ) CALL INPTAB FLINP = .TRUE. END IF @@ -1481,12 +1506,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FFXPM, FFXFM #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & SSWELLF, SSDSC1, WWNMEANP, WWNMEANPTAIL, SSTXFTF, & SSTXFTFTAIL, SSTXFTWN, & DDELTA1, DDELTA2, SSTXFTF, SSTXFTWN, & FFXPM, FFXFM + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) IF ( .NOT. FLINP ) THEN CALL INSIN3 FLINP = .TRUE. @@ -1547,7 +1573,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif END IF ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & ZZWND, AALPHA, ZZ0MAX, BBETA, SSINTHP, ZZALP, & TTAUWSHELTER, SSWELLFPAR, SSWELLF, SSINBR, & ZZ0RAT, SSDSC, & @@ -1559,12 +1585,17 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SSDSHCK, & IKTAB, DCKI, QBI, SATINDICES, SATWEIGHTS, & DIKCUMUL, CUMULW, SINTAILPAR, CAPCHNK + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) IF (SINTAILPAR(1).GT.0.5) THEN CALL INSIN4(.FALSE.) - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & DELUST, DELTAIL, DELTAUW, DELU, DELALP, & TAUT, TAUHFT - IF (TTAUWSHELTER.GT.0) READ(NDSM,END=801,ERR=802,IOSTAT=IERR) TAUHFT2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) + IF (TTAUWSHELTER.GT.0) THEN + READ(NDSM,IOSTAT=IERR) TAUHFT2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) + END IF END IF END IF #endif @@ -1583,10 +1614,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SIN6WS, SIN6FC #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & SIN6A0, SDS6ET, SDS6A1, SDS6A2, & SDS6P1, SDS6P2, SWL6S6, SWL6B1, SWL6CSTB1, & SIN6WS, SIN6FC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #endif ! @@ -1608,10 +1640,11 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & IQTPE, NLTAIL, GQNF1, GQNT1, & GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9051) SNLC1, LAM, & KDCON, KDMN, SNLS1, SNLS2, SNLS3, & @@ -1630,12 +1663,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & DPTHNL #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - IQTPE, NLTAIL, NDPTHS + READ (NDSM,IOSTAT=IERR) IQTPE, NLTAIL, NDPTHS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) ALLOCATE ( MPARS(IGRD)%SNLPS%DPTHNL(NDPTHS) ) DPTHNL => MPARS(IGRD)%SNLPS%DPTHNL PINIT = .TRUE. - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) DPTHNL + READ (NDSM,IOSTAT=IERR) DPTHNL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9051) IQTPE, NLTAIL, NDPTHS IF ( FLTEST ) WRITE (NDST,9151) DPTHNL @@ -1658,8 +1692,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SNLCS(1:SNLNQ) #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & SNLNQ, SNLMSC, SNLNSC, SNLSFD, SNLSFS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) ALLOCATE ( MPARS(IGRD)%SNLPS%SNLL(SNLNQ), & MPARS(IGRD)%SNLPS%SNLM(SNLNQ), & MPARS(IGRD)%SNLPS%SNLT(SNLNQ), & @@ -1671,8 +1706,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SNLCD => MPARS(IGRD)%SNLPS%SNLCD SNLCS => MPARS(IGRD)%SNLPS%SNLCS PINIT = .TRUE. - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - SNLL, SNLM, SNLT, SNLCD, SNLCS + READ (NDSM,IOSTAT=IERR) SNLL, SNLM, SNLT, SNLCD, SNLCS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9051) SNLNQ, SNLMSC, SNLNSC, & SNLSFD, SNLSFS @@ -1692,8 +1727,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & ITSA, IALT #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - ITSA, IALT + READ (NDSM,IOSTAT=IERR) ITSA, IALT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9051) ITSA, IALT #endif @@ -1711,9 +1746,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & QI5NNZ, QI5IPL, QI5PMX #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & QR5DPT, QR5OML, QI5DIS, QI5KEV, & QI5NNZ, QI5IPL, QI5PMX + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9051) QR5DPT, QR5OML, QI5DIS, & QI5KEV, QI5NNZ, QI5IPL, & @@ -1730,8 +1766,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9251) & CNLSA, CNLSC, CNLSFM, CNLSC1, CNLSC2, CNLSC3 @@ -1782,7 +1819,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & WRITE (NDSA,*) 'SBTC1:', SBTC1 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) SBTC1 + READ (NDSM,IOSTAT=IERR) SBTC1 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF IF ( FLTEST ) WRITE (NDST,9052) SBTC1 #endif @@ -1798,8 +1836,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SBTCX, SED_D50, SED_PSIC #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - SBTCX, SED_D50, SED_PSIC + READ (NDSM,IOSTAT=IERR) SBTCX, SED_D50, SED_PSIC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #endif ! @@ -1816,8 +1854,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & SDBC1, SDBC2, FDONLY #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - SDBC1, SDBC2, FDONLY + READ (NDSM,IOSTAT=IERR) SDBC1, SDBC2, FDONLY + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! IF ( FLTEST ) WRITE (NDST,9053) SDBC1, SDBC2, FDONLY @@ -1834,9 +1872,10 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & UOSTFACTORLOCAL, UOSTFACTORSHADOW #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & UOSTFILELOCAL, UOSTFILESHADOW, & UOSTFACTORLOCAL, UOSTFACTORSHADOW + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) CALL UOST_INITGRID(IGRD, UOSTFILELOCAL, UOSTFILESHADOW, & UOSTFACTORLOCAL, UOSTFACTORSHADOW) #endif @@ -1853,7 +1892,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & WRITE (NDSA,*) 'IS1C1, IS1C2:', IS1C1, IS1C2 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) IS1C1, IS1C2 + READ (NDSM,IOSTAT=IERR) IS1C1, IS1C2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #endif ! @@ -1864,7 +1904,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & WRITE (NDSA,*) 'IS3PARS:', IS2PARS #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) IS2PARS + READ (NDSM,IOSTAT=IERR) IS2PARS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) IF ( .NOT. FLIS ) THEN CALL INSIS2 FLIS = .TRUE. @@ -1882,8 +1923,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & WRITE (NDSA,*) 'DTME, CLATMN:', DTME, CLATMN #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - DTME, CLATMN + READ (NDSM,IOSTAT=IERR) DTME, CLATMN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! IF ( FLTEST ) WRITE (NDST,9060) DTME, CLATMN @@ -1896,8 +1937,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & WRITE (NDSA,*) 'WDCG, WDTH:', WDCG, WDTH #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - WDCG, WDTH + READ (NDSM,IOSTAT=IERR) WDCG, WDTH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! IF ( FLTEST ) WRITE (NDST,9060) WDCG, WDTH @@ -1911,8 +1952,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & DTMS, Refran, FUNO3, FVERG, FSWND, ARCTC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF ! IF ( FLTEST ) WRITE (NDST,9260) DTMS, Refran @@ -1926,8 +1968,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #endif #ifdef W3_FLD2 @@ -1938,8 +1981,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 #endif ELSE - READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSM,IOSTAT=IERR) & TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF #endif ! @@ -1964,21 +2008,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & ! RETURN ! - ! Escape locations read errors --------------------------------------- * - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) FILEXT(:IEXT), IERR - CALL EXTCDE ( 50 ) - ! -801 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) FILEXT(:IEXT) - CALL EXTCDE ( 51 ) - ! -802 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) FILEXT(:IEXT), IERR, & - MESSAGE - CALL EXTCDE ( 52 ) - ! ! Formats ! 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGR :'/ & @@ -2016,16 +2045,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & , 5(A,/) /) ! ' CHECK CONSISTENCY OF SWITCHES IN PROGRAMS'/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGR : '/ & - ' ERROR IN OPENING mod_def.',A,' FILE'/ & - ' IOSTAT =',I5/) -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGR : '/ & - ' PREMATURE END OF mod_def.',A,' FILE'/) -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOGR : '/, & - ' ERROR IN READING FROM mod_def.',A,' FILE'/ & - ' IOSTAT =',I5, & - 5(A,/) /) - ! #ifdef W3_T 9000 FORMAT (' TEST W3IOGR : INXOUT = ',A,', WRITE = ',L1, & ', UNIT =',I3,', IGRD =',I3,', FEXT = ',A) diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 07038fb7de..110b27202b 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -51,6 +51,7 @@ MODULE W3IOPOMD !/ 05-Jun-2018 : Add SETUP ( version 6.04 ) !/ 04-Oct-2019 : Optional one file per output stride ( version 7.00 ) !/ (R. Padilla-Hernandez & J.H. Alves) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -87,6 +88,8 @@ MODULE W3IOPOMD ! W3SETW Subr. W3WDATMD Data structure management. ! W3DMO2 Subr. W3ODATMD Data structure management. ! STRACE Subr. W3SERVMD Subroutine tracing. + ! EXTIOF Subr. W3SERVMD Abort if error when I/O file. + ! EXTOPN Subr. W3SERVMD Abort if error when opening file. ! EXTCDE Subr. W3SERVMD Program abort with exit code. ! MPI_STARTALL, MPIWAITALL ! Subr. MPI persistent communication routines. @@ -354,7 +357,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) USE W3ODATMD, ONLY: W3DMO2, FNMPRE USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, NAPOUT, SCREEN, & NOPTS, PTLOC, PTNME, GRDID, IPTINT, PTIFAC - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -975,7 +978,6 @@ SUBROUTINE W3IOPE ( A ) #ifdef W3_MPI USE W3ODATMD, ONLY: IRQPO2 #endif - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -2219,7 +2221,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & USE W3ODATMD, ONLY: ZET_SETO #endif !/ - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -2310,14 +2312,17 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & #endif IF ( WRITE ) THEN OPEN (NDSOP,FILE=FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOPO','',20) #ifdef W3_ASCII OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I)//'.txt', & - form='FORMATTED', ERR=800,IOSTAT=IERR) + form='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOPO','',20) #endif ELSE OPEN (NDSOP,FILE=FNMPRE_LOCAL(:J)//'out_pnt.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR,STATUS='OLD') + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR,STATUS='OLD') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOPO','',20) END IF ! REWIND ( NDSOP ) @@ -2334,8 +2339,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & IDSTR, VEROPT, NK, NTH, NOPTS #endif ELSE - READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOP,IOSTAT=IERR) & IDTST, VERTST, MK, MTH, NOPTS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOPO','',21) ! IF ( IDTST .NE. IDSTR ) THEN WRITE (NDSE,902) IDTST, IDSTR @@ -2369,8 +2375,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) #endif ELSE - READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOP,IOSTAT=IERR) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOPO','',21) END IF ! #ifdef W3_T @@ -2408,10 +2415,12 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & #endif IF ( WRITE ) THEN OPEN (NDSOP,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_pnt.' & - //FILEXT(:I),form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + //FILEXT(:I),form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOPO','',20) #ifdef W3_ASCII OPEN (NDSOA,FILE=FNMPRE_LOCAL(:J)//TIMETAG//'.out_pnt.' & - //FILEXT(:I)//'.txt',form='FORMATTED', ERR=800,IOSTAT=IERR) + //FILEXT(:I)//'.txt',form='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOPO','',20) #endif END IF ! @@ -2430,8 +2439,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & IDSTR, VEROPT, NK, NTH, NOPTS #endif ELSE - READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOP,IOSTAT=IERR) & IDTST, VERTST, MK, MTH, NOPTS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOPO','',21) ! IF ( IDTST .NE. IDSTR ) THEN WRITE (NDSE,902) IDTST, IDSTR @@ -2465,8 +2475,9 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) #endif ELSE - READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOP,IOSTAT=IERR) & ((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOPO','',21) END IF ! #ifdef W3_T @@ -2487,7 +2498,16 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & WRITE (NDSOA,*) 'TIME:', TIME #endif ELSE - READ (NDSOP,END=803,ERR=802,IOSTAT=IERR) TIME + READ (NDSOP,IOSTAT=IERR) TIME + IF (IERR.LT.0) THEN + IOTST = -1 +#ifdef W3_T + WRITE (NDST,9011) +#endif + RETURN + ELSE IF (IERR.GT.0) THEN + CALL EXTIOF(NDSE,IERR,'W3IOPO','',21) + END IF END IF ! #ifdef W3_T @@ -2533,7 +2553,7 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) #endif ELSE - READ (NDSOP,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSOP,IOSTAT=IERR) & IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I), & #ifdef W3_FLX5 TAUAO(I), TAUDO(I), DAIRO(I), & @@ -2543,32 +2563,12 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & #endif ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I), & ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOPO','',21) END IF ! END DO IF (OFILES(2) .EQ. 1) CLOSE (NDSOP) ! - RETURN - ! - ! Escape locations read errors - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 20 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 21 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 22 ) - ! -803 CONTINUE - IOTST = -1 -#ifdef W3_T - WRITE (NDST,9011) -#endif RETURN ! ! Formats @@ -2587,9 +2587,6 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & ' ERROR IN SPECTRA, MK, MTH : ',2I8/ & ' ARRAY DIMENSIONS : ',2I8/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO : '/ & - ' ERROR IN OPENING FILE'/ & - ' IOSTAT =',I5/) 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO : '/ & ' PREMATURE END OF FILE'/) 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO : '/ & diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index b04e28534f..788ff438d1 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -48,6 +48,7 @@ MODULE W3IORSMD ! W3SETO, W3SETG, W3SETW, W3DIMW ! Subr. W3xDATMD Manage data structures. ! STRACE Subr. W3SERVMD Subroutine tracing. (!/S) + ! EXTIOF Subr. W3SERVMD Abort I/O file with exit code. ! EXTCDE Subr. W3SERVMD Abort program with exit code. ! MPI_STARTALL, MPI_WAITALL (!/MPI) ! Subr. MPI persistent communication routines @@ -151,6 +152,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) !/ 25-Sep-2020 : Extra fields for coupled restart ( version 7.10 ) !/ 22-Mar-2021 : Add new coupling fields in restart ( version 7.13 ) !/ 18-May-2021 : Read by default all extra restart ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -316,7 +318,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3ADATMD, ONLY: MPI_COMM_WCMP #endif !/ - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTCDE, EXTIOF USE CONSTANTS, only: LPDLIB, file_endian USE W3PARALL, ONLY: INIT_GET_ISEA, INIT_GET_JSEA_ISPROC USE W3GDATMD, ONLY: NK, NTH @@ -505,83 +507,101 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF IF ( WRITE ) THEN + IERR = 0 IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) & OPEN (NDSR,FILE=FNMPRE_LOCAL(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & - ACCESS='STREAM',ERR=800,IOSTAT=IERR) + ACCESS='STREAM',IOSTAT=IERR) ELSE OPEN (NDSR,FILE=FNMPRE_LOCAL(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & - ACCESS='STREAM',ERR=800,IOSTAT=IERR, & - STATUS='OLD',ACTION='READ') + ACCESS='STREAM',IOSTAT=IERR,STATUS='OLD',ACTION='READ') END IF ! - ! test info ---------------------------------------------------------- * - ! - IF ( WRITE ) THEN + ! In/Out file is successfully opened + IF (IERR .EQ. 0) THEN ! - IF ( IAPROC .EQ. NAPRST ) THEN - ! Because data has mixed data types we do not know how many - ! bytes remain to fill up to LRECL. --- - ! --- Make the entire record zero --- - WRITEBUFF(:) = 0. - WRITE (NDSR,POS=1) WRITEBUFF - ! --- Replace zeros with data --- - WRITE (NDSR,POS=1) IDSTR, VERINI, GNAME, TYPE, NSEA, & - NSPEC, FLOGRR - END IF - RSTYPE = 3 + ! test info ---------------------------------------------------------- * ! - ELSE - READ (NDSR,POS=1,ERR=802,IOSTAT=IERR) & - IDTST, VERTST, TNAME, TYPE, NSEAT, MSPEC, FLOGOA - ! - IF ( IDTST .NE. IDSTR ) THEN - IF ( IAPROC .EQ. NAPERR ) & - WRITE (NDSE,901) IDTST, IDSTR - CALL EXTCDE ( 10 ) - END IF - IF ( VERTST .NE. VERINI ) THEN - IF ( IAPROC .EQ. NAPERR ) & - WRITE (NDSE,902) VERTST, VERINI - CALL EXTCDE ( 11 ) - END IF - IF ( TNAME .NE. GNAME ) THEN - IF ( IAPROC .EQ. NAPERR ) & - WRITE (NDSE,903) TNAME, GNAME - END IF - IF (TYPE.NE.'FULL' .AND. TYPE.NE.'COLD' .AND. & - TYPE.NE.'WIND' .AND. TYPE.NE.'CALM' ) THEN - IF ( IAPROC .EQ. NAPERR ) & - WRITE (NDSE,904) TYPE - CALL EXTCDE ( 12 ) - END IF - IF (NSEAT.NE.NSEA .OR. NSPEC.NE.MSPEC) THEN - IF ( IAPROC .EQ. NAPERR ) & - WRITE (NDSE,905) MSPEC, NSEAT, NSPEC, NSEA - CALL EXTCDE ( 13 ) - END IF - IF (TYPE.EQ.'FULL') THEN - RSTYPE = 2 - ELSE IF (TYPE.EQ.'WIND') THEN - RSTYPE = 1 - ELSE IF (TYPE.EQ.'CALM') THEN - RSTYPE = 4 + IF ( WRITE ) THEN + ! + IF ( IAPROC .EQ. NAPRST ) THEN + ! Because data has mixed data types we do not know how many + ! bytes remain to fill up to LRECL. --- + ! --- Make the entire record zero --- + WRITEBUFF(:) = 0. + WRITE (NDSR,POS=1) WRITEBUFF + ! --- Replace zeros with data --- + WRITE (NDSR,POS=1) IDSTR, VERINI, GNAME, TYPE, NSEA, & + NSPEC, FLOGRR + END IF + RSTYPE = 3 + ! ELSE - RSTYPE = 0 - END IF + READ (NDSR,POS=1,IOSTAT=IERR) & + IDTST, VERTST, TNAME, TYPE, NSEAT, MSPEC, FLOGOA + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + ! + IF ( IDTST .NE. IDSTR ) THEN + IF ( IAPROC .EQ. NAPERR ) & + WRITE (NDSE,901) IDTST, IDSTR + CALL EXTCDE ( 10 ) + END IF + IF ( VERTST .NE. VERINI ) THEN + IF ( IAPROC .EQ. NAPERR ) & + WRITE (NDSE,902) VERTST, VERINI + CALL EXTCDE ( 11 ) + END IF + IF ( TNAME .NE. GNAME ) THEN + IF ( IAPROC .EQ. NAPERR ) & + WRITE (NDSE,903) TNAME, GNAME + END IF + IF (TYPE.NE.'FULL' .AND. TYPE.NE.'COLD' .AND. & + TYPE.NE.'WIND' .AND. TYPE.NE.'CALM' ) THEN + IF ( IAPROC .EQ. NAPERR ) & + WRITE (NDSE,904) TYPE + CALL EXTCDE ( 12 ) + END IF + IF (NSEAT.NE.NSEA .OR. NSPEC.NE.MSPEC) THEN + IF ( IAPROC .EQ. NAPERR ) & + WRITE (NDSE,905) MSPEC, NSEAT, NSPEC, NSEA + CALL EXTCDE ( 13 ) + END IF + IF (TYPE.EQ.'FULL') THEN + RSTYPE = 2 + ELSE IF (TYPE.EQ.'WIND') THEN + RSTYPE = 1 + ELSE IF (TYPE.EQ.'CALM') THEN + RSTYPE = 4 + ELSE + RSTYPE = 0 + END IF - IF (.NOT. WRITE .AND. OARST .AND. IAPROC .EQ. NAPROC) THEN - DO I=1, NOGRP - DO J=1, NGRPP - IF (FLOGRR(I,J) .AND. .NOT. FLOGOA(I,J)) THEN - WRITE(SCREEN,1000) I, J - ENDIF + IF (.NOT. WRITE .AND. OARST .AND. IAPROC .EQ. NAPROC) THEN + DO I=1, NOGRP + DO J=1, NGRPP + IF (FLOGRR(I,J) .AND. .NOT. FLOGOA(I,J)) THEN + WRITE(SCREEN,1000) I, J + ENDIF + ENDDO ENDDO - ENDDO - ENDIF + ENDIF + ! + END IF + ELSE +#ifdef W3_LN0 + TYPE = 'WIND' + RSTYPE = 1 +#endif +#ifdef W3_SEED + TYPE = 'CALM' + RSTYPE = 4 +#endif +#ifdef W3_LN1 + TYPE = 'CALM' + RSTYPE = 4 +#endif + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,990) TYPE, IERR ! - END IF - ! -100 CONTINUE + END IF ! In/Out file is successfully opened ! #ifdef W3_T WRITE (NDST,9002) IDSTR, VERINI, GNAME, TYPE, & @@ -599,7 +619,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITE (NDSR,POS=RPOS) TIME END IF ELSE - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) TTIME + READ (NDSR,POS=RPOS,IOSTAT=IERR) TTIME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) IF (TIME(1).NE.TTIME(1) .OR. TIME(2).NE.TTIME(2)) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,906) TTIME, TIME @@ -646,7 +667,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) RPOS = 1_8 + LRECL*(NREC-1_8) WRITEBUFF(:) = 0. WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO #else DO JSEA=1, NSEA @@ -655,7 +678,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) RPOS = 1_8 + LRECL*(NREC-1_8) WRITEBUFF(:) = 0. WRITEBUFF(1:NSPEC) = VA(1:NSPEC,JSEA) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO #endif ! @@ -716,8 +741,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) JSEA = JSEA - 2*((IB-1)/2)*RSBLKS WRITEBUFF(1:NSPEC) = VAAUX(1:NSPEC,JSEA,IP) END IF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & - WRITEBUFF + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO ! ELSE @@ -776,7 +802,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! Read NAPROC records into buffer VGBUFF. ------------- * IF ( IAPROC .EQ. NAPROC ) THEN RPOS = 1_8 + (2 + (JSEA - 1_8) * NAPROC) * LRECL - READ(NDSR, POS=RPOS,ERR=802,IOSTAT=IERR) VGBUFF(:) + READ(NDSR, POS=RPOS,IOSTAT=IERR) VGBUFF(:) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) ELSE VGBUFF(:) = 0. END IF @@ -794,8 +821,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR, POS=RPOS, ERR=802, IOSTAT=IERR) & + READ (NDSR, POS=RPOS,IOSTAT=IERR) & (VA(I,JSEA), I=1,NSPEC) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END IF ! DEALLOCATE( VGBUFF ) @@ -811,8 +839,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) CALL INIT_GET_ISEA(ISEA, JSEA) NREC = ISEA + 2 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (VA(I,JSEA),I=1,NSPEC) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) ENDDO #ifdef W3_MPI END IF @@ -854,24 +883,36 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! RPOS = 1_8 + LRECL*(NREC-1_8) WRITEBUFF(:) = 0. - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & TLEV, TICE, TRHO, TIC1, TIC5 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (ICE(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO #ifdef W3_WRST @@ -887,20 +928,28 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) DO IPART=1,NPRTY2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (WXN(IX,IYL),IYL=1+(IPART-1)*NSIZE, & MIN(NY,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO END DO DO IX=1, NX DO IPART=1,NPRTY2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (WYN(IX,IYL),IYL=1+(IPART-1)*NSIZE, & MIN(NY,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO END DO #endif @@ -910,45 +959,64 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) DO IPART=1,NPRTX2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & - WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (MAPTMP(IY,IXL),IXL=1+(IPART-1)*NSIZE, & MIN(NX,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO END DO DEALLOCATE ( MAPTMP ) DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) WRITEBUFF - WRITE (NDSR,POS=RPOS,ERR=803,IOSTAT=IERR) & + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) WRITEBUFF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) & (FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) END DO IF (OARST) THEN #ifdef W3_MPI @@ -956,67 +1024,89 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #endif ! IF ( FLOGRR(1,2) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) CX(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) CY(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) CX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) CY(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) ENDIF IF ( FLOGRR(1,12) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) ICEF(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) ICEF(1:NSEA) IF ( FLOGRR(2,1) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) HS(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) HS(1:NSEA) IF ( FLOGRR(2,2) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) WLM(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) WLM(1:NSEA) IF ( FLOGRR(2,4) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) T0M1(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) T0M1(1:NSEA) IF ( FLOGRR(2,5) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) T01(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) T01(1:NSEA) IF ( FLOGRR(2,6) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) FP0(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) FP0(1:NSEA) IF ( FLOGRR(2,7) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) THM(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) THM(1:NSEA) IF ( FLOGRR(2,19) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) WNMEAN(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) WNMEAN(1:NSEA) IF ( FLOGRR(5,2) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) CHARN(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) CHARN(1:NSEA) IF ( FLOGRR(5,5) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUWIX(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUWIY(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) TAUWIX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) TAUWIY(1:NSEA) ENDIF IF ( FLOGRR(5,11) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) TWS(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) TWS(1:NSEA) IF ( FLOGRR(6,2) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOX(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOY(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) TAUOX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) TAUOY(1:NSEA) ENDIF IF ( FLOGRR(6,3) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) BHD(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) BHD(1:NSEA) IF ( FLOGRR(6,4) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) PHIOC(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) PHIOC(1:NSEA) IF ( FLOGRR(6,5) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) TUSX(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) TUSY(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) TUSX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) TUSY(1:NSEA) ENDIF IF ( FLOGRR(6,6) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) USSX(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) USSY(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) USSX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) USSY(1:NSEA) ENDIF IF ( FLOGRR(6,10) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUICE(1:NSEA,1) - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUICE(1:NSEA,2) + WRITE(NDSR,IOSTAT=IERR) TAUICE(1:NSEA,1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) TAUICE(1:NSEA,2) ENDIF IF ( FLOGRR(6,13) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOCX(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOCY(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) TAUOCX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) TAUOCY(1:NSEA) ENDIF IF ( FLOGRR(7,2) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) UBA(1:NSEA) - WRITE(NDSR,ERR=803,IOSTAT=IERR) UBD(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) UBA(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) UBD(1:NSEA) ENDIF IF ( FLOGRR(7,4) ) & - WRITE(NDSR,ERR=803,IOSTAT=IERR) PHIBBL(1:NSEA) + WRITE(NDSR,IOSTAT=IERR) PHIBBL(1:NSEA) IF ( FLOGRR(7,5) ) THEN - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUBBL(1:NSEA,1) - WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUBBL(1:NSEA,2) + WRITE(NDSR,IOSTAT=IERR) TAUBBL(1:NSEA,1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + WRITE(NDSR,IOSTAT=IERR) TAUBBL(1:NSEA,2) ENDIF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) ! #ifdef W3_MPI CALL W3SETA ( IGRD, NDSE, NDST ) @@ -1036,39 +1126,44 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ELSE IF (TYPE.EQ.'FULL') THEN RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & TLEV, TICE, TRHO, TIC1, TIC5 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (WLV(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (ICE(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO #ifdef W3_WRST DO IX=1, NX DO IPART=1,NPRTY2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (WXNwrst(IX,IYL),IYL=1+(IPART-1)*NSIZE, & MIN(NY,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO END DO DO IX=1, NX DO IPART=1,NPRTY2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (WYNwrst(IX,IYL),IYL=1+(IPART-1)*NSIZE, & MIN(NY,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO END DO #endif @@ -1077,9 +1172,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) DO IPART=1,NPRTX2 NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (MAPTMP(IY,IXL),IXL=1+(IPART-1)*NSIZE, & MIN(NX,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO END DO MAPSTA = MOD(MAPTMP+2,8) - 2 @@ -1099,98 +1195,115 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (UST(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (USTDIR(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (ASF(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO DO IPART=1,NPART NREC = NREC + 1 RPOS = 1_8 + LRECL*(NREC-1_8) - READ (NDSR,POS=RPOS,ERR=802,IOSTAT=IERR) & + READ (NDSR,POS=RPOS,IOSTAT=IERR) & (FPIS(ISEA),ISEA=1+(IPART-1)*NSIZE, & MIN(NSEA,IPART*NSIZE)) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) END DO IF (OARST) THEN IF ( FLOGOA(1,2) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) CX(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) CY(1:NSEA) + READ (NDSR,IOSTAT=IERR) CX(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) CY(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) ENDIF IF ( FLOGOA(1,12) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) ICEF(1:NSEA) + READ (NDSR,IOSTAT=IERR) ICEF(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) ENDIF IF ( FLOGOA(2,1) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) HS(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(2,2) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) WLM(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(2,4) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) T0M1(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(2,5) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) T01(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(2,6) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) FP0(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(2,7) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THM(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(2,19) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) WNMEAN(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(5,2) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) CHARN(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(5,5) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1200,15 +1313,18 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(5,11) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) TWS(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(6,2) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1218,22 +1334,26 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(6,3) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) BHD(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(6,4) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) PHIOC(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(6,5) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1243,8 +1363,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(6,6) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1254,8 +1376,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(6,10) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1265,8 +1389,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(6,13) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1276,8 +1402,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(7,2) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1287,15 +1415,18 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDDO ENDIF IF ( FLOGOA(7,4) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) PHIBBL(I) = TMP(J) ENDDO ENDIF IF ( FLOGOA(7,5) ) THEN - READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) - READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + READ (NDSR,IOSTAT=IERR) TMP(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + READ (NDSR,IOSTAT=IERR) TMP2(1:NSEA) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN @@ -1381,37 +1512,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! RETURN ! - ! Escape locations read errors : - ! -800 CONTINUE -#ifdef W3_LN0 - TYPE = 'WIND' - RSTYPE = 1 -#endif -#ifdef W3_SEED - TYPE = 'CALM' - RSTYPE = 4 -#endif -#ifdef W3_LN1 - TYPE = 'CALM' - RSTYPE = 4 -#endif - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,990) TYPE, IERR - GOTO 100 - ! -801 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,991) - CALL EXTCDE ( 30 ) - ! -802 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,992) IERR - CALL EXTCDE ( 31 ) - ! -803 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,993) IERR, RPOS - CALL EXTCDE ( 31 ) - ! - ! ! Formats ! 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS :'/ & @@ -1438,14 +1538,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ' NO READABLE RESTART FILE, ', & 'INITIALIZE WITH ''',A,''' INSTEAD'/ & ' IOSTAT =',I5/) -991 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/ & - ' PREMATURE END OF FILE'/) -992 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/ & - ' ERROR IN READING FROM FILE'/ & - ' IOSTAT =',I5/) -993 FORMAT (/' *** WAVEWATCH III ERROR IN W3IORS : '/ & - ' ERROR IN WRITING TO FILE'/ & - ' IOSTAT =',I5,', POS =',I11 /) 1000 FORMAT (/' *** WAVEWATCH III WARNING IN W3IORS : '/ & ' REQUESTED EXTRA RESTART GROUP',I2,' FIELD',I2, / & ' IS NOT PRESENT IN THE RESTART FILE.'/ & diff --git a/model/src/w3iosfmd.F90 b/model/src/w3iosfmd.F90 index fa8d93cd15..05339fe0fc 100644 --- a/model/src/w3iosfmd.F90 +++ b/model/src/w3iosfmd.F90 @@ -38,6 +38,7 @@ MODULE W3IOSFMD !/ INIT_GET_JSEA_ISPROC ( version 6.04 ) !/ 25-Jul-2018 : Changed DIMXP size for partitioning ( version 6.05 ) !/ methods 4 and 5. (C Bunney, UKMO) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -72,7 +73,7 @@ MODULE W3IOSFMD ! ---------------------------------------------------------------- ! W3PART Subr. W3PARTMD Spectral partition for single spectrum. ! STRACE Sur. W3SERVMD Subroutine tracing. - ! EXTCDE Subr. Id. Program abort. + ! EXTOPN Subr. W3SERVMD Abort if error when opening file. ! MPI_SEND, MPI_RECV ! MPI send and recieve routines ! ---------------------------------------------------------------- @@ -399,7 +400,7 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) ! Name Type Module Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. - ! EXTCDE Subr. Id. Program abort. + ! EXTOPN Subr. Id. Abort if error when opening file. ! MPI_SEND, MPI_RECV ! MPI send and recieve routines ! ---------------------------------------------------------------- @@ -427,7 +428,7 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) !/ ------------------------------------------------------------------- / !/ USE CONSTANTS - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTOPN #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -517,11 +518,12 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) ! IF ( FLFORM ) THEN OPEN (NDSPT,FILE=FNMPRE(:J)//'partition.'//FILEXT(:I), & - ERR=800,IOSTAT=IERR) + IOSTAT=IERR) ELSE OPEN (NDSPT,FILE=FNMPRE(:J)//'partition.'//FILEXT(:I), & - form='UNFORMATTED',convert=file_endian,ERR=800,IOSTAT=IERR) + form='UNFORMATTED',convert=file_endian,IOSTAT=IERR) END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3IOSF','',1) ! REWIND (NDSPT) ! @@ -722,12 +724,6 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) ! RETURN ! - ! Escape locations read errors --------------------------------------- * - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1 ) - ! ! Formats ! 910 FORMAT (A,1X,A) @@ -739,10 +735,6 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) 1X,I2,F7.1,F5.1,f6.1,F5.2,F6.1) 942 FORMAT (I3,3F8.2,2F9.2,F7.2) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOSF : '/ & - ' ERROR IN OPENING FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST W3IOSF : IPASS =',I4,', FLFROM = ',L1, & ', NDSPT =',I3,', IMOD =',I3,','/ & diff --git a/model/src/w3iotrmd.F90 b/model/src/w3iotrmd.F90 index 63b46ac04f..f62bf065e3 100644 --- a/model/src/w3iotrmd.F90 +++ b/model/src/w3iotrmd.F90 @@ -130,6 +130,7 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) !/ 26-Dec-2012 : Initialize ASPTRK. ( version 4.11 ) !/ 12-Dec-2014 : Modify instanciation of NRQTR ( version 5.04 ) !/ 08-Jun-2018 : use W3PARALL/INIT_GET_JSEA_ISPROC ( version 6.04 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -369,19 +370,64 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) 'FORMATTED' #endif OPEN (NDSTI,FILE=FNMPRE(:J)//'track_i.'//FILEXT(:I), & - STATUS='OLD',ERR=800,FORM='FORMATTED',IOSTAT=IERR) - READ (NDSTI,'(A)',ERR=801,END=802,IOSTAT=IERR) IDTST + STATUS='OLD',FORM='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF + READ (NDSTI,'(A)',IOSTAT=IERR) IDTST + IF (IERR.NE.0) THEN + IF (IERR.GT.0 .AND. IAPROC .EQ. NAPERR ) & + WRITE (NDSE,1001) FILEXT(:I), IERR + IF (IERR.LT.0 .AND. IAPROC .EQ. NAPERR ) & + WRITE (NDSE,1002) FILEXT(:I) + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF ELSE #ifdef W3_T WRITE (NDST,9011) FNMPRE(:J)//'track_i.'//FILEXT(:I), & 'UNFORMATTED' #endif OPEN (NDSTI,FILE=FNMPRE(:J)//'track_i.'//FILEXT(:I), & - STATUS='OLD',ERR=800,form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) - READ (NDSTI,ERR=801,END=802,IOSTAT=IERR) IDTST + STATUS='OLD',form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF + READ (NDSTI,IOSTAT=IERR) IDTST + IF (IERR.NE.0) THEN + IF (IERR.GT.0 .AND. IAPROC .EQ. NAPERR ) & + WRITE (NDSE,1001) FILEXT(:I), IERR + IF (IERR.LT.0 .AND. IAPROC .EQ. NAPERR ) & + WRITE (NDSE,1002) FILEXT(:I) + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF END IF ! - IF ( IDTST .NE. IDSTRI ) GOTO 803 + IF ( IDTST .NE. IDSTRI ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) FILEXT(:I), IDSTRI, IDTST + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF ! ! 1.b Open output file ! @@ -391,12 +437,36 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) 'UNFORMATTED' #endif OPEN (NDSTO,FILE=FNMPRE(:J)//'track_o.'//FILEXT(:I), & - form='UNFORMATTED', convert=file_endian,ERR=810,IOSTAT=IERR) - WRITE (NDSTO,ERR=811,IOSTAT=IERR) IDSTRO, FLAGLL, NK, & + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF + WRITE (NDSTO,IOSTAT=IERR) IDSTRO, FLAGLL, NK, & NTH, XFR - WRITE (NDSTO,ERR=811,IOSTAT=IERR) 0.5*PI-TH(1), -DTH, & + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF + WRITE (NDSTO,IOSTAT=IERR) 0.5*PI-TH(1), -DTH, & (SIG(IK)*TPIINV,IK=1,NK), & (DSIP(IK)*TPIINV,IK=1,NK) + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF END IF ! ! 1.c Initialize maps @@ -451,171 +521,178 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #ifdef W3_T WRITE (NDST,9034) #endif - GOTO 399 - END IF - ! + ELSE + ! #ifdef W3_T1 - WRITE (NDST,9030) + WRITE (NDST,9030) #endif - ! - DO ! - IF ( FORMI ) THEN - READ (NDSTI,'(A)',ERR=801,END=390,IOSTAT=IERR) LINE - LIST(:)='' - CALL STRSPLIT(LINE,LIST) - READ(LIST(1),'(I8)') TTIME(1) - READ(LIST(2),'(I6)') TTIME(2) - READ(LIST(3),*) XT - READ(LIST(4),*) YT - IF(SIZE(LIST).GE.5) TRCKT=LIST(5) - ELSE - READ (NDSTI, ERR=801,END=390,IOSTAT=IERR) TTIME, XT, YT, TRCKT - END IF + DO + ! + IF ( FORMI ) THEN + READ (NDSTI,'(A)', IOSTAT=IERR) LINE + ELSE + READ (NDSTI, IOSTAT=IERR) TTIME, XT, YT, TRCKT + END IF + ! Check if file has been properly read + IF (IERR .LT. 0) THEN + ! End of input file #ifdef W3_T - NREAD = NREAD + 1 + WRITE (NDST,9033) +#endif + STOP = .TRUE. + EXIT + ELSE IF (IERR .GT. 0) THEN + ! Error reading file + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) #endif - ! - ! 3.b Point before time interval - ! - IF ( DSEC21(TIMEB,TTIME) .LT. 0. ) THEN + RETURN + END IF + ! + IF ( FORMI ) THEN + LIST(:)='' + CALL STRSPLIT(LINE,LIST) + READ(LIST(1),'(I8)') TTIME(1) + READ(LIST(2),'(I6)') TTIME(2) + READ(LIST(3),*) XT + READ(LIST(4),*) YT + IF(SIZE(LIST).GE.5) TRCKT=LIST(5) + END IF +#ifdef W3_T + NREAD = NREAD + 1 +#endif + ! + ! 3.b Point before time interval + ! + IF ( DSEC21(TIMEB,TTIME) .LT. 0. ) THEN #ifdef W3_T1 - WRITE (NDST,9031) TTIME,FACTOR*XT,FACTOR*YT,'TOO EARLY' + WRITE (NDST,9031) TTIME,FACTOR*XT,FACTOR*YT,'TOO EARLY' #endif - CYCLE - END IF - ! - ! 3.c Point after time interval - ! - IF ( DSEC21(TIMEE,TTIME) .GT. 0. ) THEN - BACKSPACE (NDSTI) + CYCLE + END IF + ! + ! 3.c Point after time interval + ! + IF ( DSEC21(TIMEE,TTIME) .GT. 0. ) THEN + BACKSPACE (NDSTI) #ifdef W3_T - NREAD = NREAD - 1 + NREAD = NREAD - 1 #endif #ifdef W3_T1 - WRITE (NDST,9031) TTIME,FACTOR*XT,FACTOR*YT,'TOO LATE' + WRITE (NDST,9031) TTIME,FACTOR*XT,FACTOR*YT,'TOO LATE' #endif - GOTO 399 - END IF - ! - ! 3.d Check time in interval - ! - FLAG1 = DSEC21(TTIME,TIMEE) .GT. RTCHCK*DTOUT - FLAG2 = DSEC21(TIMEB,TTIME) .GT. RTCHCK*DTOUT - ! - ! 3.e Check point coordinates - ! + EXIT + END IF + ! + ! 3.d Check time in interval + ! + FLAG1 = DSEC21(TTIME,TIMEE) .GT. RTCHCK*DTOUT + FLAG2 = DSEC21(TIMEB,TTIME) .GT. RTCHCK*DTOUT + ! + ! 3.e Check point coordinates + ! - ! 3.e.1 Initial identification of computational grid points to include. - ! - ! Find cell that encloses target point (note that the returned - ! cell corner indices are adjusted for global wrapping and the - ! coordinates are adjusted to avoid branch cut crossings) - INGRID = W3GFCL( GSU, XT, YT, IXX, IYY, XX, YY ) - IF ( .NOT. INGRID ) THEN + ! 3.e.1 Initial identification of computational grid points to include. + ! + ! Find cell that encloses target point (note that the returned + ! cell corner indices are adjusted for global wrapping and the + ! coordinates are adjusted to avoid branch cut crossings) + INGRID = W3GFCL( GSU, XT, YT, IXX, IYY, XX, YY ) + IF ( .NOT. INGRID ) THEN #ifdef W3_T1 - WRITE (NDST,9031) TTIME, FACTOR*XT, FACTOR*YT, & - 'OUT OF GRID' + WRITE (NDST,9031) TTIME, FACTOR*XT, FACTOR*YT, & + 'OUT OF GRID' #endif - CYCLE - END IF - ! - ! Change cell-corners from counter-clockwise to column-major order - IX = IXX(4); IY = IYY(4); - IXX(4) = IXX(3); IYY(4) = IYY(3); - IXX(3) = IX; IYY(3) = IY; - ! - ! 3.e.2 Optimize: omit points that are not strictly required. - ! See "Remarks" - - IF(CMPRTRCK)THEN ! perform track compression - - ! Project onto I-axis - RD = DPDX(IYY(1),IXX(1))*(XT-XX(1)) & - + DPDY(IYY(1),IXX(1))*(YT-YY(1)) - ! - ! Collapse to left or right if within tolerance - IF ( RD .LT. RDCHCK ) THEN - IXX(2) = IXX(1) - IXX(4) = IXX(3) - ELSE IF ( RD .GT. 1.-RDCHCK ) THEN - IXX(1) = IXX(2) - IXX(3) = IXX(4) + CYCLE END IF ! - ! Project onto J-axis - RD = DQDX(IYY(1),IXX(1))*(XT-XX(1)) & - + DQDY(IYY(1),IXX(1))*(YT-YY(1)) + ! Change cell-corners from counter-clockwise to column-major order + IX = IXX(4); IY = IYY(4); + IXX(4) = IXX(3); IYY(4) = IYY(3); + IXX(3) = IX; IYY(3) = IY; ! - ! Collapse to top or bottom if within tolerance - IF ( RD .LT. RDCHCK ) THEN - IYY(3) = IYY(1) - IYY(4) = IYY(2) - ELSE IF ( RD .GT. 1.-RDCHCK ) THEN - IYY(1) = IYY(3) - IYY(2) = IYY(4) - END IF + ! 3.e.2 Optimize: omit points that are not strictly required. + ! See "Remarks" - END IF ! IF(CMPRTRCK)THEN - ! - ! 3.f Mark the four corner points - ! - DO J=1, 4 + IF(CMPRTRCK)THEN ! perform track compression + + ! Project onto I-axis + RD = DPDX(IYY(1),IXX(1))*(XT-XX(1)) & + + DPDY(IYY(1),IXX(1))*(YT-YY(1)) + ! + ! Collapse to left or right if within tolerance + IF ( RD .LT. RDCHCK ) THEN + IXX(2) = IXX(1) + IXX(4) = IXX(3) + ELSE IF ( RD .GT. 1.-RDCHCK ) THEN + IXX(1) = IXX(2) + IXX(3) = IXX(4) + END IF + ! + ! Project onto J-axis + RD = DQDX(IYY(1),IXX(1))*(XT-XX(1)) & + + DQDY(IYY(1),IXX(1))*(YT-YY(1)) + ! + ! Collapse to top or bottom if within tolerance + IF ( RD .LT. RDCHCK ) THEN + IYY(3) = IYY(1) + IYY(4) = IYY(2) + ELSE IF ( RD .GT. 1.-RDCHCK ) THEN + IYY(1) = IYY(3) + IYY(2) = IYY(4) + END IF + + END IF ! IF(CMPRTRCK)THEN ! - IX = IXX(J) - IY = IYY(J) - IF(GTYPE .EQ. UNGTYPE) THEN - X = XGRD(1,IX) - Y = YGRD(1,IX) - ENDIF - MASK1(IY,IX) = MASK1(IY,IX) .OR. FLAG1 - MASK2(IY,IX) = MASK2(IY,IX) .OR. FLAG2 - TRCKID(IY,IX) = TRCKT + ! 3.f Mark the four corner points ! + DO J=1, 4 + ! + IX = IXX(J) + IY = IYY(J) + IF(GTYPE .EQ. UNGTYPE) THEN + X = XGRD(1,IX) + Y = YGRD(1,IX) + ENDIF + MASK1(IY,IX) = MASK1(IY,IX) .OR. FLAG1 + MASK2(IY,IX) = MASK2(IY,IX) .OR. FLAG2 + TRCKID(IY,IX) = TRCKT + ! #ifdef W3_T1 - IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN - IF ( MAPST2(IY,IX) .EQ. 0 ) THEN - TSTLOC(4*J-3:4*J-1) = 'LND' - ELSE - TSTLOC(4*J-3:4*J-1) = 'XCL' - END IF - ELSE IF ( MAPSTA(IY,IX) .LT. 0 ) THEN - IF ( MAPST2(IY,IX) .EQ. 1 ) THEN - TSTLOC(4*J-3:4*J-1) = 'ICE' - ELSE IF ( MAPST2(IY,IX) .EQ. 2 ) THEN - TSTLOC(4*J-3:4*J-1) = 'DRY' - ELSE - TSTLOC(4*J-3:4*J-1) = 'DIS' + IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN + IF ( MAPST2(IY,IX) .EQ. 0 ) THEN + TSTLOC(4*J-3:4*J-1) = 'LND' + ELSE + TSTLOC(4*J-3:4*J-1) = 'XCL' + END IF + ELSE IF ( MAPSTA(IY,IX) .LT. 0 ) THEN + IF ( MAPST2(IY,IX) .EQ. 1 ) THEN + TSTLOC(4*J-3:4*J-1) = 'ICE' + ELSE IF ( MAPST2(IY,IX) .EQ. 2 ) THEN + TSTLOC(4*J-3:4*J-1) = 'DRY' + ELSE + TSTLOC(4*J-3:4*J-1) = 'DIS' + END IF + ELSE IF ( MAPSTA(IY,IX) .GT. 0 ) THEN + TSTLOC(4*J-3:4*J-1) = 'SEA' END IF - ELSE IF ( MAPSTA(IY,IX) .GT. 0 ) THEN - TSTLOC(4*J-3:4*J-1) = 'SEA' - END IF #endif + ! + END DO ! - END DO - ! #ifdef W3_T1 - WRITE (NDST,9031) TTIME, FACTOR*XT, FACTOR*YT, TSTLOC, & - IXX(1), IXX(2), IYY(1), IYY(3), FLAG1, FLAG2 + WRITE (NDST,9031) TTIME, FACTOR*XT, FACTOR*YT, TSTLOC, & + IXX(1), IXX(2), IYY(1), IYY(3), FLAG1, FLAG2 #endif - ! #ifdef W3_T - NTRACK = NTRACK + 1 + NTRACK = NTRACK + 1 #endif - ! - END DO - ! - ! 3.g End of input file escape location - ! -390 CONTINUE -#ifdef W3_T - WRITE (NDST,9033) -#endif - STOP = .TRUE. - ! - ! 3.h Read end escape location - ! -399 CONTINUE + ! + END DO + END IF ! ! 3.h Mask test output ! @@ -765,17 +842,41 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) ! ! 4.e Sea point, write general data + spectrum ! - WRITE (NDSTO,ERR=811,IOSTAT=IERR) & + WRITE (NDSTO,IOSTAT=IERR) & TIME, X, Y, TSTSTR, TRCKID(IY,IX) - WRITE (NDSTO,ERR=811,IOSTAT=IERR) & + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF + WRITE (NDSTO,IOSTAT=IERR) & DW(ISEA), CX(ISEA), CY(ISEA), WX, WY, & UST(ISEA), AS(ISEA), SPEC + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF ! ! 4.f Non-sea point, write ! ELSE - WRITE (NDSTO,ERR=811,IOSTAT=IERR) & + WRITE (NDSTO,IOSTAT=IERR) & TIME, X, Y, TSTSTR, TRCKID(IY,IX) + IF (IERR.NE.0) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR + ATOLAST(:,3) = TIME +#ifdef W3_T + WRITE (NDST,9080) +#endif + RETURN + END IF ! ! ..... Sea and non-sea points processed ! @@ -804,43 +905,6 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #ifdef W3_T WRITE (NDST,9090) NTRACK, NREAD, NSPECO, NLOCO #endif - ! - GOTO 888 - ! - ! Error Escape Locations - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) FILEXT(:I), IERR - GOTO 880 - ! -801 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) FILEXT(:I), IERR - GOTO 880 - ! -802 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) FILEXT(:I) - GOTO 880 - ! -803 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) FILEXT(:I), IDSTRI, IDTST - GOTO 880 - ! -810 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) FILEXT(:I), IERR - GOTO 880 - ! -811 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1011) FILEXT(:I), IERR - ! - ! Disabeling output - ! -880 CONTINUE - ATOLAST(:,3) = TIME -#ifdef W3_T - WRITE (NDST,9080) -#endif - ! -888 CONTINUE ! RETURN ! diff --git a/model/src/w3meminfo.F90 b/model/src/w3meminfo.F90 index f23308e6a8..936ef09f38 100644 --- a/model/src/w3meminfo.F90 +++ b/model/src/w3meminfo.F90 @@ -11,6 +11,7 @@ module MallocInfo_m !/ +-----------------------------------+ !/ !/ 01-June-2018 : Origination. ( version 6.04 ) + !/ 04-July-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : Init pdlib part ! 2. Method : @@ -349,12 +350,13 @@ function getVmSize() result(vmsize) exit end if end do -88 close(unit=1000) - if (vmsize == 0) goto 99 - return + close(unit=1000) + if (vmsize == 0) then + print *, 'ERROR: procfs not mounted or not compatible' + vmsize = -1 + end if ! -99 print *, 'ERROR: procfs not mounted or not compatible' - vmsize = -1 + return end function getVmSize function getVmRSS() result(vmRSS) @@ -434,12 +436,13 @@ function getVmRSS() result(vmRSS) exit end if end do -88 close(unit=1000) - if (vmRSS == 0) goto 99 - return + close(unit=1000) + if (vmRSS == 0) then + print *, 'ERROR: procfs not mounted or not compatible' + vmRSS = -1 + end if ! -99 print *, 'ERROR: procfs not mounted or not compatible' - vmRSS = -1 + return end function getVmRSS end module MallocInfo_m diff --git a/model/src/w3ounfmetamd.F90 b/model/src/w3ounfmetamd.F90 index 0d1312aa0e..bca8137198 100644 --- a/model/src/w3ounfmetamd.F90 +++ b/model/src/w3ounfmetamd.F90 @@ -482,6 +482,7 @@ SUBROUTINE NEXT_LINE(NDMI, BUF, ILINE, EOF, NEW_SECTION) !/ +-----------------------------------+ !/ !/ 09-Nov-2020 : Creation ( version 7.12 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! ! 1. Purpose : @@ -532,7 +533,15 @@ SUBROUTINE NEXT_LINE(NDMI, BUF, ILINE, EOF, NEW_SECTION) ! - a comment line (starting with $) ! - the end of the file DO - READ(NDMI, '(A)', iostat=IERR, err=101, end=100) BUF + READ(NDMI, '(A)', iostat=IERR) BUF + IF (IERR.LT.0) THEN + BUF = '' + EOF = .TRUE. + RETURN + ELSE IF (IERR.GT.0) THEN + WRITE(NDSE, 1000) FN_META, ILINE, IERR + CALL EXTCDE(10) + END IF ILINE = ILINE + 1 @@ -581,18 +590,6 @@ SUBROUTINE NEXT_LINE(NDMI, BUF, ILINE, EOF, NEW_SECTION) RETURN ENDDO - !/ Escape locations - ! - ! End of file -100 CONTINUE - BUF = '' - EOF = .TRUE. - RETURN - ! - ! I/O Error -101 CONTINUE - WRITE(NDSE, 1000) FN_META, ILINE, IERR - CALL EXTCDE(10) ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNFMETA : '/ & ' ERROR READING METADATA FILE'/ & diff --git a/model/src/w3partmd.F90 b/model/src/w3partmd.F90 index 49a52f6805..64e032c52e 100644 --- a/model/src/w3partmd.F90 +++ b/model/src/w3partmd.F90 @@ -1190,6 +1190,7 @@ SUBROUTINE PTMEAN ( NPI, IMO, ZP, DEPTH, UABS, UDIR, WN, & !/ 02-Dec-2010 : Adding a mapping PMAP between ( version 3.14 ) !/ original and combined partitions !/ ( M. Szyszka ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -1412,7 +1413,10 @@ SUBROUTINE PTMEAN ( NPI, IMO, ZP, DEPTH, UABS, UDIR, WN, & CYCLE ENDIF ! - IF ( NPO .GE. DIMXP ) GOTO 2000 + IF ( NPO .GE. DIMXP ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) NPO+1 + RETURN + END IF NPO = NPO + 1 IF (IP.GT.0)THEN IF(NPO.LT.1)CYCLE @@ -1525,12 +1529,6 @@ SUBROUTINE PTMEAN ( NPI, IMO, ZP, DEPTH, UABS, UDIR, WN, & ! RETURN ! - ! Escape locations read errors --------------------------------------- * - ! -2000 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) NPO+1 - RETURN - ! ! Formats ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN PTMEAN :'/ & diff --git a/model/src/w3pro1md.F90 b/model/src/w3pro1md.F90 index f8b498833c..35e7b0e247 100644 --- a/model/src/w3pro1md.F90 +++ b/model/src/w3pro1md.F90 @@ -170,7 +170,6 @@ SUBROUTINE W3MAP1 ( MAPSTA ) ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL USE W3ADATMD, ONLY: IS0, IS2, FACVX, FACVY USE W3ODATMD, ONLY: NDSE, IAPROC, NAPERR - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -437,7 +436,6 @@ SUBROUTINE W3XYP1 ( ISP, DTG, MAPSTA, FIELD, VGX, VGY ) USE W3IDATMD, ONLY: FLCUR USE W3ODATMD, ONLY: NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, & BBPI0, BBPIN, NDSE, IAPROC, NAPERR - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 5fff60867f..17350959ab 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -18,6 +18,7 @@ MODULE W3PROFSMD !/ 15-Dec-2013 : Bug fix for implicit scheme ( version 4.16 ) !/ 18-Aug-2016 : Corrected boundary treatment ( version 4.16 ) !/ 15-Apr-2020 : Adds optional opt-out for CFL on BC ( version 7.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) ! ! 1. Purpose : ! @@ -2003,33 +2004,30 @@ END MODULE W3PROFSMD ! solver, say BCG. Here is a piece of pseudo-code showing how it can ! be done, ! -! 10 call bcg(n,rhs,sol,ipar,fpar,w) +! do +! call bcg(n,rhs,sol,ipar,fpar,w) ! if (ipar(1).eq.1) then ! call amux(n,w(ipar(8)),w(ipar(9)),a,ja,ia) -! goto 10 ! else if (ipar(1).eq.2) then ! call atmux(n,w(ipar(8)),w(ipar(9)),a,ja,ia) -! goto 10 ! else if (ipar(1).eq.3) then ! left preconditioner solver -! goto 10 ! else if (ipar(1).eq.4) then ! left preconditioner transposed solve -! goto 10 ! else if (ipar(1).eq.5) then ! right preconditioner solve -! goto 10 ! else if (ipar(1).eq.6) then ! right preconditioner transposed solve -! goto 10 ! else if (ipar(1).eq.10) then ! call my own stopping test routine -! goto 10 ! else if (ipar(1).gt.0) then ! ipar(1) is an unspecified code +! exit ! else ! the iterative solver terminated with code = ipar(1) +! exit ! endif +! end do ! ! This segment of pseudo-code assumes the matrix is in CSR format, ! AMUX and ATMUX are two routines from the SPARSKIT MATVEC module. @@ -2098,240 +2096,271 @@ subroutine bcgstab(n, rhs, sol, ipar, fpar, w) ! integer i real*8 alpha,beta,rho,omega - logical lp, rp + logical lp, rp, matvec, iterated save lp, rp ! ! where to go ! + matvec = .true. if (ipar(1).gt.0) then - !!goto (10, 20, 40, 50, 60, 70, 80, 90, 100, 110) ipar(10) - SELECT CASE (ipar(10)) - CASE (1) - GOTO 10 - CASE (2) - GOTO 20 - CASE (3) - GOTO 40 - CASE (4) - GOTO 50 - CASE (5) - GOTO 60 - CASE (6) - GOTO 70 - CASE (7) - GOTO 80 - CASE (8) - GOTO 90 - CASE (9) - GOTO 100 - CASE (10) - GOTO 110 - END SELECT + if(ipar(10) .eq. 1) then + ipar(7) = ipar(7) + 1 + ipar(13) = ipar(13) + 1 + do i = 1, n + w(i,1) = rhs(i) - w(i,2) + enddo + fpar(11) = fpar(11) + n + if (lp) then + ipar(1) = 3 + ipar(10) = 2 + return + endif + endif + ! + if(ipar(10) .le. 2) then + if (lp) then + do i = 1, n + w(i,1) = w(i,2) + w(i,6) = w(i,2) + enddo + else + do i = 1, n + w(i,2) = w(i,1) + w(i,6) = w(i,1) + enddo + endif + ! + fpar(7) = ddot(n,w,w) + fpar(11) = fpar(11) + 2 * n + fpar(5) = sqrt(fpar(7)) + fpar(3) = fpar(5) + if (abs(ipar(3)).eq.2) then + fpar(4) = fpar(1) * sqrt(ddot(n,rhs,rhs)) + fpar(2) + fpar(11) = fpar(11) + 2 * n + else if (ipar(3).ne.999) then + fpar(4) = fpar(1) * fpar(3) + fpar(2) + endif + if (ipar(3).ge.0) fpar(6) = fpar(5) + if (ipar(3).ge.0 .and. fpar(5).le.fpar(4) .and. ipar(3).ne.999) then + matvec = .false. + endif + endif + ! + ! beginning of the iterations + ! + if (matvec) then + iterated = .false. + do + ! Step (1), v = A p + if (ipar(10) .le. 2 .or. iterated) then + if (rp) then + ipar(1) = 5 + ipar(8) = 5*n+1 + if (lp) then + ipar(9) = 4*n + 1 + else + ipar(9) = 6*n + 1 + endif + ipar(10) = 3 + return + endif + endif + ! + if (ipar(10) .le. 3 .or. iterated) then + ipar(1) = 1 + if (rp) then + ipar(8) = ipar(9) + else + ipar(8) = 5*n+1 + endif + if (lp) then + ipar(9) = 6*n + 1 + else + ipar(9) = 4*n + 1 + endif + ipar(10) = 4 + return + endif + ! + if (ipar(10) .le. 4 .or. iterated) then + if (lp) then + ipar(1) = 3 + ipar(8) = ipar(9) + ipar(9) = 4*n + 1 + ipar(10) = 5 + return + endif + endif + ! + if (ipar(10) .le. 5 .or. iterated) then + ipar(7) = ipar(7) + 1 + ! + ! step (2) + alpha = ddot(n,w(1,1),w(1,5)) + fpar(11) = fpar(11) + 2 * n + if (brkdn(alpha, ipar)) then + matvec = .false. + exit + end if + alpha = fpar(7) / alpha + fpar(8) = alpha + ! + ! step (3) + do i = 1, n + w(i,3) = w(i,2) - alpha * w(i,5) + enddo + fpar(11) = fpar(11) + 2 * n + ! + ! Step (4): the second matvec -- t = A s + ! + if (rp) then + ipar(1) = 5 + ipar(8) = n+n+1 + if (lp) then + ipar(9) = ipar(8)+n + else + ipar(9) = 6*n + 1 + endif + ipar(10) = 6 + return + endif + endif + ! + if (ipar(10) .le. 6 .or. iterated) then + ipar(1) = 1 + if (rp) then + ipar(8) = ipar(9) + else + ipar(8) = n+n+1 + endif + if (lp) then + ipar(9) = 6*n + 1 + else + ipar(9) = 3*n + 1 + endif + ipar(10) = 7 + return + endif + ! + if (ipar(10) .le. 7 .or. iterated) then + if (lp) then + ipar(1) = 3 + ipar(8) = ipar(9) + ipar(9) = 3*n + 1 + ipar(10) = 8 + return + endif + endif + ! + if (ipar(10) .le. 8 .or. iterated) then + ipar(7) = ipar(7) + 1 + ! + ! step (5) + omega = ddot(n,w(1,4),w(1,4)) + fpar(11) = fpar(11) + n + n + if (brkdn(omega,ipar)) then + matvec = .false. + exit + endif + omega = ddot(n,w(1,4),w(1,3)) / omega + fpar(11) = fpar(11) + n + n + if (brkdn(omega,ipar)) then + matvec = .false. + exit + endif + fpar(9) = omega + alpha = fpar(8) + ! + ! step (6) and (7) + do i = 1, n + w(i,7) = alpha * w(i,6) + omega * w(i,3) + w(i,8) = w(i,8) + w(i,7) + w(i,2) = w(i,3) - omega * w(i,4) + enddo + fpar(11) = fpar(11) + 6 * n + 1 + ! + ! convergence test + if (ipar(3).eq.999) then + ipar(1) = 10 + ipar(8) = 7*n + 1 + ipar(9) = 6*n + 1 + ipar(10) = 9 + return + endif + if (stopbis(n,ipar,2,fpar,w(1,2),w(1,7),one)) then + matvec = .false. + exit + endif + endif + ! + if (ipar(10) .le. 9 .or. iterated) then + if (ipar(3).eq.999.and.ipar(11).eq.1) then + matvec = .false. + exit + end if + ! + ! step (8): computing new p and rho + ! + rho = fpar(7) + fpar(7) = ddot(n,w(1,2),w(1,1)) + omega = fpar(9) + beta = fpar(7) * fpar(8) / (fpar(9) * rho) + do i = 1, n + w(i,6) = w(i,2) + beta * (w(i,6) - omega * w(i,5)) + enddo + fpar(11) = fpar(11) + 6 * n + 3 + if (brkdn(fpar(7),ipar)) then + matvec = .false. + exit + end if + ! + ! end of an iteration + ! + end if + iterated = .true. + enddo + endif else if (ipar(1).lt.0) then - goto 900 - endif - ! - ! call the initialization routine - ! - call bisinit(ipar,fpar,8*n,1,lp,rp,w) - if (ipar(1).lt.0) return - ! - ! perform a matvec to compute the initial residual - ! - ipar(1) = 1 - ipar(8) = 1 - ipar(9) = 1 + n - do i = 1, n - w(i,1) = sol(i) - enddo - ipar(10) = 1 - return -10 ipar(7) = ipar(7) + 1 - ipar(13) = ipar(13) + 1 - do i = 1, n - w(i,1) = rhs(i) - w(i,2) - enddo - fpar(11) = fpar(11) + n - if (lp) then - ipar(1) = 3 - ipar(10) = 2 - return + matvec = .false. endif ! -20 if (lp) then - do i = 1, n - w(i,1) = w(i,2) - w(i,6) = w(i,2) - enddo - else + if (matvec) then + ! + ! call the initialization routine + ! + call bisinit(ipar,fpar,8*n,1,lp,rp,w) + if (ipar(1).lt.0) return + ! + ! perform a matvec to compute the initial residual + ! + ipar(1) = 1 + ipar(8) = 1 + ipar(9) = 1 + n do i = 1, n - w(i,2) = w(i,1) - w(i,6) = w(i,1) + w(i,1) = sol(i) enddo - endif - ! - fpar(7) = ddot(n,w,w) - fpar(11) = fpar(11) + 2 * n - fpar(5) = sqrt(fpar(7)) - fpar(3) = fpar(5) - if (abs(ipar(3)).eq.2) then - fpar(4) = fpar(1) * sqrt(ddot(n,rhs,rhs)) + fpar(2) - fpar(11) = fpar(11) + 2 * n - else if (ipar(3).ne.999) then - fpar(4) = fpar(1) * fpar(3) + fpar(2) - endif - if (ipar(3).ge.0) fpar(6) = fpar(5) - if (ipar(3).ge.0 .and. fpar(5).le.fpar(4) .and. ipar(3).ne.999) then - goto 900 - endif - ! - ! beginning of the iterations - ! - ! Step (1), v = A p -30 if (rp) then - ipar(1) = 5 - ipar(8) = 5*n+1 - if (lp) then - ipar(9) = 4*n + 1 - else - ipar(9) = 6*n + 1 - endif - ipar(10) = 3 + ipar(10) = 1 return - endif - ! -40 ipar(1) = 1 - if (rp) then - ipar(8) = ipar(9) else - ipar(8) = 5*n+1 - endif - if (lp) then - ipar(9) = 6*n + 1 - else - ipar(9) = 4*n + 1 - endif - ipar(10) = 4 - return -50 if (lp) then - ipar(1) = 3 - ipar(8) = ipar(9) - ipar(9) = 4*n + 1 - ipar(10) = 5 - return - endif - ! -60 ipar(7) = ipar(7) + 1 - ! - ! step (2) - alpha = ddot(n,w(1,1),w(1,5)) - fpar(11) = fpar(11) + 2 * n - if (brkdn(alpha, ipar)) goto 900 - alpha = fpar(7) / alpha - fpar(8) = alpha - ! - ! step (3) - do i = 1, n - w(i,3) = w(i,2) - alpha * w(i,5) - enddo - fpar(11) = fpar(11) + 2 * n - ! - ! Step (4): the second matvec -- t = A s - ! - if (rp) then - ipar(1) = 5 - ipar(8) = n+n+1 - if (lp) then - ipar(9) = ipar(8)+n - else - ipar(9) = 6*n + 1 + ! + ! some clean up job to do + ! + if (rp) then + if (ipar(1).lt.0) ipar(12) = ipar(1) + ipar(1) = 5 + ipar(8) = 7*n + 1 + ipar(9) = ipar(8) - n + ipar(10) = 10 + return endif - ipar(10) = 6 - return - endif - ! -70 ipar(1) = 1 - if (rp) then - ipar(8) = ipar(9) - else - ipar(8) = n+n+1 - endif - if (lp) then - ipar(9) = 6*n + 1 - else - ipar(9) = 3*n + 1 - endif - ipar(10) = 7 - return -80 if (lp) then - ipar(1) = 3 - ipar(8) = ipar(9) - ipar(9) = 3*n + 1 - ipar(10) = 8 - return - endif -90 ipar(7) = ipar(7) + 1 - ! - ! step (5) - omega = ddot(n,w(1,4),w(1,4)) - fpar(11) = fpar(11) + n + n - if (brkdn(omega,ipar)) goto 900 - omega = ddot(n,w(1,4),w(1,3)) / omega - fpar(11) = fpar(11) + n + n - if (brkdn(omega,ipar)) goto 900 - fpar(9) = omega - alpha = fpar(8) - ! - ! step (6) and (7) - do i = 1, n - w(i,7) = alpha * w(i,6) + omega * w(i,3) - w(i,8) = w(i,8) + w(i,7) - w(i,2) = w(i,3) - omega * w(i,4) - enddo - fpar(11) = fpar(11) + 6 * n + 1 - ! - ! convergence test - if (ipar(3).eq.999) then - ipar(1) = 10 - ipar(8) = 7*n + 1 - ipar(9) = 6*n + 1 - ipar(10) = 9 - return - endif - if (stopbis(n,ipar,2,fpar,w(1,2),w(1,7),one)) goto 900 -100 if (ipar(3).eq.999.and.ipar(11).eq.1) goto 900 - ! - ! step (8): computing new p and rho - ! - rho = fpar(7) - fpar(7) = ddot(n,w(1,2),w(1,1)) - omega = fpar(9) - beta = fpar(7) * fpar(8) / (fpar(9) * rho) - do i = 1, n - w(i,6) = w(i,2) + beta * (w(i,6) - omega * w(i,5)) - enddo - fpar(11) = fpar(11) + 6 * n + 3 - if (brkdn(fpar(7),ipar)) goto 900 - ! - ! end of an iteration - ! - goto 30 - ! - ! some clean up job to do - ! -900 if (rp) then - if (ipar(1).lt.0) ipar(12) = ipar(1) - ipar(1) = 5 - ipar(8) = 7*n + 1 - ipar(9) = ipar(8) - n - ipar(10) = 10 - return endif -110 if (rp) then - call tidycg(n,ipar,fpar,sol,w(1,7)) - else - call tidycg(n,ipar,fpar,sol,w(1,8)) + if (ipar(10) .eq. 10 .or. .not. matvec) then + if (rp) then + call tidycg(n,ipar,fpar,sol,w(1,7)) + else + call tidycg(n,ipar,fpar,sol,w(1,8)) + endif endif ! return @@ -2346,29 +2375,32 @@ subroutine implu(np,umm,beta,ypiv,u,permut,full) ! performs implicitly one step of the lu factorization of a ! banded hessenberg matrix. !----------------------------------------------------------------------- - if (np .le. 1) goto 12 - npm1 = np - 1 - ! - ! -- perform previous step of the factorization- - ! - do k=1,npm1 - if (.not. permut(k)) goto 5 - x=u(k) - u(k) = u(k+1) - u(k+1) = x -5 u(k+1) = u(k+1) - ypiv(k)*u(k) - end do + if (np .gt. 1) then + npm1 = np - 1 + ! + ! -- perform previous step of the factorization- + ! + do k=1,npm1 + if (permut(k)) then + x=u(k) + u(k) = u(k+1) + u(k+1) = x + end if + u(k+1) = u(k+1) - ypiv(k)*u(k) + end do + end if !----------------------------------------------------------------------- ! now determine pivotal information to be used in the next call !----------------------------------------------------------------------- -12 umm = u(np) + umm = u(np) perm = (beta .gt. abs(umm)) - if (.not. perm) goto 4 - xpiv = umm / beta - u(np) = beta - goto 8 -4 xpiv = beta/umm -8 permut(np) = perm + if (perm) then + xpiv = umm / beta + u(np) = beta + else + xpiv = beta/umm + end if + permut(np) = perm ypiv(np) = xpiv if (.not. full) return ! shift everything up if full... @@ -2395,20 +2427,24 @@ subroutine uppdir(n,p,np,lbp,indp,y,u,usav,flops) parameter(zero=0.0D0) ! npm1=np-1 - if (np .le. 1) goto 12 - j=indp - ju = npm1 -10 if (j .le. 0) j=lbp - x = u(ju) /usav(j) - if (x .eq. zero) goto 115 - do k=1,n - y(k) = y(k) - x*p(k,j) - end do - flops = flops + 2*n -115 j = j-1 - ju = ju -1 - if (ju .ge. 1) goto 10 -12 indp = indp + 1 + if (np .gt. 1) then + j=indp + ju = npm1 + do + if (j .le. 0) j=lbp + x = u(ju) /usav(j) + if (x .ne. zero) then + do k=1,n + y(k) = y(k) - x*p(k,j) + end do + flops = flops + 2*n + end if + j = j-1 + ju = ju -1 + if (ju .lt. 1) exit + end do + end if + indp = indp + 1 if (indp .gt. lbp) indp = 1 usav(indp) = u(np) do k=1,n @@ -3707,40 +3743,41 @@ subroutine qsplit(a,ind,n,ncut) ! ! outer loop -- while mid .ne. ncut do ! -1 mid = first - abskey = abs(a(mid)) - do j=first+1, last - if (abs(a(j)) .gt. abskey) then - mid = mid+1 - ! interchange - tmp = a(mid) - itmp = ind(mid) - a(mid) = a(j) - ind(mid) = ind(j) - a(j) = tmp - ind(j) = itmp + do + mid = first + abskey = abs(a(mid)) + do j=first+1, last + if (abs(a(j)) .gt. abskey) then + mid = mid+1 + ! interchange + tmp = a(mid) + itmp = ind(mid) + a(mid) = a(j) + ind(mid) = ind(j) + a(j) = tmp + ind(j) = itmp + endif + end do + ! + ! interchange + ! + tmp = a(mid) + a(mid) = a(first) + a(first) = tmp + ! + itmp = ind(mid) + ind(mid) = ind(first) + ind(first) = itmp + ! + ! test for while loop + ! + if (mid .eq. ncut) return + if (mid .gt. ncut) then + last = mid-1 + else + first = mid+1 endif end do - ! - ! interchange - ! - tmp = a(mid) - a(mid) = a(first) - a(first) = tmp - ! - itmp = ind(mid) - ind(mid) = ind(first) - ind(first) = itmp - ! - ! test for while loop - ! - if (mid .eq. ncut) return - if (mid .gt. ncut) then - last = mid-1 - else - first = mid+1 - endif - goto 1 !----------------end-of-qsplit------------------------------------------ !----------------------------------------------------------------------- end subroutine qsplit @@ -3780,38 +3817,41 @@ subroutine runrc(n,rhs,sol,ipar,fpar,wk,guess,a,ja,ia,au,jau,ju,solver) ipar(1) = 0 ! time = dtime(dt) -10 call solver(n,rhs,sol,ipar,fpar,wk) + do + call solver(n,rhs,sol,ipar,fpar,wk) - if (ipar(7).ne.its) then - its = ipar(7) - endif - if (ipar(1).eq.1) then - call amux(n, wk(ipar(8)), wk(ipar(9)), a, ja, ia) - goto 10 - else if (ipar(1).eq.2) then - call atmux(n, wk(ipar(8)), wk(ipar(9)), a, ja, ia) - goto 10 - else if (ipar(1).eq.3 .or. ipar(1).eq.5) then - call lusol(n,wk(ipar(8)),wk(ipar(9)),au,jau,ju) - goto 10 - else if (ipar(1).eq.4 .or. ipar(1).eq.6) then - call lutsol(n,wk(ipar(8)),wk(ipar(9)),au,jau,ju) - goto 10 - else if (ipar(1).le.0) then - if (ipar(1).eq.0) then - ! WRITE(*,*) 'Iterative sovler has satisfied convergence test.' - else if (ipar(1).eq.-1) then - WRITE(*,*) 'Iterative solver has iterated too many times.' - else if (ipar(1).eq.-2) then - WRITE(*,*) 'Iterative solver was not given enough work space.' - WRITE(*,*) 'The work space should at least have ', ipar(4), & - & ' elements.' - else if (ipar(1).eq.-3) then - WRITE(*,*) 'Iterative sovler is facing a break-down.' - else - WRITE(*,*) 'Iterative solver terminated. code =', ipar(1) + if (ipar(7).ne.its) then + its = ipar(7) endif - endif + if (ipar(1).eq.1) then + call amux(n, wk(ipar(8)), wk(ipar(9)), a, ja, ia) + cycle + else if (ipar(1).eq.2) then + call atmux(n, wk(ipar(8)), wk(ipar(9)), a, ja, ia) + cycle + else if (ipar(1).eq.3 .or. ipar(1).eq.5) then + call lusol(n,wk(ipar(8)),wk(ipar(9)),au,jau,ju) + cycle + else if (ipar(1).eq.4 .or. ipar(1).eq.6) then + call lutsol(n,wk(ipar(8)),wk(ipar(9)),au,jau,ju) + cycle + else if (ipar(1).le.0) then + if (ipar(1).eq.0) then + ! WRITE(*,*) 'Iterative sovler has satisfied convergence test.' + else if (ipar(1).eq.-1) then + WRITE(*,*) 'Iterative solver has iterated too many times.' + else if (ipar(1).eq.-2) then + WRITE(*,*) 'Iterative solver was not given enough work space.' + WRITE(*,*) 'The work space should at least have ', ipar(4), & + & ' elements.' + else if (ipar(1).eq.-3) then + WRITE(*,*) 'Iterative sovler is facing a break-down.' + else + WRITE(*,*) 'Iterative solver terminated. code =', ipar(1) + endif + exit + endif + end do end subroutine runrc !-----end-of-runrc !----------------------------------------------------------------------c @@ -3914,7 +3954,10 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) ! locals integer ju0,k,j1,j2,j,ii,i,lenl,lenu,jj,jrow,jpos,lenn real*8 tnorm, t, abs, s, fact - if (lfil .lt. 0) goto 998 + if (lfil .lt. 0) then ! illegal lfil entered. + ierr = -4 + return + end if !----------------------------------------------------------------------- ! initialize ju0 (points to next element to be added to alu,jlu) ! and pointer array. @@ -3939,7 +3982,10 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) do k=j1,j2 tnorm = tnorm+abs(a(k)) end do - if (abs(tnorm) .lt. tiny(1.)) goto 999 + if (abs(tnorm) .lt. tiny(1.)) then ! zero row encountered + ierr = -5 + return + end if tnorm = tnorm/real(j2-j1+1) ! @@ -3974,104 +4020,110 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) ! ! eliminate previous rows ! -150 jj = jj+1 - if (jj .gt. lenl) goto 160 - !----------------------------------------------------------------------- - ! in order to do the elimination in the correct order we must select - ! the smallest column index among jw(k), k=jj+1, ..., lenl. - !----------------------------------------------------------------------- - jrow = jw(jj) - k = jj - ! - ! determine smallest column index - ! - do j=jj+1,lenl - if (jw(j) .lt. jrow) then - jrow = jw(j) - k = j - endif - end do - ! - if (k .ne. jj) then - ! exchange in jw - j = jw(jj) - jw(jj) = jw(k) - jw(k) = j - ! exchange in jr - jw(n+jrow) = jj - jw(n+j) = k - ! exchange in w - s = w(jj) - w(jj) = w(k) - w(k) = s - endif - ! - ! zero out element in row by setting jw(n+jrow) to zero. - ! - jw(n+jrow) = 0 - ! - ! get the multiplier for row to be eliminated (jrow). - ! - fact = w(jj)*alu(jrow) - if (abs(fact) .le. droptol) goto 150 - ! - ! combine current row and row jrow - ! - do k = ju(jrow), jlu(jrow+1)-1 - s = fact*alu(k) - j = jlu(k) - jpos = jw(n+j) - if (j .ge. ii) then - ! - ! dealing with upper part. - ! - if (jpos .eq. 0) then - ! - ! this is a fill-in element - ! - lenu = lenu+1 - if (lenu .gt. n) goto 995 - i = ii+lenu-1 - jw(i) = j - jw(n+j) = i - w(i) = - s - else - ! - ! this is not a fill-in element - ! - w(jpos) = w(jpos) - s - + do + jj = jj+1 + if (jj .gt. lenl) exit + !----------------------------------------------------------------------- + ! in order to do the elimination in the correct order we must select + ! the smallest column index among jw(k), k=jj+1, ..., lenl. + !----------------------------------------------------------------------- + jrow = jw(jj) + k = jj + ! + ! determine smallest column index + ! + do j=jj+1,lenl + if (jw(j) .lt. jrow) then + jrow = jw(j) + k = j endif - else - ! - ! dealing with lower part. - ! - if (jpos .eq. 0) then + end do + ! + if (k .ne. jj) then + ! exchange in jw + j = jw(jj) + jw(jj) = jw(k) + jw(k) = j + ! exchange in jr + jw(n+jrow) = jj + jw(n+j) = k + ! exchange in w + s = w(jj) + w(jj) = w(k) + w(k) = s + endif + ! + ! zero out element in row by setting jw(n+jrow) to zero. + ! + jw(n+jrow) = 0 + ! + ! get the multiplier for row to be eliminated (jrow). + ! + fact = w(jj)*alu(jrow) + if (abs(fact) .le. droptol) cycle + ! + ! combine current row and row jrow + ! + do k = ju(jrow), jlu(jrow+1)-1 + s = fact*alu(k) + j = jlu(k) + jpos = jw(n+j) + if (j .ge. ii) then ! - ! this is a fill-in element + ! dealing with upper part. ! - lenl = lenl+1 - if (lenl .gt. n) goto 995 - jw(lenl) = j - jw(n+j) = lenl - w(lenl) = - s + if (jpos .eq. 0) then + ! + ! this is a fill-in element + ! + lenu = lenu+1 + if (lenu .gt. n) then ! incomprehensible error. Matrix must be wrong. + ierr = -1 + return + end if + i = ii+lenu-1 + jw(i) = j + jw(n+j) = i + w(i) = - s + else + ! + ! this is not a fill-in element + ! + w(jpos) = w(jpos) - s + + endif else ! - ! this is not a fill-in element + ! dealing with lower part. ! - w(jpos) = w(jpos) - s + if (jpos .eq. 0) then + ! + ! this is a fill-in element + ! + lenl = lenl+1 + if (lenl .gt. n) then ! incomprehensible error. Matrix must be wrong. + ierr = -1 + return + end if + jw(lenl) = j + jw(n+j) = lenl + w(lenl) = - s + else + ! + ! this is not a fill-in element + ! + w(jpos) = w(jpos) - s + endif endif - endif + end do + ! + ! store this pivot element -- (from left to right -- no danger of + ! overlap with the working elements in L (pivots). + ! + lenn = lenn+1 + w(lenn) = fact + jw(lenn) = jrow end do - ! - ! store this pivot element -- (from left to right -- no danger of - ! overlap with the working elements in L (pivots). - ! - lenn = lenn+1 - w(lenn) = fact - jw(lenn) = jrow - goto 150 -160 continue ! ! reset double-pointer to zero (U-part) ! @@ -4091,7 +4143,10 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) ! store L-part ! do k=1, lenn - if (ju0 .gt. iwk) goto 996 + if (ju0 .gt. iwk) then! insufficient storage in L. + ierr = -2 + return + end if alu(ju0) = w(k) jlu(ju0) = jw(k) ju0 = ju0+1 @@ -4119,7 +4174,10 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) ! copy ! t = abs(w(ii)) - if (lenn + ju0 .gt. iwk) goto 997 + if (lenn + ju0 .gt. iwk) then ! insufficient storage in U. + ierr = -3 + return + end if do k=ii+1,ii+lenn-1 jlu(ju0) = jw(k) alu(ju0) = w(k) @@ -4141,32 +4199,8 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) ! end main loop !----------------------------------------------------------------------- end do + ierr = 0 - return - ! - ! incomprehensible error. Matrix must be wrong. - ! -995 ierr = -1 - return - ! - ! insufficient storage in L. - ! -996 ierr = -2 - return - ! - ! insufficient storage in U. - ! -997 ierr = -3 - return - ! - ! illegal lfil entered. - ! -998 ierr = -4 - return - ! - ! zero row encountered - ! -999 ierr = -5 return !----------------end-of-ilut-------------------------------------------- !----------------------------------------------------------------------- @@ -4217,7 +4251,10 @@ subroutine ilu0(n, a, ja, ia, alu, jlu, ju, iw, ierr) end do end do ! invert and store diagonal element. - if (abs(alu(ii)) .lt. tiny(1.)) goto 600 + if (abs(alu(ii)) .lt. tiny(1.)) then ! zero pivot : + ierr = ii + return + end if alu(ii) = 1.0d0/alu(ii) ! reset pointer iw to zero iw(ii) = 0 @@ -4229,9 +4266,6 @@ subroutine ilu0(n, a, ja, ia, alu, jlu, ju, iw, ierr) ierr = 0 return - ! zero pivot : -600 ierr = ii - return end subroutine ilu0 !----------------------------------------------------------------------- ! subroutine pgmres(n, im, rhs, sol, eps, maxits, ierr) @@ -4333,160 +4367,165 @@ subroutine pgmres(n, im, rhs, sol, eps, maxits, aspar, nnz, ia, ja, alu, jlu, ju do j=1,n vv(j,1) = rhs(j) - vv(j,1) end do -20 if (lblas) then - ro = dnrm2(n, vv) - else - ro = sqrt(sum(vv(:,1)*vv(:,1))) - end if - if (abs(ro) .lt. epsmac) goto 999 - t = 1.0d0 / ro - do j=1, n - vv(j,1) = vv(j,1)*t - end do - if (its .eq. 0) eps1=eps*ro - ! initialize 1-st term of rhs of hessenberg system.. - rs(1) = ro - i = 0 -4 i=i+1 - its = its + 1 - i1 = i + 1 - if (lblas) then - call lusol (n, vv(1,i), rhs, alu, jlu, ju) - call amux (n, rhs, vv(1,i1), aspar, ja, ia) - else - do iii = 1, n !- lusol - rhs(iii) = vv(iii,i) - do k=jlu(iii),ju(iii)-1 - rhs(iii) = rhs(iii) - alu(k)* rhs(jlu(k)) - end do - end do - do iii = n, 1, -1 - do k=ju(iii),jlu(iii+1)-1 - rhs(iii) = rhs(iii) - alu(k)*rhs(jlu(k)) - end do - rhs(iii) = alu(iii)*rhs(iii) - end do - do iii = 1, n !- amux - t = 0.0d0 - do k = ia(iii), ia(iii+1)-1 - t = t + aspar(k) * rhs(ja(k)) - end do - vv(iii,i1) = t + do + if (lblas) then + ro = dnrm2(n, vv) + else + ro = sqrt(sum(vv(:,1)*vv(:,1))) + end if + if (abs(ro) .lt. epsmac) then + ierr = -1 + return + end if + t = 1.0d0 / ro + do j=1, n + vv(j,1) = vv(j,1)*t end do - end if - ! modified gram - schmidt... - if (lblas) then - do j=1, i - t = ddot(n, vv(1,j),vv(1,i1)) - hh(j,i) = t - call daxpy(n, -t, vv(1,j), 1, vv(1,i1), 1) - t = dnrm2(n, vv(1,i1)) + if (its .eq. 0) eps1=eps*ro + ! initialize 1-st term of rhs of hessenberg system.. + rs(1) = ro + i = 0 + do + i=i+1 + its = its + 1 + i1 = i + 1 + if (lblas) then + call lusol (n, vv(1,i), rhs, alu, jlu, ju) + call amux (n, rhs, vv(1,i1), aspar, ja, ia) + else + do iii = 1, n !- lusol + rhs(iii) = vv(iii,i) + do k=jlu(iii),ju(iii)-1 + rhs(iii) = rhs(iii) - alu(k)* rhs(jlu(k)) + end do + end do + do iii = n, 1, -1 + do k=ju(iii),jlu(iii+1)-1 + rhs(iii) = rhs(iii) - alu(k)*rhs(jlu(k)) + end do + rhs(iii) = alu(iii)*rhs(iii) + end do + do iii = 1, n !- amux + t = 0.0d0 + do k = ia(iii), ia(iii+1)-1 + t = t + aspar(k) * rhs(ja(k)) + end do + vv(iii,i1) = t + end do + end if + ! modified gram - schmidt... + if (lblas) then + do j=1, i + t = ddot(n, vv(1,j),vv(1,i1)) + hh(j,i) = t + call daxpy(n, -t, vv(1,j), 1, vv(1,i1), 1) + t = dnrm2(n, vv(1,i1)) + end do + else + do j=1, i + t = 0.d0 + do iii = 1,n + t = t + vv(iii,j)*vv(iii,i1) + end do + hh(j,i) = t + vv(:,i1) = vv(:,i1) - t * vv(:,j) + t = sqrt(sum(vv(:,i1)*vv(:,i1))) + end do + end if + hh(i1,i) = t + if ( abs(t) .ge. epsmac) then + t = 1.0d0/t + do k=1,n + vv(k,i1) = vv(k,i1)*t + end do + end if + ! done with modified gram schimd and arnoldi step.. now update factorization of hh + if (i .ne. 1) then + do k=2,i + k1 = k-1 + t = hh(k1,i) + hh(k1,i) = c(k1)*t + s(k1)*hh(k,i) + hh(k,i) = -s(k1)*t + c(k1)*hh(k,i) + end do + end if + gam = sqrt(hh(i,i)**2 + hh(i1,i)**2) + if (abs(gam) .lt. epsmac) gam = epsmac + ! get next plane rotation + c(i) = hh(i,i)/gam + s(i) = hh(i1,i)/gam + rs(i1) = -s(i)*rs(i) + rs(i) = c(i)*rs(i) + ! detrermine residual norm and test for convergence- + hh(i,i) = c(i)*hh(i,i) + s(i)*hh(i1,i) + ro = abs(rs(i1)) + if (i .ge. im .or. (ro .le. eps1)) exit end do - else - do j=1, i - t = 0.d0 - do iii = 1,n - t = t + vv(iii,j)*vv(iii,i1) + ! now compute solution. first solve upper triangular system. + rs(i) = rs(i)/hh(i,i) + do ii=2,i + k=i-ii+1 + k1 = k+1 + t=rs(k) + do j=k1,i + t = t-hh(k,j)*rs(j) end do - hh(j,i) = t - vv(:,i1) = vv(:,i1) - t * vv(:,j) - t = sqrt(sum(vv(:,i1)*vv(:,i1))) - end do - end if - hh(i1,i) = t - if ( abs(t) .lt. epsmac) goto 58 - t = 1.0d0/t - do k=1,n - vv(k,i1) = vv(k,i1)*t - end do - ! done with modified gram schimd and arnoldi step.. now update factorization of hh -58 if (i .eq. 1) goto 121 - do k=2,i - k1 = k-1 - t = hh(k1,i) - hh(k1,i) = c(k1)*t + s(k1)*hh(k,i) - hh(k,i) = -s(k1)*t + c(k1)*hh(k,i) - end do -121 gam = sqrt(hh(i,i)**2 + hh(i1,i)**2) - if (abs(gam) .lt. epsmac) gam = epsmac - ! get next plane rotation - c(i) = hh(i,i)/gam - s(i) = hh(i1,i)/gam - rs(i1) = -s(i)*rs(i) - rs(i) = c(i)*rs(i) - ! detrermine residual norm and test for convergence- - hh(i,i) = c(i)*hh(i,i) + s(i)*hh(i1,i) - ro = abs(rs(i1)) - if (i .lt. im .and. (ro .gt. eps1)) goto 4 - ! now compute solution. first solve upper triangular system. - rs(i) = rs(i)/hh(i,i) - do ii=2,i - k=i-ii+1 - k1 = k+1 - t=rs(k) - do j=k1,i - t = t-hh(k,j)*rs(j) + rs(k) = t/hh(k,k) end do - rs(k) = t/hh(k,k) - end do - ! form linear combination of v(*,i)'s to get solution - t = rs(1) - do k=1, n - rhs(k) = vv(k,1)*t - end do - do j = 2, i - t = rs(j) + ! form linear combination of v(*,i)'s to get solution + t = rs(1) do k=1, n - rhs(k) = rhs(k)+t*vv(k,j) + rhs(k) = vv(k,1)*t end do - end do - ! call preconditioner. - if (lblas) then - call lusol (n, rhs, rhs, alu, jlu, ju) - else - do iii = 1, n - do k=jlu(iii),ju(iii)-1 - rhs(iii) = rhs(iii) - alu(k)* rhs(jlu(k)) - end do - end do - do iii = n, 1, -1 - do k=ju(iii),jlu(iii+1)-1 - rhs(iii) = rhs(iii) - alu(k)*rhs(jlu(k)) + do j = 2, i + t = rs(j) + do k=1, n + rhs(k) = rhs(k)+t*vv(k,j) end do - rhs(iii) = alu(iii)*rhs(iii) end do - end if - do k=1, n - sol(k) = sol(k) + rhs(k) - end do - ! restart outer loop when necessary - if (ro .le. eps1) goto 990 - if (its .ge. maxits) goto 991 - ! else compute residual vector and continue.. - do j=1,i - jj = i1-j+1 - rs(jj-1) = -s(jj-1)*rs(jj) - rs(jj) = c(jj-1)*rs(jj) - end do - do j=1,i1 - t = rs(j) - if (j .eq. 1) t = t-1.0d0 + ! call preconditioner. if (lblas) then - call daxpy (n, t, vv(1,j), 1, vv, 1) + call lusol (n, rhs, rhs, alu, jlu, ju) else - vv(:,j) = vv(:,j) + t * vv(:,1) + do iii = 1, n + do k=jlu(iii),ju(iii)-1 + rhs(iii) = rhs(iii) - alu(k)* rhs(jlu(k)) + end do + end do + do iii = n, 1, -1 + do k=ju(iii),jlu(iii+1)-1 + rhs(iii) = rhs(iii) - alu(k)*rhs(jlu(k)) + end do + rhs(iii) = alu(iii)*rhs(iii) + end do + end if + do k=1, n + sol(k) = sol(k) + rhs(k) + end do + ! restart outer loop when necessary + if (ro .le. eps1) then + ierr = 0 + return end if + if (its .ge. maxits) then + ierr = 1 + return + end if + ! else compute residual vector and continue.. + do j=1,i + jj = i1-j+1 + rs(jj-1) = -s(jj-1)*rs(jj) + rs(jj) = c(jj-1)*rs(jj) + end do + do j=1,i1 + t = rs(j) + if (j .eq. 1) t = t-1.0d0 + if (lblas) then + call daxpy (n, t, vv(1,j), 1, vv, 1) + else + vv(:,j) = vv(:,j) + t * vv(:,1) + end if + end do end do - ! 199 format(' its =', i4, ' res. norm =', d20.6) - ! restart outer loop. - goto 20 -990 ierr = 0 - return -991 ierr = 1 - return -999 continue - ierr = -1 - return !--------------------------------------------------------------------- end subroutine pgmres !----------------------------------------------------------------------- @@ -4615,25 +4654,24 @@ double precision function ddot(n,dx,dy) ! uses unrolled loops for increments equal to one. ! jack dongarra, linpack, 3/11/78. ! - double precision dx(*),dy(*),dtemp + double precision dx(*),dy(*) integer i,m,mp1,n ! ddot = 0.0d0 - dtemp = 0.0d0 if(n.le.0)return -20 m = mod(n,5) - if( m .eq. 0 ) go to 40 - do i = 1,m - dtemp = dtemp + dx(i)*dy(i) - end do - if( n .lt. 5 ) go to 60 -40 mp1 = m + 1 + m = mod(n,5) + if( m .ne. 0 ) then + do i = 1,m + ddot = ddot + dx(i)*dy(i) + end do + if( n .lt. 5 ) return + end if + mp1 = m + 1 do i = mp1,n,5 - dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) + & + ddot = ddot + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) + & & dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4) end do -60 ddot = dtemp return end function ddot !---------------------------------------------------------------------- @@ -4648,34 +4686,36 @@ subroutine daxpy(n,da,dx,incx,dy,incy) ! if(n.le.0)return if (abs(da) .lt. tiny(1.d0)) return - if(incx.eq.1.and.incy.eq.1)go to 20 - ! - ! code for unequal increments or equal increments - ! not equal to 1 - ! - ix = 1 - iy = 1 - if(incx.lt.0)ix = (-n+1)*incx + 1 - if(incy.lt.0)iy = (-n+1)*incy + 1 - do i = 1,n - dy(iy) = dy(iy) + da*dx(ix) - ix = ix + incx - iy = iy + incy - end do - return - ! - ! code for both increments equal to 1 - ! - ! - ! clean-up loop - ! -20 m = mod(n,4) - if( m .eq. 0 ) go to 40 - do i = 1,m - dy(i) = dy(i) + da*dx(i) - end do - if( n .lt. 4 ) return -40 mp1 = m + 1 + if(incx.ne.1.or.incy.ne.1) then + ! + ! code for unequal increments or equal increments + ! not equal to 1 + ! + ix = 1 + iy = 1 + if(incx.lt.0)ix = (-n+1)*incx + 1 + if(incy.lt.0)iy = (-n+1)*incy + 1 + do i = 1,n + dy(iy) = dy(iy) + da*dx(ix) + ix = ix + incx + iy = iy + incy + end do + return + ! + ! code for both increments equal to 1 + ! + ! + ! clean-up loop + ! + end if + m = mod(n,4) + if( m .ne. 0 ) then + do i = 1,m + dy(i) = dy(i) + da*dx(i) + end do + if( n .lt. 4 ) return + end if + mp1 = m + 1 do i = mp1,n,4 dy(i) = dy(i) + da*dx(i) dy(i + 1) = dy(i + 1) + da*dx(i + 1) diff --git a/model/src/w3psmcmd.F90 b/model/src/w3psmcmd.F90 index 6083a78223..537769986d 100644 --- a/model/src/w3psmcmd.F90 +++ b/model/src/w3psmcmd.F90 @@ -3710,7 +3710,6 @@ SUBROUTINE W3SMCELL( IMOD, NC, IDCl, XLon, YLat ) !/ ------------------------------------------------------------------- / USE CONSTANTS USE W3GDATMD - USE W3SERVMD, ONLY: EXTCDE USE W3ODATMD, ONLY: NDSE, NDST #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -3852,7 +3851,6 @@ SUBROUTINE W3SMCGMP( IMOD, NC, XLon, YLat, IDCl ) !/ ------------------------------------------------------------------- / USE CONSTANTS USE W3GDATMD - USE W3SERVMD, ONLY: EXTCDE USE W3ODATMD, ONLY: NDSE, NDST #ifdef W3_S USE W3SERVMD, ONLY: STRACE diff --git a/model/src/w3sbt4md.F90 b/model/src/w3sbt4md.F90 index 1d0e3a8d7a..6c6f5107c1 100644 --- a/model/src/w3sbt4md.F90 +++ b/model/src/w3sbt4md.F90 @@ -413,7 +413,6 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) USE CONSTANTS USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DDEN, & SBTCX, ECOS, ESIN, DTH diff --git a/model/src/w3servmd.F90 b/model/src/w3servmd.F90 index 44d986f7d9..67c52f1794 100644 --- a/model/src/w3servmd.F90 +++ b/model/src/w3servmd.F90 @@ -19,6 +19,8 @@ MODULE W3SERVMD !/ processing rotated grid data !/ 15-Jan-2021 : Added UV_TO_MAG_DIR routine ( version 7.12 ) !/ 02-Jan-2025 : Added DIST_HAVERSINE routine ( version 7.xx ) + !/ 04-Jul-2025 : Remove labelled statements, add EXTIOF and + !/ EXTOPN routines ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -52,6 +54,8 @@ MODULE W3SERVMD ! EJ5P R.F. Public Five parameter JONSWAP spectrum. ! WWDATE Subr. Public Get system date. ! WWTIME Subr. Public Get system time. + ! EXTOPN Subr. Public Abort program with exit code when opening file. + ! EXTIOF Subr. Public Abort program with exit code when I/O file. ! EXTCDE Subr. Public Abort program with exit code. ! Four subs for rotated grid are appended to this module. As they ! are shared with SMC grid, they are not quoted by option /RTD but @@ -290,41 +294,28 @@ SUBROUTINE NEXTLN ( CHCKC , NDSI , NDSE ) CALL STRACE (IENT, 'NEXTLN') #endif ! -100 CONTINUE - ! read line - READ ( NDSI, 900, END=800, ERR=801, IOSTAT=IERR, IOMSG=MSG ) LINE - ! leading blanks removed and placed on the right - TEST = ADJUSTL ( LINE ) - IF ( TEST(1:1).EQ.CHCKC .OR. LEN_TRIM(TEST).EQ.0 ) THEN - ! if comment or blank line, then skip - GOTO 100 - ELSE - ! otherwise, backup to beginning of line - BACKSPACE ( NDSI, ERR=802, IOSTAT=IERR, IOMSG=MSG ) - ENDIF - RETURN - ! -800 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,910) - CALL EXTCDE ( 1 ) - ! -801 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,911) IERR, TRIM(MSG) - CALL EXTCDE ( 2 ) - ! -802 CONTINUE - IF ( NDSE .GE. 0 ) WRITE (NDSE,912) IERR, TRIM(MSG) - CALL EXTCDE ( 3 ) + DO + ! read line + READ ( NDSI, '(A)', IOSTAT=IERR, IOMSG=MSG ) LINE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'NEXTLN','INPUT',1,MSG) + ! leading blanks removed and placed on the right + TEST = ADJUSTL ( LINE ) + IF ( TEST(1:1).EQ.CHCKC .OR. LEN_TRIM(TEST).EQ.0 ) THEN + ! if comment or blank line, then skip + CYCLE + ELSE + ! otherwise, backup to beginning of line and exit + BACKSPACE ( NDSI, IOSTAT=IERR, IOMSG=MSG ) + IF (IERR.GT.0) THEN + IF ( NDSE .GE. 0 ) WRITE (NDSE,912) IERR, TRIM(MSG) + CALL EXTCDE ( 3 ) + END IF + RETURN + ENDIF + END DO ! ! Formats ! -900 FORMAT (A) -910 FORMAT (/' *** WAVEWATCH III ERROR IN NEXTLN : '/ & - ' PREMATURE END OF INPUT FILE'/) -911 FORMAT (/' *** WAVEWATCH III ERROR IN NEXTLN : '/ & - ' ERROR IN READING FROM FILE'/ & - ' IOSTAT =',I5,/ & - ' IOMSG = ',A/) 912 FORMAT (/' *** WAVEWATCH III ERROR IN NEXTLN : '/ & ' ERROR ON BACKSPACE'/ & ' IOSTAT =',I5,/ & @@ -827,6 +818,248 @@ SUBROUTINE WWTIME (STRNG) !/ END SUBROUTINE WWTIME !/ ------------------------------------------------------------------- / + SUBROUTINE EXTIOF (NDSE, IERR, PNAME, FNAME, ERRCODE, MESSAGE, & + ISWRITE, POS, FIELD) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | H. L. Tolman | + !/ | FORTRAN 90 | + !/ | Last update : 27-Jun-2025 | + !/ +-----------------------------------+ + !/ + !/ 27-Jun-2025 : First implementation ( version x.xx ) + !/ + ! 1. Purpose : + ! + ! Perform a program stop with an exit code when there are errors + ! reading or writing a file + ! + ! 2. Method : + ! + ! Check IOSTAT and call EXTCDE if it shows an error + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! NDSE Int. I File unit where to write error messages + ! IERR Int. I Error code thrown by the OPEN statement + ! PNAME Str. I Name of the calling subroutine + ! FNAME Str. I Type of file that was opened + ! ERRCODE Int. I Exit code to be used. + ! MESSAGE Str. I (optional) error message + ! ISWRITE Log. I (optional) output writing version + ! POS Int. I (optional) writing position + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! EXTCDE + ! + ! 5. Called by : + ! + ! Any routine. + ! + ! 9. Switches : + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + !/ + !/ ------------------------------------------------------------------- / + !/ Parameter list + !/ + INTEGER, INTENT(IN) :: NDSE, IERR, ERRCODE + CHARACTER(len=*), INTENT(IN) :: PNAME, FNAME + CHARACTER(len=*), INTENT(IN), OPTIONAL :: MESSAGE + LOGICAL, INTENT(IN), OPTIONAL :: ISWRITE + INTEGER(KIND=8), INTENT(IN), OPTIONAL :: POS + CHARACTER(len=*), INTENT(IN), OPTIONAL :: FIELD + !/ + !/ ------------------------------------------------------------------- / + !/ Local parameters + !/ + LOGICAL :: TOWRITE + !/ ------------------------------------------------------------------- / + !/ + ! + IF (PRESENT(ISWRITE)) THEN + TOWRITE = ISWRITE + ELSE + TOWRITE = .FALSE. + END IF + ! + IF (TOWRITE) THEN + IF (PRESENT(POS)) THEN + WRITE (NDSE,903) TRIM(PNAME), TRIM(FNAME), IERR, POS + CALL EXTCDE ( ERRCODE ) + ELSE + WRITE (NDSE,900) TRIM(PNAME), TRIM(FNAME), IERR + CALL EXTCDE ( ERRCODE ) + END IF + ELSE + IF (TRIM(PNAME).EQ.'W3TIMEMD') THEN + IF (IERR.LT.0) THEN + WRITE (NDSE,1004) TRIM(PNAME), TRIM(FNAME) + ELSE + WRITE (NDSE,1005) TRIM(PNAME), TRIM(FNAME), IERR + END IF + ELSE + IF (IERR.GT.0) THEN + IF (PRESENT(MESSAGE)) THEN + WRITE (NDSE,1003) TRIM(PNAME), TRIM(FNAME), IERR, TRIM(MESSAGE) + ELSE IF (PRESENT(FIELD)) THEN + WRITE (NDSE,1006) TRIM(PNAME), TRIM(FIELD), TRIM(FNAME), IERR + ELSE + WRITE (NDSE,1002) TRIM(PNAME), TRIM(FNAME), IERR + END IF + CALL EXTCDE ( ERRCODE+1 ) + END IF + IF (IERR.LT.0) THEN + WRITE (NDSE,1001) TRIM(PNAME), TRIM(FNAME) + CALL EXTCDE ( ERRCODE ) + END IF + END IF + END IF + ! +900 FORMAT (/' *** ERROR ', A, ' : '/ & + ' ERROR IN WRITING TO ', A, ' FILE'/ & + ' IOSTAT =',I5/) + ! +903 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN WRITING TO ', A, ' FILE'/ & + ' IOSTAT =',I5,', POS =',I11 /) + ! +1001 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' PREMATURE END OF ', A, ' FILE'/) + ! +1002 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN READING FROM ', A, ' FILE'/ & + ' IOSTAT =',I5/) + ! +1003 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN READING FROM ', A, ' FILE'/ & + ' IOSTAT =',I5,/ & + ' IOMSG = ',A/) + ! +1006 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN READING ',A,' FROM ', A, ' FILE'/ & + ' IOSTAT =',I5/) + ! +1004 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' PREMATURE END OF TIME ATTRIBUTE '/ & + ' ',A/ & + ' DIFFERS FROM CONVENTIONS ISO8601 '/ & + ' XXX since YYYY-MM-DD hh:mm:ss'/ & + ' XXX since YYYY-M-D h:m:s'/ & + ' XXX since YYYY-M-D hh:mm:ss'/) + ! +1005 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN READING OF TIME ATTRIBUTE '/ & + ' ',A/ & + ' DIFFERS FROM CONVENTIONS ISO8601 '/ & + ' XXX since YYYY-MM-DD hh:mm:ss'/ & + ' XXX since YYYY-M-D h:m:s'/ & + ' XXX since YYYY-M-D hh:mm:ss'/ & + ' IOSTAT =',I5/) + + RETURN + !/ + !/ End of EXTIOF ----------------------------------------------------- / + !/ + END SUBROUTINE EXTIOF + !/ ------------------------------------------------------------------- / + SUBROUTINE EXTOPN (NDSE, IERR, PNAME, FNAME, ERRCODE, NDSF, NAMEF) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | H. L. Tolman | + !/ | FORTRAN 90 | + !/ | Last update : 27-Jun-2025 | + !/ +-----------------------------------+ + !/ + !/ 27-Jun-2025 : First implementation ( version x.xx ) + !/ + ! 1. Purpose : + ! + ! Perform a program stop with an exit code when there are errors + ! opening a file + ! + ! 2. Method : + ! + ! Check IOSTAT and call EXTCDE if it shows an error + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! NDSE Int. I File unit where to write error messages + ! IERR Int. I Error code thrown by the OPEN statement + ! PNAME Str. I Name of the calling subroutine + ! FNAME Str. I Type of file that was opened + ! ERRCODE Int. I Exit code to be used. + ! NDSF Int. I (optional) file unit + ! NAMEF Str. I (optional) name of the file that was opened + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! EXTCDE + ! + ! 5. Called by : + ! + ! Any routine. + ! + ! 9. Switches : + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + !/ + !/ ------------------------------------------------------------------- / + !/ Parameter list + !/ + INTEGER, INTENT(IN) :: NDSE, IERR, ERRCODE + CHARACTER(len=*), INTENT(IN) :: PNAME, FNAME + INTEGER, INTENT(IN), OPTIONAL :: NDSF + CHARACTER(len=*), INTENT(IN), OPTIONAL :: NAMEF + !/ + !/ ------------------------------------------------------------------- / + !/ Local parameters + !/ + !/ ------------------------------------------------------------------- / + !/ + ! + IF (PRESENT(NDSF) .AND. PRESENT(NAMEF)) THEN + WRITE (NDSE,1050) TRIM(PNAME), TRIM(FNAME), IERR, NDSF, TRIM(NAMEF) + ELSE IF (PRESENT(NAMEF)) THEN + WRITE (NDSE,1009) TRIM(PNAME), TRIM(FNAME), IERR, TRIM(NAMEF) + ELSE + WRITE (NDSE,1000) TRIM(PNAME), TRIM(FNAME), IERR + END IF + CALL EXTCDE ( ERRCODE ) + +1000 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN OPENING ', A, ' FILE'/ & + ' IOSTAT =',I5/) +! +1009 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN OPENING ', A, ' FILE: ', A/ & + ' IOSTAT =',I5/) +! +1050 FORMAT (/' *** WAVEWATCH III ERROR IN ', A, ' : '/ & + ' ERROR IN OPENING ', A, ' FILE'/ & + ' IOSTAT =',I5/ & + ' NDSF =',I5/ & + ' NAMEF = ',A/) + ! + RETURN + !/ + !/ End of EXTOPN ----------------------------------------------------- / + !/ + END SUBROUTINE EXTOPN + !/ ------------------------------------------------------------------- / SUBROUTINE EXTCDE ( IEXIT, UNIT, MSG, FILE, LINE, COMM ) !/ !/ +-----------------------------------+ @@ -1690,237 +1923,263 @@ SUBROUTINE SSORT1 (X, Y, N, KFLAG) end do ENDIF ! - IF (KK .EQ. 2) GO TO 100 - ! - ! Sort X only - ! - M = 1 - I = 1 - J = NN - R = 0.375E0 - ! -20 IF (I .EQ. J) GO TO 60 - IF (R .LE. 0.5898437E0) THEN - R = R+3.90625E-2 - ELSE - R = R-0.21875E0 - ENDIF - ! -30 K = I - ! - ! Select a central element of the array and save it in location T - ! - IJ = I + INT((J-I)*R) - T = X(IJ) - ! - ! If first element of array is greater than T, interchange with T - ! - IF (X(I) .GT. T) THEN - X(IJ) = X(I) - X(I) = T - T = X(IJ) - ENDIF - L = J - ! - ! If last element of array is less than than T, interchange with T - ! - IF (X(J) .LT. T) THEN - X(IJ) = X(J) - X(J) = T - T = X(IJ) + IF (KK .EQ. 2) THEN ! - ! If first element of array is greater than T, interchange with T + ! Sort X and carry Y along ! - IF (X(I) .GT. T) THEN - X(IJ) = X(I) - X(I) = T - T = X(IJ) - ENDIF - ENDIF - ! - ! Find an element in the second half of the array which is smaller - ! than T - ! -40 L = L-1 - IF (X(L) .GT. T) GO TO 40 - ! - ! Find an element in the first half of the array which is greater - ! than T - ! -50 K = K+1 - IF (X(K) .LT. T) GO TO 50 - ! - ! Interchange these elements - ! - IF (K .LE. L) THEN - TT = X(L) - X(L) = X(K) - X(K) = TT - GO TO 40 - ENDIF - ! - ! Save upper and lower subscripts of the array yet to be sorted - ! - IF (L-I .GT. J-K) THEN - IL(M) = I - IU(M) = L - I = K - M = M+1 - ELSE - IL(M) = K - IU(M) = J - J = L - M = M+1 - ENDIF - GO TO 70 - ! - ! Begin again on another portion of the unsorted array - ! -60 M = M-1 - IF (M .EQ. 0) GO TO 190 - I = IL(M) - J = IU(M) - ! -70 IF (J-I .GE. 1) GO TO 30 - IF (I .EQ. 1) GO TO 20 - I = I-1 - ! -80 I = I+1 - IF (I .EQ. J) GO TO 60 - T = X(I+1) - IF (X(I) .LE. T) GO TO 80 - K = I - ! -90 X(K+1) = X(K) - K = K-1 - IF (T .LT. X(K)) GO TO 90 - X(K+1) = T - GO TO 80 - ! - ! Sort X and carry Y along - ! -100 M = 1 - I = 1 - J = NN - R = 0.375E0 - ! -110 IF (I .EQ. J) GO TO 150 - IF (R .LE. 0.5898437E0) THEN - R = R+3.90625E-2 + M = 1 + I = 1 + J = NN + R = 0.375E0 + ! + DO + IF (I .EQ. J) THEN + M = M-1 + IF (M .EQ. 0) EXIT + I = IL(M) + J = IU(M) + DO WHILE (J-I .GE. 1) + ! + K = I + ! + ! Select a central element of the array and save it in location T + ! + IJ = I + INT((J-I)*R) + T = X(IJ) + TY = Y(IJ) + ! + ! If first element of array is greater than T, interchange with T + ! + IF (X(I) .GT. T) THEN + X(IJ) = X(I) + X(I) = T + T = X(IJ) + Y(IJ) = Y(I) + Y(I) = TY + TY = Y(IJ) + ENDIF + L = J + ! + ! If last element of array is less than T, interchange with T + ! + IF (X(J) .LT. T) THEN + X(IJ) = X(J) + X(J) = T + T = X(IJ) + Y(IJ) = Y(J) + Y(J) = TY + TY = Y(IJ) + ! + ! If first element of array is greater than T, interchange with T + ! + IF (X(I) .GT. T) THEN + X(IJ) = X(I) + X(I) = T + T = X(IJ) + Y(IJ) = Y(I) + Y(I) = TY + TY = Y(IJ) + ENDIF + ENDIF + ! + DO + ! + ! Find an element in the second half of the array which is smaller + ! than T + ! + DO + L = L-1 + IF (X(L) .LE. T) EXIT + END DO + ! + ! Find an element in the first half of the array which is greater + ! than T + ! + DO + K = K+1 + IF (X(K) .GE. T) EXIT + END DO + ! + ! Interchange these elements + ! + IF (K .LE. L) THEN + TT = X(L) + X(L) = X(K) + X(K) = TT + TTY = Y(L) + Y(L) = Y(K) + Y(K) = TTY + ELSE + EXIT + ENDIF + END DO + ! + ! Save upper and lower subscripts of the array yet to be sorted + ! + IF (L-I .GT. J-K) THEN + IL(M) = I + IU(M) = L + I = K + M = M+1 + ELSE + IL(M) = K + IU(M) = J + J = L + M = M+1 + ENDIF + END DO + ! + IF (I .EQ. 1) CYCLE + ! + I = I-1 + ! + DO + I = I+1 + IF (I .EQ. J) EXIT + T = X(I+1) + TY = Y(I+1) + IF (X(I) .LE. T) CYCLE + K = I + ! + DO + X(K+1) = X(K) + Y(K+1) = Y(K) + K = K-1 + IF (T .GE. X(K)) EXIT + END DO + X(K+1) = T + Y(K+1) = TY + END DO + IF (I .EQ. J) CYCLE + END IF + ! + IF (R .LE. 0.5898437E0) THEN + R = R+3.90625E-2 + ELSE + R = R-0.21875E0 + ENDIF + END DO ELSE - R = R-0.21875E0 - ENDIF - ! -120 K = I - ! - ! Select a central element of the array and save it in location T - ! - IJ = I + INT((J-I)*R) - T = X(IJ) - TY = Y(IJ) - ! - ! If first element of array is greater than T, interchange with T - ! - IF (X(I) .GT. T) THEN - X(IJ) = X(I) - X(I) = T - T = X(IJ) - Y(IJ) = Y(I) - Y(I) = TY - TY = Y(IJ) - ENDIF - L = J - ! - ! If last element of array is less than T, interchange with T - ! - IF (X(J) .LT. T) THEN - X(IJ) = X(J) - X(J) = T - T = X(IJ) - Y(IJ) = Y(J) - Y(J) = TY - TY = Y(IJ) ! - ! If first element of array is greater than T, interchange with T + ! Sort X only ! - IF (X(I) .GT. T) THEN - X(IJ) = X(I) - X(I) = T - T = X(IJ) - Y(IJ) = Y(I) - Y(I) = TY - TY = Y(IJ) - ENDIF - ENDIF - ! - ! Find an element in the second half of the array which is smaller - ! than T - ! -130 L = L-1 - IF (X(L) .GT. T) GO TO 130 - ! - ! Find an element in the first half of the array which is greater - ! than T - ! -140 K = K+1 - IF (X(K) .LT. T) GO TO 140 - ! - ! Interchange these elements - ! - IF (K .LE. L) THEN - TT = X(L) - X(L) = X(K) - X(K) = TT - TTY = Y(L) - Y(L) = Y(K) - Y(K) = TTY - GO TO 130 - ENDIF - ! - ! Save upper and lower subscripts of the array yet to be sorted - ! - IF (L-I .GT. J-K) THEN - IL(M) = I - IU(M) = L - I = K - M = M+1 - ELSE - IL(M) = K - IU(M) = J - J = L - M = M+1 - ENDIF - GO TO 160 - ! - ! Begin again on another portion of the unsorted array - ! -150 M = M-1 - IF (M .EQ. 0) GO TO 190 - I = IL(M) - J = IU(M) - ! -160 IF (J-I .GE. 1) GO TO 120 - IF (I .EQ. 1) GO TO 110 - I = I-1 - ! -170 I = I+1 - IF (I .EQ. J) GO TO 150 - T = X(I+1) - TY = Y(I+1) - IF (X(I) .LE. T) GO TO 170 - K = I - ! -180 X(K+1) = X(K) - Y(K+1) = Y(K) - K = K-1 - IF (T .LT. X(K)) GO TO 180 - X(K+1) = T - Y(K+1) = TY - GO TO 170 + M = 1 + I = 1 + J = NN + R = 0.375E0 + ! + DO + IF (I .EQ. J) THEN + M = M-1 + IF (M .EQ. 0) EXIT + I = IL(M) + J = IU(M) + DO WHILE (J-I .GE. 1) + K = I + INT((J-I)*R) + T = X(IJ) + ! + ! If first element of array is greater than T, interchange with T + ! + IF (X(I) .GT. T) THEN + X(IJ) = X(I) + X(I) = T + T = X(IJ) + ENDIF + L = J + ! + ! If last element of array is less than than T, interchange with T + ! + IF (X(J) .LT. T) THEN + X(IJ) = X(J) + X(J) = T + T = X(IJ) + ! + ! If first element of array is greater than T, interchange with T + ! + IF (X(I) .GT. T) THEN + X(IJ) = X(I) + X(I) = T + T = X(IJ) + ENDIF + ENDIF + ! + ! Find an element in the second half of the array which is smaller + ! than T + ! + DO + DO + L = L-1 + IF (X(L) .LE. T) EXIT + END DO + ! + ! Find an element in the first half of the array which is greater + ! than T + ! + DO + K = K+1 + IF (X(K) .GE. T) EXIT + END DO + ! + ! Interchange these elements + ! + IF (K .LE. L) THEN + TT = X(L) + X(L) = X(K) + X(K) = TT + ELSE + EXIT + ENDIF + END DO + ! + ! Save upper and lower subscripts of the array yet to be sorted + ! + IF (L-I .GT. J-K) THEN + IL(M) = I + IU(M) = L + I = K + M = M+1 + ELSE + IL(M) = K + IU(M) = J + J = L + M = M+1 + ENDIF + END DO + IF (I .EQ. 1) CYCLE + I = I-1 + ! + DO + DO + I = I+1 + IF (I .EQ. J) EXIT + T = X(I+1) + IF (X(I) .GT. T) EXIT + END DO + IF (I .EQ. J) EXIT + K = I + ! + DO + X(K+1) = X(K) + K = K-1 + IF (T .GE. X(K)) EXIT + END DO + X(K+1) = T + END DO + IF (I .EQ. J) CYCLE + END IF + ! + IF (R .LE. 0.5898437E0) THEN + R = R+3.90625E-2 + ELSE + R = R-0.21875E0 + ENDIF + END DO + END IF ! ! Clean up ! -190 IF (KFLAG .LE. -1) THEN + IF (KFLAG .LE. -1) THEN DO I=1,NN X(I) = -X(I) end do diff --git a/model/src/w3sis1md.F90 b/model/src/w3sis1md.F90 index 4c7cff92b5..dde5f08fe6 100644 --- a/model/src/w3sis1md.F90 +++ b/model/src/w3sis1md.F90 @@ -136,7 +136,6 @@ SUBROUTINE W3SIS1 (A, ICE, S) ! !/ ------------------------------------------------------------------- / USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, SIG2, DDEN2 USE W3GDATMD, ONLY: DTMIN, TH, DTH, ECOS, DTMIN USE W3GDATMD, ONLY: IS1C1, IS1C2 diff --git a/model/src/w3sis2md.F90 b/model/src/w3sis2md.F90 index 3eba61f14f..11ebb1fe46 100644 --- a/model/src/w3sis2md.F90 +++ b/model/src/w3sis2md.F90 @@ -741,7 +741,6 @@ SUBROUTINE W3SIS2 (A, DEPTH, CICE, ICEH, ICEF, ICEDMAX, IX, IY, & !/ ------------------------------------------------------------------- / USE W3ODATMD, ONLY: NDSE USE CONSTANTS, ONLY: TPIINV, PI, TPI, GRAV, DWAT - USE W3SERVMD, ONLY: EXTCDE USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, SIG2, DDEN, IS2PARS, XFR, & IICEHMIN,IICESMOOTH #ifdef W3_T diff --git a/model/src/w3sln1md.F90 b/model/src/w3sln1md.F90 index 15b8b6228e..0c776729f6 100644 --- a/model/src/w3sln1md.F90 +++ b/model/src/w3sln1md.F90 @@ -138,7 +138,6 @@ SUBROUTINE W3SLN1 (K, FHIGH, USTAR, USDIR, S) USE CONSTANTS USE W3GDATMD, ONLY: NTH, NK, ECOS, ESIN, SIG, SLNC1, FSPM, FSHF USE W3ODATMD, ONLY: NDSE, NDST - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index 09c096d2bd..1e1949367f 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -37,6 +37,7 @@ MODULE W3SNL1MD !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 03-Sep-2012 : Clean up of test output T0, T1 ( version 4.07 ) !/ 28-Feb-2023 : Adds GQM separate routines ( version 7.07 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -1323,18 +1324,19 @@ SUBROUTINE GAULEG (W_LEG ,X_LEG ,NPOIN) M=(NPOIN+1)/2 DO I=1,M Z=COS(PI*(DBLE(I)-0.25D0)/(DBLE(NPOIN)+0.5D0)) -1 CONTINUE - P1=1.0D0 - P2=0.0D0 - DO J=1,NPOIN - P3=P2 - P2=P1 - P1=((2.D0*DBLE(J)-1.D0)*Z*P2-(DBLE(J)-1.D0)*P3)/DBLE(J) - ENDDO - PP=DBLE(NPOIN)*(Z*P1-P2)/(Z*Z-1.D0) - Z1=Z - Z=Z-P1/PP - IF (ABS(Z-Z1).GT.EPS) GOTO 1 + DO + P1=1.0D0 + P2=0.0D0 + DO J=1,NPOIN + P3=P2 + P2=P1 + P1=((2.D0*DBLE(J)-1.D0)*Z*P2-(DBLE(J)-1.D0)*P3)/DBLE(J) + ENDDO + PP=DBLE(NPOIN)*(Z*P1-P2)/(Z*Z-1.D0) + Z1=Z + Z=Z-P1/PP + IF (ABS(Z-Z1).LE.EPS) EXIT + END DO X_LEG(I)=-Z X_LEG(NPOIN+1-I)=Z W_LEG(I)=2.D0/((1.D0-Z**2)*PP**2) diff --git a/model/src/w3snl2md.F90 b/model/src/w3snl2md.F90 index 6008f4a8e2..4477eb9064 100644 --- a/model/src/w3snl2md.F90 +++ b/model/src/w3snl2md.F90 @@ -108,6 +108,7 @@ SUBROUTINE W3SNL2 ( A, CG, DEPTH, S, D ) !/ 11-Nov-2002 : Interface fix ( version 3.00 ) !/ 25-Sep-2003 : Exact-NL version 5.0 ( version 3.05 ) !/ 24-Dec-2004 : Multiple model version. ( version 3.06 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -232,45 +233,45 @@ SUBROUTINE W3SNL2 ( A, CG, DEPTH, S, D ) CALL xnl_main ( A2, SIG(1:NK), TH, NK, NTH, DEPTH, IQTPE, & S2, D2, IAPROC, IERR ) ! - IF ( IERR .NE. 0 ) GOTO 800 - ! - ! 3. Pack results in proper format ---------------------------------- * - ! - DO IK=1, NK - DO ITH=1, NTH - S(ITH,IK) = S2(IK,ITH) * CG(IK) - D(ITH,IK) = D2(IK,ITH) + IF ( IERR .EQ. 0 ) THEN + ! + ! 3. Pack results in proper format ---------------------------------- * + ! + DO IK=1, NK + DO ITH=1, NTH + S(ITH,IK) = S2(IK,ITH) * CG(IK) + D(ITH,IK) = D2(IK,ITH) + END DO END DO - END DO - ! - ! ... Test output : - ! + ! + ! ... Test output : + ! #ifdef W3_T0 - DO IK=1, NK - DO ITH=1, NTH - SOUT(IK,ITH) = S(IK,ITH) * TPI * SIG(IK) / CG(IK) - DOUT(IK,ITH) = D(IK,ITH) + DO IK=1, NK + DO ITH=1, NTH + SOUT(IK,ITH) = S(IK,ITH) * TPI * SIG(IK) / CG(IK) + DOUT(IK,ITH) = D(IK,ITH) + END DO END DO - END DO - CALL PRT2DS (NDST, NK, NK, NTH, SOUT, SIG(1:NK), ' ', 1., & - 0.0, 0.001, 'Snl(f,t)', ' ', 'NONAME') - CALL PRT2DS (NDST, NK, NK, NTH, DOUT, SIG(1:NK), ' ', 1., & - 0.0, 0.001, 'Diag Snl', ' ', 'NONAME') + CALL PRT2DS (NDST, NK, NK, NTH, SOUT, SIG(1:NK), ' ', 1., & + 0.0, 0.001, 'Snl(f,t)', ' ', 'NONAME') + CALL PRT2DS (NDST, NK, NK, NTH, DOUT, SIG(1:NK), ' ', 1., & + 0.0, 0.001, 'Diag Snl', ' ', 'NONAME') #endif - ! + ! #ifdef W3_T1 - CALL OUTMAT (NDST, S, NTH, NTH, NK, 'Snl') - CALL OUTMAT (NDST, D, NTH, NTH, NK, 'Diag Snl') + CALL OUTMAT (NDST, S, NTH, NTH, NK, 'Snl') + CALL OUTMAT (NDST, D, NTH, NTH, NK, 'Diag Snl') #endif + ! + ELSE + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR + CALL EXTCDE ( 1 ) + ! + END IF ! RETURN ! - ! Error escape locations - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1 ) - ! ! Format statements ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3SNL2 :'/ & @@ -393,16 +394,13 @@ SUBROUTINE INSNL2 CALL xnl_init ( SIG(1:NK), TH, NK, NTH, NLTAIL, XGRAV, & DPTHNL, NDPTHS, IQTPE, IGRD, IAPROC, IERR ) ! - IF ( IERR .NE. 0 ) GOTO 800 + IF ( IERR .NE. 0 ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR + CALL EXTCDE ( 1 ) + END IF ! RETURN ! - ! Error escape locations - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1 ) - ! ! Format statements ! 1000 FORMAT (/' *** WAVEWATCH III ERROR IN INSNL2 :'/ & diff --git a/model/src/w3snl3md.F90 b/model/src/w3snl3md.F90 index d737cacd0d..517a802bd1 100644 --- a/model/src/w3snl3md.F90 +++ b/model/src/w3snl3md.F90 @@ -38,6 +38,7 @@ MODULE W3SNL3MD !/ 01-Dec-2009 : Bug fix frequency filtering. ( version 3.13 ) !/ 13-Aug-2010 : Move to NL3. ( version 3.15 ) !/ 13-Jul-2012 : Moved from version 3.15 to 4.08. ( version 4.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2008-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -920,7 +921,10 @@ SUBROUTINE INSNL3 ! XFRLN = LOG(XFR) ! - IF ( LAMMAX.LE.0. .OR. LAMMAX.GT.0.5 .OR. DELTHM.LT.0. ) GOTO 800 + IF ( LAMMAX.LE.0. .OR. LAMMAX.GT.0.5 .OR. DELTHM.LT.0. ) THEN + WRITE (NDSE,1000) LAMMAX, DELTHM + CALL EXTCDE ( 1000 ) + END IF ! ! 1.b Set up relative depths ! @@ -971,12 +975,19 @@ SUBROUTINE INSNL3 ! IF ( TH12 .LT. 0. ) THEN IF ( OFF12.LT.0. .OR. OFF12.GT.0.5 .OR. & - OFF34.LT.0. .OR. OFF34.GT.0.5 ) GOTO 801 + OFF34.LT.0. .OR. OFF34.GT.0.5 ) THEN + WRITE (NDSE,1001) OFF12, OFF34 + CALL EXTCDE ( 1001 ) + END IF ELSE IF ( SNLT(IQ).GT.DELTHM .OR. OFF12.LT.0. .OR. & OFF12.GE.1. & .OR. OFF34.LT.MINLAM(OFF12,SNLT(IQ)) .OR. & - OFF34.GT.MAXLAM(OFF12,SNLT(IQ)) ) GOTO 802 + OFF34.GT.MAXLAM(OFF12,SNLT(IQ)) ) THEN + WRITE (NDSE,1002) OFF12, OFF34, SNLT(IQ), & + MINLAM(OFF12,SNLT(IQ)), MAXLAM(OFF12,SNLT(IQ)) + CALL EXTCDE ( 1002 ) + END IF END IF ! #ifdef W3_T1 @@ -1429,38 +1440,19 @@ SUBROUTINE INSNL3 ! QST4 = AST1*NTHEXP + AST2 ! - IF ( NTHMAX .LT. NTHMX2 ) GOTO 810 - IF ( NQA .NE. SIZE(AST1(1,:,1)) ) GOTO 811 + IF ( NTHMAX .LT. NTHMX2 ) THEN + WRITE (NDSE,1010) NTHMAX, NTHMX2 + CALL EXTCDE ( 1010 ) + END IF + IF ( NQA .NE. SIZE(AST1(1,:,1)) ) THEN + WRITE (NDSE,1011) NQA, SIZE(AST1(1,:,1)) + CALL EXTCDE ( 1011 ) + END IF ! DEALLOCATE ( AST1, AST2 ) ! RETURN ! - ! Error escape locations - ! -800 CONTINUE - WRITE (NDSE,1000) LAMMAX, DELTHM - CALL EXTCDE ( 1000 ) - ! -801 CONTINUE - WRITE (NDSE,1001) OFF12, OFF34 - CALL EXTCDE ( 1001 ) - ! -802 CONTINUE - WRITE (NDSE,1002) OFF12, OFF34, SNLT(IQ), & - MINLAM(OFF12,SNLT(IQ)), MAXLAM(OFF12,SNLT(IQ)) - CALL EXTCDE ( 1002 ) - ! -810 CONTINUE - WRITE (NDSE,1010) NTHMAX, NTHMX2 - CALL EXTCDE ( 1010 ) - ! -811 CONTINUE - WRITE (NDSE,1011) NQA, SIZE(AST1(1,:,1)) - CALL EXTCDE ( 1011 ) - ! - RETURN - ! ! Formats ! 1000 FORMAT (/' *** WAVEWATCH-III ERROR IN INSNL3 :'/ & diff --git a/model/src/w3snl4md.F90 b/model/src/w3snl4md.F90 index 012e65ba4e..82e292c671 100644 --- a/model/src/w3snl4md.F90 +++ b/model/src/w3snl4md.F90 @@ -229,6 +229,7 @@ SUBROUTINE INSNL4 !/ +-----------------------------------+ !/ !/ 01-Mar-2016 : Origination. ( version 5.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !! !! it returns: 11 look-up tables arrays dim=(npts,nang,nzz,ndep) @@ -1259,37 +1260,35 @@ SUBROUTINE W3SNL4 ( A, CG, WN, DEPTH, S, D ) !!B This 2nd peak is not suitable for tsa, drop it and stay with just 1st peak. if ( e1max2.lt.0.000001 ) then npeaks = 1 - goto 200 !* skip the remaings tests goto 200 - endif - !! ------------------------------------------------------------ !!op2 - !! ================================================================== - !! - !! - !! - !! - !!op2 ctd - if ( npeaks.eq.2 ) then - !!-1 Shuffle the 2 peaks (if necessary) to keep npk to be always < npk2 - !! This says nothing about which peak is the dominant peak - !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if ( npk2.lt.npk ) then - npk0 = npk2 - npk2 = npk - npk = npk0 !* this way npk < npk2 always - fpk = frqa(npk) - fpk2 = frqa(npk2) - endif - !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + else + !! ------------------------------------------------------------ !!op2 + !! ================================================================== !! - !!-2 here we have 2 peaks (npeaks=2) with npk < npk2 - !! find the freq. separation "nfs" (that divide the freq. regime into 2) - !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - nfs = INT ( (npk+npk2) / 2.0 ) !* take the lower bin # to be nfs - !b nfs = INT ( (npk+npk2+1) / 2.0 ) !* take the higher bin # to be nfs - !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - endif !! if ( npeaks.eq.2 ) - !! -200 continue + !! + !! + !! + !!op2 ctd + if ( npeaks.eq.2 ) then + !!-1 Shuffle the 2 peaks (if necessary) to keep npk to be always < npk2 + !! This says nothing about which peak is the dominant peak + !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + if ( npk2.lt.npk ) then + npk0 = npk2 + npk2 = npk + npk = npk0 !* this way npk < npk2 always + fpk = frqa(npk) + fpk2 = frqa(npk2) + endif + !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + !! + !!-2 here we have 2 peaks (npeaks=2) with npk < npk2 + !! find the freq. separation "nfs" (that divide the freq. regime into 2) + !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + nfs = INT ( (npk+npk2) / 2.0 ) !* take the lower bin # to be nfs + !b nfs = INT ( (npk+npk2+1) / 2.0 ) !* take the higher bin # to be nfs + !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + endif !! if ( npeaks.eq.2 ) + endif !! ------------------------------------------------------------ !!op2 !! ================================================================== !! @@ -1490,6 +1489,7 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) !/ +-----------------------------------+ !/ !/ 01-Mar-2016 : Origination. ( version 5.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !! ------------------------------------------------------------------ !! @@ -1680,8 +1680,7 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) !! irng and iang are k1 parameters; krng and kang are k3 parameters iang = 1 !* set = 1 and will remain = 1 !! - !!20 - do 20 irng=1,nrng + do irng=1,nrng !!kz kmax = min(irng+kzone, nrng) !* Bash; Sometimes a locus pt is outside nrng !kz kmax = min(irng+kzone, nrng-1) !* Bash; Taking 1 out will not affect kzone, try it @@ -1691,21 +1690,19 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) wk1x = wka1(irng) wk1y = 0.0 !* set = 0.0 and will remain = 0.0 iizz = (nrng-1)*(irng-1)-((irng-2)*(irng-1))/2 - !!30 !!kz - do 30 krng=irng,kmax + do krng=irng,kmax !!kz--- - !kz do 30 krng=irng,nrng + !kz do krng=irng,nrng !! !! Bash; check1 - change this ratio from > 4 to > 3 and !! make it consistent with similar test done in subr. snlr_'s - !kz if ( frqa(krng)/frqa(irng) .gt. 2. ) go to 30 !* Bash; use .gt. 2 for speed - !kz if ( frqa(krng)/frqa(irng) .gt. 3. ) go to 30 !* original snlr_'s - !kz if ( frqa(krng)/frqa(irng) .gt. 4. ) go to 30 !* original gridsetr + !kz if ( frqa(krng)/frqa(irng) .gt. 2. ) cycle !* Bash; use .gt. 2 for speed + !kz if ( frqa(krng)/frqa(irng) .gt. 3. ) cycle !* original snlr_'s + !kz if ( frqa(krng)/frqa(irng) .gt. 4. ) cycle !* original gridsetr !!kz--- izz = krng+iizz - !!40 - do 40 kang=1,nang + do kang=1,nang !! wk3x = wka1(krng)*cosan(kang) wk3y = wka1(krng)*sinan(kang) @@ -1714,7 +1711,7 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) !! !!ba1 Bash; skip k1 but keep the opposite angle to k1 - orig setting !!ba1 remember here iang = 1 - if ( kang .eq. 1 ) go to 40 !* th3 = th1 + if ( kang .eq. 1 ) cycle !* th3 = th1 !!ba1--- !! ---------------------------------------------------------- !! -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1742,12 +1739,11 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) !b dif13 = (wk1x-wk3x)**2 + (wk1y-wk3y)**2 !* wk1y = 0.0 !b dif13 = (wk1x-wk3x)**2 + (wk3y)**2 dif13 = (wk1x-wk3x)*(wk1x-wk3x) + wk3y*wk3y - !!50 - do 50 ipt=1,npts + do ipt=1,npts !! !!xlc1 Bash; skip k1 but keep the opposite angle to k1 - original setting if ( kang.eq.1 ) then !* th3=+th1, iang=1 - if (ipt.eq.1 .or. ipt.eq.np2p1) go to 50 !* skip x-axis loci + if (ipt.eq.1 .or. ipt.eq.np2p1) cycle !* skip x-axis loci end if !!xlc1--- !! ---------------------------------------------------------- @@ -1765,11 +1761,11 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) dif14 = (wk1x-wk4x(ipt))*(wk1x-wk4x(ipt)) + & wk4y(ipt)*wk4y(ipt) !! - if ( dif13 .gt. dif14 ) go to 50 !* skip, don't compute + if ( dif13 .gt. dif14 ) cycle !* skip, don't compute !! !b if ( dif13 .gt. dif14 ) then !b Heaviside = 0. !* Eq(12) of RPTV - !b go to 50 + !b cycle !b else !b Heaviside = 1. !* Eq(11) of RPTV !b end if @@ -1929,13 +1925,13 @@ SUBROUTINE gridsetr ( dep, wka1, cgnrng1 ) jref4(ipt,kang,izz) = i !mpc jref4(ipt,kang,izz) = MOD(i,nang) !* is this better that the above two lines? !! -50 end do !* end of ipt loop + end do !* end of ipt loop !! -40 end do !* end of kang loop + end do !* end of kang loop !! -30 end do !* end of krng loop + end do !* end of krng loop !! -20 end do !* end of irng loop + end do !* end of irng loop !! ------------------------------------------------------------------ !! ================================================================== !! @@ -2315,6 +2311,7 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) !/ +-----------------------------------+ !/ !/ 01-Mar-2016 : Origination. ( version 5.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !! ------------------------------------------------------------------ !! @@ -2565,6 +2562,7 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) rnew1 = (t1 + t2 + t3) / (t*t) !! !! + rold = 0.9 !* default if not otherwise found do n=1,4 rold2 = rold1 + 0.1 tp = tanh(rold2 * p) @@ -2576,13 +2574,11 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) rnew2 = (t1 + t2 + t3) / (t*t) if ( rnew2 .lt. rold2 ) then rold = (rold2*rnew1-rold1*rnew2)/(rold2-rold1-rnew2+rnew1) - go to 11 + exit end if rold1 = rold2 rnew1 = rnew2 end do ! do n=1,4 - rold = 0.9 !* default if not otherwise found -11 continue !! ------------------------------------------------------------------ !! !! @@ -2596,14 +2592,13 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) t3 = 2. * qrtp*sqrt(tp*tm)*sqrt(t-qsqp) rnew = (t1 + t2 + t3) / (t*t) if ( abs(rnew-rold) .lt. 0.00001 ) then - rmin = rnew - go to 21 + ierr_gr = ierr_gr - 1 + exit end if rold = 0.5 * (rold + rnew) end do ierr_gr = ierr_gr + 1 !* set 1's flag in ierr_gr if no convergence rmin = rnew -21 continue !! ------------------------------------------------------------------ !! !! set (dimensional) wavenumber components for this point on locus @@ -2666,11 +2661,11 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) rnew = ((t1+rold*t)**2) / t2 if ( rnew .lt. rold ) then rold = rold - 10. - go to 31 + ierr_gr = ierr_gr - 10 + exit end if end do ierr_gr = ierr_gr + 10 !* set 10's place in ierr_gr if no sol'n -31 continue !! ------------------------------------------------------------------ !! !! @@ -2688,10 +2683,9 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) rnew = ((t1+rold*t)**2) / t2 if ( rnew .lt. rold ) then rold = rold - dr - go to 51 + exit end if end do -51 continue end do !! rmax = rold @@ -2774,12 +2768,14 @@ SUBROUTINE shlocr ( dep, wk1x,wk1y, wk3x,wk3y ) !! do n=1,25 cdthnew = dbt4 - dbt5 / ((dtanh(dbt6))**2) - if ( dabs(cdthnew-cdthold) .lt. 0.0000001d0 ) go to 71 + if ( dabs(cdthnew-cdthold) .lt. 0.0000001d0 ) then + ierr_gr = ierr_gr - 100 + exit + end if cdthold = wate1 * cdthnew + wate2 * cdthold dbt6 = dbp * dsqrt(dbt3-2.d0*dbz*cdthold) end do ierr_gr = ierr_gr + 100 !* add to 100's place for every failure -71 continue !! dth = sngl(dacos(cdthnew)) zpod = sngl(dbz) * p / dep @@ -3767,6 +3763,7 @@ SUBROUTINE snlr_fbi ( pha, ialt ) !/ +-----------------------------------+ !/ !/ 01-Mar-2016 : Origination. ( version 5.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !! ------------------------------------------------------------------ !! @@ -4012,8 +4009,7 @@ SUBROUTINE snlr_fbi ( pha, ialt ) !! !! !! - !!50 - do 50 irng=1,nrng,ialt + do irng=1,nrng,ialt !!kz kmax = min(irng+kzone, nrng) !* Bash; Sometimes a locus pt is outside nrng !kz kmax = min(irng+kzone, nrng-1) !* Bash; Taking 1 out will not affect kzone, try it @@ -4023,8 +4019,7 @@ SUBROUTINE snlr_fbi ( pha, ialt ) !! ---------------------------------------------------------------- !! !! - !!60 - do 60 iang=1,nang,ialt + do iang=1,nang,ialt !! !! for both -tsa and -fbi d1 = dens1(irng,iang) @@ -4033,31 +4028,28 @@ SUBROUTINE snlr_fbi ( pha, ialt ) !! for -fbi ddp1 = d1+dp1 !! for full expression of diag2 term !! - !!70 - !!kz - !kz do 70 krng=irng,nrng - do 70 krng=irng,kmax,ialt + !kz do krng=irng,nrng + do krng=irng,kmax,ialt !! !! for both -tsa and -fbi !! Bash; check5 be consistent with gridsetr - !! moved here from below (was after do 80 kang=1,nang) - !! and changed go to 80 into go to 70 (i.e. go to next krng) - !kz if ( frqa(krng)/frqa(irng) .gt. 4. ) go to 70 !* original gridsetr - !kz if ( frqa(krng)/frqa(irng) .gt. 3. ) go to 70 !* original snlr_'s - !kz if ( frqa(krng)/frqa(irng) .gt. 2. ) go to 70 !* Bash; use .gt. 2 + !! moved here from below (was after do kang=1,nang) + !! and changed do iang to do krng) + !kz if ( frqa(krng)/frqa(irng) .gt. 4. ) cycle !* original gridsetr + !kz if ( frqa(krng)/frqa(irng) .gt. 3. ) cycle !* original snlr_'s + !kz if ( frqa(krng)/frqa(irng) .gt. 2. ) cycle !* Bash; use .gt. 2 !!kz--- !! izz = krng + iizz !! ------------------------------------------------------------ !! - !!80 - do 80 kang=1,nang,ialt + do kang=1,nang,ialt !! !! for both -tsa and -fbi !!ba1 Bash; Remove self interaction !! skip k1 but keep the opposite angle to k1 - original setting if ( krng.eq.irng ) then !* wn3 = wn1 - if ( kang.eq.iang ) go to 80 !* th3 = th1 + if ( kang.eq.iang ) cycle !* th3 = th1 endif !!ba1--- !! ---------------------------------------------------------- @@ -4077,9 +4069,9 @@ SUBROUTINE snlr_fbi ( pha, ialt ) !! !! for both -tsa and -fbi !! Bash; check5 be consistent with gridsetr - !! and move this test above right after do 70 krng=irng,nrng - !x if ( frqa(krng)/frqa(irng) .gt. 4. ) go to 80 !* gridsetr - !b if ( frqa(krng)/frqa(irng) .gt. 3. ) go to 80 !* original + !! and move this test above right after do krng=irng,nrng + !x if ( frqa(krng)/frqa(irng) .gt. 4. ) cycle !* gridsetr + !b if ( frqa(krng)/frqa(irng) .gt. 3. ) cycle !* original !! !! !! for both -tsa and -fbi @@ -4103,21 +4095,20 @@ SUBROUTINE snlr_fbi ( pha, ialt ) dsp13 = dp3-dp1 !! ---------------------------------------------------------- !! - !!90 - do 90 ipt=1,npts + do ipt=1,npts !! !! for both -tsa and -fbi !! save time by skipping insignificant contributions !!e-30 - !e-30 if ( grad(ipt,nref,izz) .lt. 1.e-30 ) go to 90 + !e-30 if ( grad(ipt,nref,izz) .lt. 1.e-30 ) cycle !!e-30--- - if ( grad(ipt,nref,izz) .lt. 1.e-15 ) go to 90 + if ( grad(ipt,nref,izz) .lt. 1.e-15 ) cycle !!e-30--- !! -------------------------------------------------------- !! !!xlc1 Bash; skip k1 but keep the opposite angle to k1 - original setting !xlc1 if ( kang.eq.iang ) then !* th3=+th1 - !xlc1 if (ipt.eq.1 .or. ipt.eq.np2p1) go to 90 !* skip x-axis loci + !xlc1 if (ipt.eq.1 .or. ipt.eq.np2p1) cycle !* skip x-axis loci !xlc1 end if !!xlc1--- !! -------------------------------------------------------- @@ -4266,7 +4257,7 @@ SUBROUTINE snlr_fbi ( pha, ialt ) !! ======================================================== !! !! -90 end do !* end of ipt (locus) loop + end do !* end of ipt (locus) loop !! ---------------------------------------------------------- !! !! @@ -4320,13 +4311,13 @@ SUBROUTINE snlr_fbi ( pha, ialt ) diag2(krng,kang) = diag2(krng,kang) - diag2k3*pha(irng) !! ---------------------------------------------------------- !! -80 end do !* end of kang loop + end do !* end of kang loop !! -70 end do !* end of krng loop + end do !* end of krng loop !! -60 end do !* end of iang loop + end do !* end of iang loop !! -50 end do !* end of irng loop + end do !* end of irng loop !!------------------------------------------------------------------------------ !!============================================================================== !! @@ -4400,6 +4391,7 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !/ +-----------------------------------+ !/ !/ 01-Mar-2016 : Origination. ( version 5.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !! ------------------------------------------------------------------ !! @@ -4645,8 +4637,7 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !! !! !! - !!50 - do 50 irng=1,nrng,ialt + do irng=1,nrng,ialt !!kz kmax = min(irng+kzone, nrng) !* Bash; Sometimes a locus pt is outside nrng !kz kmax = min(irng+kzone, nrng-1) !* Bash; Taking 1 out will not affect kzone, try it @@ -4656,8 +4647,7 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !! ---------------------------------------------------------------- !! !! - !!60 - do 60 iang=1,nang,ialt + do iang=1,nang,ialt !! !! for both -tsa and -fbi d1 = dens1(irng,iang) @@ -4666,31 +4656,29 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !! for -fbi !fbi ddp1 = d1+dp1 !! for full expression of diag2 term !! - !!70 !!kz - !kz do 70 krng=irng,nrng - do 70 krng=irng,kmax,ialt + !kz do krng=irng,nrng + do krng=irng,kmax,ialt !! !! for both -tsa and -fbi !! Bash; check5 be consistent with gridsetr - !! moved here from below (was after do 80 kang=1,nang) - !! and changed go to 80 into go to 70 (i.e. go to next krng) - !kz if ( frqa(krng)/frqa(irng) .gt. 4. ) go to 70 !* original gridsetr - !kz if ( frqa(krng)/frqa(irng) .gt. 3. ) go to 70 !* original snlr_'s - !kz if ( frqa(krng)/frqa(irng) .gt. 2. ) go to 70 !* Bash; use .gt. 2 + !! moved here from below (was after do kang=1,nang) + !! and changed do kang into do krng) + !kz if ( frqa(krng)/frqa(irng) .gt. 4. ) cycle !* original gridsetr + !kz if ( frqa(krng)/frqa(irng) .gt. 3. ) cycle !* original snlr_'s + !kz if ( frqa(krng)/frqa(irng) .gt. 2. ) cycle !* Bash; use .gt. 2 !!kz--- !! izz = krng + iizz !! ------------------------------------------------------------ !! - !!80 - do 80 kang=1,nang,ialt + do kang=1,nang,ialt !! !! for both -tsa and -fbi !!ba1 Bash; Remove self interaction !! skip k1 but keep the opposite angle to k1 - original setting if ( krng.eq.irng ) then !* wn3 = wn1 - if ( kang.eq.iang ) go to 80 !* th3 = th1 + if ( kang.eq.iang ) cycle !* th3 = th1 endif !!ba1--- !! ---------------------------------------------------------- @@ -4710,9 +4698,9 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !! !! for both -tsa and -fbi !! Bash; check5 be consistent with gridsetr - !! and move this test above right after do 70 krng=irng,nrng - !x if ( frqa(krng)/frqa(irng) .gt. 4. ) go to 80 !* gridsetr - !b if ( frqa(krng)/frqa(irng) .gt. 3. ) go to 80 !* original + !! and move this test above right after do krng=irng,nrng + !x if ( frqa(krng)/frqa(irng) .gt. 4. ) cycle !* gridsetr + !b if ( frqa(krng)/frqa(irng) .gt. 3. ) cycle !* original !! !! !! for both -tsa and -fbi @@ -4736,21 +4724,20 @@ SUBROUTINE snlr_tsa ( pha, ialt ) dsp13 = dp3-dp1 !! ---------------------------------------------------------- !! - !!90 - do 90 ipt=1,npts + do ipt=1,npts !! !! for both -tsa and -fbi !! save time by skipping insignificant contributions !!e-30 - !e-30 if ( grad(ipt,nref,izz) .lt. 1.e-30 ) go to 90 + !e-30 if ( grad(ipt,nref,izz) .lt. 1.e-30 ) cycle !!e-30--- - if ( grad(ipt,nref,izz) .lt. 1.e-15 ) go to 90 + if ( grad(ipt,nref,izz) .lt. 1.e-15 ) cycle !!e-30--- !! -------------------------------------------------------- !! !!xlc1 Bash; skip k1 but keep the opposite angle to k1 - original setting !xlc1 if ( kang.eq.iang ) then !* th3=+th1 - !xlc1 if (ipt.eq.1 .or. ipt.eq.np2p1) go to 90 !* skip x-axis loci + !xlc1 if (ipt.eq.1 .or. ipt.eq.np2p1) cycle !* skip x-axis loci !xlc1 end if !!xlc1--- !! -------------------------------------------------------- @@ -4899,7 +4886,7 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !! ======================================================== !! !! -90 end do !* end of ipt (locus) loop + end do !* end of ipt (locus) loop !! ---------------------------------------------------------- !! !! @@ -4953,13 +4940,13 @@ SUBROUTINE snlr_tsa ( pha, ialt ) !fbi diag2(krng,kang) = diag2(krng,kang) - diag2k3*pha(irng) !! ---------------------------------------------------------- !! -80 end do !* end of kang loop + end do !* end of kang loop !! -70 end do !* end of krng loop + end do !* end of krng loop !! -60 end do !* end of iang loop + end do !* end of iang loop !! -50 end do !* end of irng loop + end do !* end of irng loop !!------------------------------------------------------------------------------ !!============================================================================== !! @@ -5027,6 +5014,7 @@ SUBROUTINE interp2 ( X ) !/ +-----------------------------------+ !/ !/ 01-Mar-2016 : Origination. ( version 5.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !! !! 1. Purpose : @@ -5156,112 +5144,112 @@ SUBROUTINE interp2 ( X ) !! Skip smoothing only if ismo = 0 !! !! - if ( ismo.eq.0 ) goto 99 - !! - !! - !! - !!-2 Smoothing the 2D array X into array Y - !! - !!-2a Smoothing the interior [2;nrng-1] x [2:nang-1] - !!- Using 9 points averaged with equal weights. - !!- Here use the dummy array so we don't spoil the original array. - do irng=2,nrng-1 + if ( ismo.ne.0 ) then + !! + !! + !! + !!-2 Smoothing the 2D array X into array Y + !! + !!-2a Smoothing the interior [2;nrng-1] x [2:nang-1] + !!- Using 9 points averaged with equal weights. + !!- Here use the dummy array so we don't spoil the original array. + do irng=2,nrng-1 + do iang=2,nang-1 + Y(irng,iang)=(X(irng-1,iang-1)+X(irng-1,iang)+X(irng-1,iang+1) + & + X(irng, iang-1)+X(irng, iang)+X(irng, iang+1) + & + X(irng+1,iang-1)+X(irng+1,iang)+X(irng+1,iang+1))/9. + end do + end do + !! ------------------------------------------------------------------ + !! ================================================================== + !! + !! + !!-3 Smooth first & last line at iang=1 & iang=nang (special cases) + !! + !!-3a Smooth line at iang = 1 (special case) + !!- Using 9 points averaged with equal weights. + do irng=2,nrng-1 + Y(irng, 1) = (X(irng-1,nang) + X(irng-1, 1) + X(irng-1, 2) + & + X(irng, nang) + X(irng, 1) + X(irng, 2) + & + X(irng+1,nang) + X(irng+1, 1) + X(irng+1, 2) )/9. + end do + !! ------------------------------------------------------------------ + !! + !!-3b Smooth line at iang = nang (special case) + !!- Using 9 points averaged with equal weights. + do irng=2,nrng-1 + Y(irng,nang)=(X(irng-1,nang-1) +X(irng-1,nang) +X(irng-1,1) + & + X(irng, nang-1) +X(irng, nang) +X(irng, 1) + & + X(irng+1,nang-1) +X(irng+1,nang) +X(irng+1,1))/9. + end do + !! ------------------------------------------------------------------ + !! ================================================================== + !! + !! + !!-4 Smooth first & last col. at irng=1 & irng=nrng (special cases) + !! + !!-4a Smooth col. at irng = 1 (low frq. can be skipped) + !!- Using 6 points averaged with equal weights. do iang=2,nang-1 - Y(irng,iang)=(X(irng-1,iang-1)+X(irng-1,iang)+X(irng-1,iang+1) + & - X(irng, iang-1)+X(irng, iang)+X(irng, iang+1) + & - X(irng+1,iang-1)+X(irng+1,iang)+X(irng+1,iang+1))/9. + Y(1,iang) = (X(1,iang-1) + X(1,iang) + X(1,iang+1) + & + X(2,iang-1) + X(2,iang) + X(2,iang+1) )/6. end do - end do - !! ------------------------------------------------------------------ - !! ================================================================== - !! - !! - !!-3 Smooth first & last line at iang=1 & iang=nang (special cases) - !! - !!-3a Smooth line at iang = 1 (special case) - !!- Using 9 points averaged with equal weights. - do irng=2,nrng-1 - Y(irng, 1) = (X(irng-1,nang) + X(irng-1, 1) + X(irng-1, 2) + & - X(irng, nang) + X(irng, 1) + X(irng, 2) + & - X(irng+1,nang) + X(irng+1, 1) + X(irng+1, 2) )/9. - end do - !! ------------------------------------------------------------------ - !! - !!-3b Smooth line at iang = nang (special case) - !!- Using 9 points averaged with equal weights. - do irng=2,nrng-1 - Y(irng,nang)=(X(irng-1,nang-1) +X(irng-1,nang) +X(irng-1,1) + & - X(irng, nang-1) +X(irng, nang) +X(irng, 1) + & - X(irng+1,nang-1) +X(irng+1,nang) +X(irng+1,1))/9. - end do - !! ------------------------------------------------------------------ - !! ================================================================== - !! - !! - !!-4 Smooth first & last col. at irng=1 & irng=nrng (special cases) - !! - !!-4a Smooth col. at irng = 1 (low frq. can be skipped) - !!- Using 6 points averaged with equal weights. - do iang=2,nang-1 - Y(1,iang) = (X(1,iang-1) + X(1,iang) + X(1,iang+1) + & - X(2,iang-1) + X(2,iang) + X(2,iang+1) )/6. - end do - !! ------------------------------------------------------------------ - !! - !!-4b Smooth col. at irng = nrng (high frq. can be skipped) - !!- Using 6 points averaged with equal weights. - do iang=2,nang-1 - Y(nrng,iang)=(X(nrng-1,iang-1)+X(nrng-1,iang)+X(nrng-1,iang+1)+ & - X(nrng, iang-1)+X(nrng, iang)+X(nrng, iang+1) )/6. - end do - !! ------------------------------------------------------------------ - !! ================================================================== - !! - !! - !!-5 Smooth the 4 corners (optional): <== Skip no sig. effect - !!- Using 6 points averaged with equal weights - !! - !!-5a Corner (1, 1) - Y(1, 1) =( X(1,nang) + X(1, 1) + X(1, 2) + & - X(2,nang) + X(2, 1) + X(2, 2) )/6.0 - !! ------------------------------------------------------------------ - !! - !!-5b Corner (nrng,1) - Y(nrng,1) =( X(nrng-1,nang) + X(nrng-1,1) + X(nrng-1,2) + & - X(nrng, nang) + X(nrng, 1) + X(nrng, 2) )/6.0 - !! ------------------------------------------------------------------ - !! - !!-5c Corner (1,nang) - Y(1,nang) =( X(1,nang-1) + X(1,nang) + X(1, 1) + & - X(2,nang-1) + X(2,nang) + X(2, 1) ) / 6. - !! ------------------------------------------------------------------ - !! - !!-5d Corner (nrng,nang) - Y(nrng,nang) =( X(nrng-1,nang-1) +X(nrng-1,nang) +X(nrng-1,1) + & - X(nrng, nang-1) +X(nrng, nang) +X(nrng, 1) )/6. - !! ------------------------------------------------------------------ - !! ================================================================== - !! - !! - !!-6 Final, dump smoothed array Y(:,:) into X(:,:) to be returned - !! - !!-6a Done with X(:,:) re-initial before it's replaced by Y(:,:) - !!ini - X(:,:) = 0.0 - !!ini--- - !! - !!-6b Dump smoothed array Y(:,:) into X(:,:) to be returned - do iang=1,nang - do irng=1,nrng - X(irng,iang) = Y(irng,iang) + !! ------------------------------------------------------------------ + !! + !!-4b Smooth col. at irng = nrng (high frq. can be skipped) + !!- Using 6 points averaged with equal weights. + do iang=2,nang-1 + Y(nrng,iang)=(X(nrng-1,iang-1)+X(nrng-1,iang)+X(nrng-1,iang+1)+ & + X(nrng, iang-1)+X(nrng, iang)+X(nrng, iang+1) )/6. end do - end do - !! Bash; can simplify in one line - !b X(1:nrng, 1:nang) = Y(1:nrng, 1:nang) - !! ------------------------------------------------------------------ - !! ================================================================== - !! -99 continue + !! ------------------------------------------------------------------ + !! ================================================================== + !! + !! + !!-5 Smooth the 4 corners (optional): <== Skip no sig. effect + !!- Using 6 points averaged with equal weights + !! + !!-5a Corner (1, 1) + Y(1, 1) =( X(1,nang) + X(1, 1) + X(1, 2) + & + X(2,nang) + X(2, 1) + X(2, 2) )/6.0 + !! ------------------------------------------------------------------ + !! + !!-5b Corner (nrng,1) + Y(nrng,1) =( X(nrng-1,nang) + X(nrng-1,1) + X(nrng-1,2) + & + X(nrng, nang) + X(nrng, 1) + X(nrng, 2) )/6.0 + !! ------------------------------------------------------------------ + !! + !!-5c Corner (1,nang) + Y(1,nang) =( X(1,nang-1) + X(1,nang) + X(1, 1) + & + X(2,nang-1) + X(2,nang) + X(2, 1) ) / 6. + !! ------------------------------------------------------------------ + !! + !!-5d Corner (nrng,nang) + Y(nrng,nang) =( X(nrng-1,nang-1) +X(nrng-1,nang) +X(nrng-1,1) + & + X(nrng, nang-1) +X(nrng, nang) +X(nrng, 1) )/6. + !! ------------------------------------------------------------------ + !! ================================================================== + !! + !! + !!-6 Final, dump smoothed array Y(:,:) into X(:,:) to be returned + !! + !!-6a Done with X(:,:) re-initial before it's replaced by Y(:,:) + !!ini + X(:,:) = 0.0 + !!ini--- + !! + !!-6b Dump smoothed array Y(:,:) into X(:,:) to be returned + do iang=1,nang + do irng=1,nrng + X(irng,iang) = Y(irng,iang) + end do + end do + !! Bash; can simplify in one line + !b X(1:nrng, 1:nang) = Y(1:nrng, 1:nang) + !! ------------------------------------------------------------------ + !! ================================================================== + !! + end if !! ------------------------------------------------------------------ !! ================================================================== !! diff --git a/model/src/w3snl5md.F90 b/model/src/w3snl5md.F90 index e486913785..35b41df092 100644 --- a/model/src/w3snl5md.F90 +++ b/model/src/w3snl5md.F90 @@ -191,7 +191,6 @@ SUBROUTINE W3SNL5(A, CG, WN, FMEAN, T1ABS, U10, UDIR, JSEA, & IAPROC, NAPOUT, SCREEN USE W3PARALL, ONLY: INIT_GET_ISEA USE W3TIMEMD, ONLY: DSEC21 - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -488,7 +487,6 @@ SUBROUTINE INSNL5 QR5DPT, QR5OML, QI5DIS, QI5KEV, QI5NNZ, & QI5IPL, QI5PMX USE W3ODATMD, ONLY: IAPROC, NAPOUT, SCREEN - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3snlsmd.F90 b/model/src/w3snlsmd.F90 index df78017939..d661f63bef 100644 --- a/model/src/w3snlsmd.F90 +++ b/model/src/w3snlsmd.F90 @@ -673,6 +673,7 @@ SUBROUTINE INSNLS !/ +-----------------------------------+ !/ !/ 04-Aug-2008 : Origination. ( version 3.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -823,7 +824,10 @@ SUBROUTINE INSNLS #endif ! IF ( A34.GT.ABMAX .OR. B3.GT.ABMAX .OR. B4.GT.ABMAX .OR. & - A34.LT.0. .OR. B3.LT.0. .OR. B4.LT.0. ) GOTO 801 + A34.LT.0. .OR. B3.LT.0. .OR. B4.LT.0. ) THEN + WRITE (NDSE,1001) A34, B3, B4 + CALL EXTCDE (1001) + END IF ! ! 2.d Store weights ! @@ -840,12 +844,6 @@ SUBROUTINE INSNLS ! RETURN ! - ! Error escape locations - ! -801 CONTINUE - WRITE (NDSE,1001) A34, B3, B4 - CALL EXTCDE (1001) - ! ! Formats ! 1001 FORMAT (/' *** WAVEWATCH-III ERROR IN INSNLS :'/ & diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index 0d20f9e29f..4656a1678c 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -1065,7 +1065,6 @@ SUBROUTINE INSIN4(FLTABS) !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: TPIINV, RADE, GRAV USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE USE W3DISPMD, ONLY: WAVNU2 USE W3GDATMD, ONLY: SIG, DSIP, NK, NTH, TTAUWSHELTER, & SSDSDTH, SSDSCOS, TH, DTH, XFR, ECOS, ESIN, & @@ -1604,6 +1603,7 @@ SUBROUTINE TABU_TAUHF2(SIGMAX) !/ !/ 15-May-2007 : Origination in WW3 ( version 3.10.SHOM ) !/ 24-Jan-2013 : Allows to read in table ( version 4.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) ! ! 1. Purpose : ! @@ -1728,91 +1728,98 @@ SUBROUTINE TABU_TAUHF2(SIGMAX) DELTAIL = ALPHAM/REAL(ILEVTAIL) CONST1 = BBETA/KAPPA**2 OMEGAC = SIGMAX -800 CONTINUE - IF ( NOFILE ) THEN - WRITE(NDSE,*) 'Filling 3D look-up table for SIN4. please wait' - WRITE(NDSE,*) IDSTR, VERGRD, SIGMAX, AALPHA, BBETA, IUSTAR, IALPHA, & - ILEVTAIL, ZZALP, KAPPA, GRAV - ! - TAUHFT(0:IUSTAR,0:IALPHA)=0. !table initialization - ! - ALLOCATE(W(JTOT)) - W(2:JTOT-1)=1. - W(1)=0.5 - W(JTOT)=0.5 - X0 = 0.05 - ! - DO K=0,IUSTAR - UST0 = MAX(REAL(K)*DELUST,0.000001) - DO L=0,IALPHA - UST=UST0 - ZZ0 = UST0**2*(AALPHA+FLOAT(L)*DELALP)/GRAV - OMEGACC = MAX(OMEGAC,X0*GRAV/UST) - YC = OMEGACC*SQRT(ZZ0/GRAV) - DELY = MAX((1.-YC)/REAL(JTOT),0.) - ! For a given value of UST and ALPHA, - ! the wave-supported stress is integrated all the way - ! to 0.05*g/UST - DO I=0,ILEVTAIL - LEVTAIL=REAL(I)*DELTAIL - TAUHFT(K,L)=0. - TAUHFT2(K,L,I)=0. - TAUW0=UST0**2 - TAUW=TAUW0 - DO J=1,JTOT - Y = YC+REAL(J-1)*DELY - OMEGA = Y*SQRT(GRAV/ZZ0) - ! This is the deep water phase speed - CM = GRAV/OMEGA - !this is the inverse wave age, shifted by ZZALP (tuning) - ZX = UST0/CM +ZZALP - ZARG = MIN(KAPPA/ZX,20.) - ZMU = MIN(GRAV*ZZ0/CM**2*EXP(ZARG),1.) - ZLOG = MIN(ALOG(ZMU),0.) - ZBETA = CONST1*ZMU*ZLOG**4 - ! Power of Y in denominator should be FACHFE-4 - TAUHFT(K,L) = TAUHFT(K,L)+W(J)*ZBETA/Y*DELY - ZX = UST/CM +ZZALP - ZARG = MIN(KAPPA/ZX,20.) - ZMU = MIN(GRAV*ZZ0/CM**2*EXP(ZARG),1.) - ZLOG = MIN(ALOG(ZMU),0.) - ZBETA = CONST1*ZMU*ZLOG**4 - ! Power of Y in denominator should be FACHFE-4 - TAUHFT2(K,L,I) = TAUHFT2(K,L,I)+W(J)*ZBETA*(UST/UST0)**2/Y*DELY - TAUW=TAUW-W(J)*UST**2*ZBETA*LEVTAIL/Y*DELY - UST=SQRT(MAX(TAUW,0.)) - END DO + DO + IF ( NOFILE ) THEN + WRITE(NDSE,*) 'Filling 3D look-up table for SIN4. please wait' + WRITE(NDSE,*) IDSTR, VERGRD, SIGMAX, AALPHA, BBETA, IUSTAR, IALPHA, & + ILEVTAIL, ZZALP, KAPPA, GRAV + ! + TAUHFT(0:IUSTAR,0:IALPHA)=0. !table initialization + ! + ALLOCATE(W(JTOT)) + W(2:JTOT-1)=1. + W(1)=0.5 + W(JTOT)=0.5 + X0 = 0.05 + ! + DO K=0,IUSTAR + UST0 = MAX(REAL(K)*DELUST,0.000001) + DO L=0,IALPHA + UST=UST0 + ZZ0 = UST0**2*(AALPHA+FLOAT(L)*DELALP)/GRAV + OMEGACC = MAX(OMEGAC,X0*GRAV/UST) + YC = OMEGACC*SQRT(ZZ0/GRAV) + DELY = MAX((1.-YC)/REAL(JTOT),0.) + ! For a given value of UST and ALPHA, + ! the wave-supported stress is integrated all the way + ! to 0.05*g/UST + DO I=0,ILEVTAIL + LEVTAIL=REAL(I)*DELTAIL + TAUHFT(K,L)=0. + TAUHFT2(K,L,I)=0. + TAUW0=UST0**2 + TAUW=TAUW0 + DO J=1,JTOT + Y = YC+REAL(J-1)*DELY + OMEGA = Y*SQRT(GRAV/ZZ0) + ! This is the deep water phase speed + CM = GRAV/OMEGA + !this is the inverse wave age, shifted by ZZALP (tuning) + ZX = UST0/CM +ZZALP + ZARG = MIN(KAPPA/ZX,20.) + ZMU = MIN(GRAV*ZZ0/CM**2*EXP(ZARG),1.) + ZLOG = MIN(ALOG(ZMU),0.) + ZBETA = CONST1*ZMU*ZLOG**4 + ! Power of Y in denominator should be FACHFE-4 + TAUHFT(K,L) = TAUHFT(K,L)+W(J)*ZBETA/Y*DELY + ZX = UST/CM +ZZALP + ZARG = MIN(KAPPA/ZX,20.) + ZMU = MIN(GRAV*ZZ0/CM**2*EXP(ZARG),1.) + ZLOG = MIN(ALOG(ZMU),0.) + ZBETA = CONST1*ZMU*ZLOG**4 + ! Power of Y in denominator should be FACHFE-4 + TAUHFT2(K,L,I) = TAUHFT2(K,L,I)+W(J)*ZBETA*(UST/UST0)**2/Y*DELY + TAUW=TAUW-W(J)*UST**2*ZBETA*LEVTAIL/Y*DELY + UST=SQRT(MAX(TAUW,0.)) + END DO #ifdef W3_T - WRITE (NDST,9000) K,L,I,UST0,AALPHA+FLOAT(L)*DELALP,LEVTAIL,TAUHFT2(K,L,I) + WRITE (NDST,9000) K,L,I,UST0,AALPHA+FLOAT(L)*DELALP,LEVTAIL,TAUHFT2(K,L,I) #endif + END DO END DO END DO - END DO - DEALLOCATE(W) - OPEN (993,FILE=FNAMETAB,form='UNFORMATTED', convert=file_endian,IOSTAT=IERR,STATUS='UNKNOWN') - WRITE(993) IDSTR, VERGRD, SIGMAX, AALPHA, BBETA, IUSTAR, IALPHA, ILEVTAIL, ZZALP, KAPPA, GRAV - WRITE(993) TAUHFT(0:IUSTAR,0:IALPHA) - WRITE(993) TAUHFT2 - CLOSE(993) - !DO K=0,IUSTAR - ! DO L=0,IALPHA - ! DO I=0,ILEVTAIL - ! WRITE(995,*) K,L,I,MAX(REAL(K)*DELUST,0.000001),AALPHA+FLOAT(L)*DELALP,REAL(I)*DELTAIL,TAUHFT(K,L),TAUHFT2(K,L,I) - ! END DO - ! END DO - ! END DO + DEALLOCATE(W) + OPEN (993,FILE=FNAMETAB,form='UNFORMATTED', convert=file_endian,IOSTAT=IERR,STATUS='UNKNOWN') + WRITE(993) IDSTR, VERGRD, SIGMAX, AALPHA, BBETA, IUSTAR, IALPHA, ILEVTAIL, ZZALP, KAPPA, GRAV + WRITE(993) TAUHFT(0:IUSTAR,0:IALPHA) + WRITE(993) TAUHFT2 + CLOSE(993) + !DO K=0,IUSTAR + ! DO L=0,IALPHA + ! DO I=0,ILEVTAIL + ! WRITE(995,*) K,L,I,MAX(REAL(K)*DELUST,0.000001),AALPHA+FLOAT(L)*DELALP,REAL(I)*DELTAIL,TAUHFT(K,L),TAUHFT2(K,L,I) + ! END DO + ! END DO + ! END DO + ! + ELSE + WRITE(NDSE,*) 'Reading 3D look-up table for SIN4 from file.' + READ(993,IOSTAT=IERR ) TAUHFT(0:IUSTAR,0:IALPHA) + IF (IERR .GT. 0) THEN + NOFILE=.TRUE. + CYCLE + END IF + READ(993,IOSTAT=IERR ) TAUHFT2 + IF (IERR .GT. 0) THEN + NOFILE=.TRUE. + CYCLE + END IF + CLOSE(993) + END IF ! - ELSE - WRITE(NDSE,*) 'Reading 3D look-up table for SIN4 from file.' - READ(993,ERR=2000,IOSTAT=IERR ) TAUHFT(0:IUSTAR,0:IALPHA) - READ(993,ERR=2000,IOSTAT=IERR ) TAUHFT2 - CLOSE(993) - END IF + EXIT + END DO ! - GOTO 2001 -2000 NOFILE=.TRUE. - GOTO 800 -2001 CONTINUE RETURN #ifdef W3_T 9000 FORMAT (' TEST TABU_HFT2, K, L, I, UST, ALPHA, LEVTAIL, TAUHFT2(K,L,I) :',(3I4,4F10.5)) diff --git a/model/src/w3src6md.F90 b/model/src/w3src6md.F90 index 354d425cd8..73481adf94 100644 --- a/model/src/w3src6md.F90 +++ b/model/src/w3src6md.F90 @@ -187,7 +187,6 @@ SUBROUTINE W3SPR6 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX, FP) USE CONSTANTS, ONLY: TPIINV USE W3GDATMD, ONLY: NK, NTH, SIG, DTH, DDEN, FTE, FTF, FTWN, DSII USE W3ODATMD, ONLY: NDST, NDSE - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -378,7 +377,6 @@ SUBROUTINE W3SIN6 (A, CG, WN2, UABS, USTAR, USDIR, CD, DAIR, & USE W3GDATMD, ONLY: NK, NTH, NSPEC, DTH, SIG2, DDEN2 USE W3GDATMD, ONLY: ECOS, ESIN, SIN6A0, SIN6WS USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -626,7 +624,6 @@ SUBROUTINE W3SDS6 (A, CG, WN, S, D) USE W3GDATMD, ONLY: NK, NTH, NSPEC, DDEN, DSII, SIG2, DTH, XFR USE W3GDATMD, ONLY: SDS6A1, SDS6A2, SDS6P1, SDS6P2, SDS6ET USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_T6 USE W3TIMEMD, ONLY: STME21 USE W3WDATMD, ONLY: TIME diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index beb3e13d5b..f76569cfa4 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -265,6 +265,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & !/ 22-Mar-2021 : Add extra fields used in coupling ( version 7.13 ) !/ 07-Jun-2021 : S_{nl5} GKE NL5 (Q. Liu) ( version 7.13 ) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -636,7 +637,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & USE W3SERVMD, ONLY: STRACE #endif #ifdef W3_NNT - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTOPN, EXTIOF #endif #ifdef W3_UOST USE W3UOSTMD, ONLY: UOST_SRCTRMCOMPUTE @@ -1162,11 +1163,15 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & J = LEN_TRIM(FNMPRE) WRITE (FNAME(11:13),'(I3.3)') IAPROC OPEN (NDSD,FILE=FNMPRE(:J)//FNAME,form='UNFORMATTED', convert=file_endian, & - ERR=800,IOSTAT=IERR) - WRITE (NDSD,ERR=801,IOSTAT=IERR) NK, NTH - WRITE (NDSD,ERR=801,IOSTAT=IERR) SIG(1:NK) * TPIINV + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3SRCE','',1,NAMEF=FNAME) + WRITE (NDSD,IOSTAT=IERR) NK, NTH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SRC','',2,ISWRITE=.TRUE.) + WRITE (NDSD,IOSTAT=IERR) SIG(1:NK) * TPIINV + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SRC','',2,ISWRITE=.TRUE.) OPEN (NDSD2,FILE=FNMPRE(:J)//'time.ww3', & - FORM='FORMATTED',ERR=800,IOSTAT=IERR) + FORM='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3SRCE','',1,NAMEF='time.ww3') END IF #endif ! @@ -1360,8 +1365,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & WRITE (SCREEN,8888) TIME, DTTOT, FLAGNN, QCERR WRITE (NDSD2,8888) TIME, DTTOT, FLAGNN, QCERR 8888 FORMAT (1X,I8.8,1X,I6.6,F8.1,L2,F8.2) - WRITE (NDSD,ERR=801,IOSTAT=IERR) IX, IY, TIME, NSTEPS, & + WRITE (NDSD,IOSTAT=IERR) IX, IY, TIME, NSTEPS, & DTTOT, FLAGNN, DEPTH, U10ABS, U10DIR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SRC','',2,ISWRITE=.TRUE.) ! IF ( FLAGNN ) THEN DO IK=1, NK @@ -1373,9 +1379,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & DOUT(IK,ITH) = VDNL(IS) END DO END DO - WRITE (NDSD,ERR=801,IOSTAT=IERR) FOUT - WRITE (NDSD,ERR=801,IOSTAT=IERR) SOUT - WRITE (NDSD,ERR=801,IOSTAT=IERR) DOUT + WRITE (NDSD,IOSTAT=IERR) FOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SRC','',2,ISWRITE=.TRUE.) + WRITE (NDSD,IOSTAT=IERR) SOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SRC','',2,ISWRITE=.TRUE.) + WRITE (NDSD,IOSTAT=IERR) DOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SRC','',2,ISWRITE=.TRUE.) END IF #endif ! @@ -2010,22 +2019,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! DTDYN = DTDYN / REAL(MAX(1,NSTEPS)) FCUT = FHIGH * TPIINV - ! - GOTO 888 - ! - ! Error escape locations - ! -#ifdef W3_NNT -800 CONTINUE - WRITE (NDSE,8000) FNAME, IERR - CALL EXTCDE (1) - ! -801 CONTINUE - WRITE (NDSE,8001) IERR - CALL EXTCDE (2) -#endif - ! -888 CONTINUE ! ! 9.a Computes PHIOC------------------------------------------ * ! The wave to ocean flux is the difference between initial energy @@ -2333,13 +2326,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! ! Formats ! -#ifdef W3_NNT -8000 FORMAT (/' *** ERROR W3SRCE : ERROR IN OPENING FILE ',A,' ***'/ & - ' IOSTAT = ',I10/) -8001 FORMAT (/' *** ERROR W3SRCE : ERROR IN WRITING TO FILE ***'/ & - ' IOSTAT = ',I10/) -#endif - ! #ifdef W3_T 9000 FORMAT (' TEST W3SRCE : COUNTERS : NO LONGER AVAILABLE') 9001 FORMAT (' TEST W3SRCE : DEPTH :',F8.1/ & diff --git a/model/src/w3str1md.F90 b/model/src/w3str1md.F90 index ce14b6b365..cdcd798f21 100644 --- a/model/src/w3str1md.F90 +++ b/model/src/w3str1md.F90 @@ -309,7 +309,6 @@ SUBROUTINE W3STR1 (A, CG, WN, DEPTH, IX, S, D) USE CONSTANTS, ONLY: GRAV, PI, TPI USE W3GDATMD, ONLY: NK, NTH, NSPEC, DTH, SIG, DDEN, FTE, FTF USE W3ODATMD, ONLY: NDSE - USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3strkmd.F90 b/model/src/w3strkmd.F90 index a776a36bb9..e4a887e4cc 100644 --- a/model/src/w3strkmd.F90 +++ b/model/src/w3strkmd.F90 @@ -308,12 +308,15 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & !/ 03-Feb-2012 : Origination, based on Matlab code ( version 4.05 ) !/ by Jeff Hanson & Eve-Marie Devaliere !/ 04-Jan-2013 : Inclusion in trunk ( version 4.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 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. !/ + USE W3SERVMD, ONLY: EXTIOF + IMPLICIT NONE #ifdef W3_MPI @@ -430,6 +433,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & REAL :: dx INTEGER :: latind1, latind2, lonind1, lonind2 REAL :: lonext, latext + LOGICAL :: endloop #ifdef W3_MPI INTEGER :: rank, irank, nproc, EXTENT, DOMSIZE, tag1, tag2 @@ -511,15 +515,16 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & OPEN(unit=11,file=filename,status='old') line = 1 DO WHILE (.TRUE.) - READ (11, *, END=113) dummyc,llat(line),llon(line), & + READ (11, *, IOSTAT=IOERR) dummyc,llat(line),llon(line), & ts(line),hs0(line),tp0(line),dir0(line), & wndSpd0(line),wndDir0(line),invar7 + IF (IOERR.LT.0) EXIT !partRes file does not contain the dspr variable dspr0(line) = 9999. ! wf0(line) = 9999. line = line+1 ENDDO -113 IERR = -1 + IERR = -1 CLOSE(11) line = line-1 WRITE(6,*) '... finished' @@ -543,7 +548,8 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & !/ Test unformatted read !/ ------------------------------------------------- OPEN(UNIT=11,FILE=FILENAME,form='UNFORMATTED', convert=file_endian,STATUS='OLD',ACCESS='STREAM') - READ(11,ERR=802,IOSTAT=IOERR) I + READ(11,IOSTAT=IOERR) I + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) CLOSE(11) !/ --- First four-byte integer could possibly be byte-swapped, ! if ww3_shel was compiled on a different architecture. --- @@ -576,9 +582,12 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & status='OLD') ENDIF REWIND(11) - READ(11,ERR=802,IOSTAT=IOERR) IDSTR,VERPRT - READ(11,ERR=802,IOSTAT=IOERR) headln1 - READ(11,ERR=802,IOSTAT=IOERR) headln2 + READ(11,IOSTAT=IOERR) IDSTR,VERPRT + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) + READ(11,IOSTAT=IOERR) headln1 + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) + READ(11,IOSTAT=IOERR) headln2 + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) END IF !/ IF (IDSTR(1:9).ne.'WAVEWATCH') THEN @@ -592,18 +601,28 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & !/ ------------------------------------------------- skipln = 3 ttest = 0 - DO WHILE (ttest.LT.tstart) + loop = .true. + endloop = .false. + DO WHILE (ttest.LT.tstart .AND.loop) IF (FLFORM) THEN - READ (11,1000,ERR=802,END=112) date1,date2,x,y, & + READ (11,1000,IOSTAT=IOERR) date1,date2,x,y, & numpart,wnd,wnddir,invar6,invar7 + IF (IOERR.LT.0) THEN + loop = .false. + endloop = .true. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF #ifdef W3_del write(*,*) '0:',x,y,numpart #endif skipln = skipln+1 ELSE - READ (11,ERR=802,IOSTAT=IOERR) DATETIME,x,y, & + READ (11,IOSTAT=IOERR) DATETIME,x,y, & dummy,numpart,invar1,wnd,wnddir, & invar5,invar6 + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) ! write(*,*) '0:',DATETIME,numpart date1=dble(DATETIME(1)) date2=dble(DATETIME(2)) @@ -611,223 +630,306 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ttest = date1 + date2*1.0E-6 IF (FLFORM) THEN DO line = 1,numpart+1 - READ(11,1010,END=111,ERR=802,IOSTAT=IOERR) & + READ(11,1010,IOSTAT=IOERR) & invar1,invar2,invar3,invar4 + IF (IOERR.LT.0) THEN + loop = .false. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF ! write(*,*) '0+:',line,numpart+1,invar1,invar2,invar3,invar4 skipln = skipln+1 END DO ELSE DO line = 1,numpart+1 - READ (11,ERR=802,IOSTAT=IOERR) iline,invar1, & + READ (11,IOSTAT=IOERR) iline,invar1, & invar2,invar3,invar4,invar5,invar6 + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) ! write(*,*) '0+:',line,iline,invar1,invar2,invar3,invar4,invar5,invar6 END DO END IF END DO - skipln = skipln-numpart-1-1 - !/ ------------------------------------------------- - ! Read file for ntint time levels - !/ ------------------------------------------------- - readln = numpart - tstep = 1 - ttemp = tstart - maxPart = numpart - DO WHILE (tstep.LE.ntint) - IF (readln.GT.0) THEN - IF (FLFORM) THEN - READ (11,1000,ERR=802,END=111) date1,date2,x,y, & - numpart,wnd,wnddir,invar6,invar7 - ELSE - READ (11,END=111,ERR=802,IOSTAT=IOERR) DATETIME, & - x,y,dummy,numpart,wnd,wnddir,invar5,invar6,invar7 - ! write(*,*) '1:',numpart,x,y - date1=dble(DATETIME(1)) - date2=dble(DATETIME(2)) + IF (loop) THEN + skipln = skipln-numpart-1-1 + !/ ------------------------------------------------- + ! Read file for ntint time levels + !/ ------------------------------------------------- + readln = numpart + tstep = 1 + ttemp = tstart + maxPart = numpart + DO WHILE (tstep.LE.ntint) + IF (readln.GT.0) THEN + IF (FLFORM) THEN + READ (11,1000,IOSTAT=IOERR) date1,date2,x,y, & + numpart,wnd,wnddir,invar6,invar7 + ELSE + READ (11,IOSTAT=IOERR) DATETIME, & + x,y,dummy,numpart,wnd,wnddir,invar5,invar6,invar7 + END IF + IF (IOERR.LT.0) EXIT + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + IF (.NOT.FLFORM) THEN + ! write(*,*) '1:',numpart,x,y + date1=dble(DATETIME(1)) + date2=dble(DATETIME(2)) + END IF + maxPart = MAX(maxPart,numpart) END IF - maxPart = MAX(maxPart,numpart) - END IF - ttest = date1 + date2*1.E-6 - IF (ttest.GT.ttemp) THEN - tstep = tstep+1 - ttemp = ttest - IF (tstep.GT.ntint) EXIT - END IF - IF (FLFORM) THEN - DO line = 1,numpart+1 - READ (11,1010,END=111,ERR=802,IOSTAT=IOERR) & - invar1,invar2,invar3,invar4 + ttest = date1 + date2*1.E-6 + IF (ttest.GT.ttemp) THEN + tstep = tstep+1 + ttemp = ttest + IF (tstep.GT.ntint) EXIT + END IF + IF (FLFORM) THEN + DO line = 1,numpart+1 + READ (11,1010,IOSTAT=IOERR) invar1,invar2,invar3,invar4 + IF (IOERR.LT.0) THEN + loop = .false. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF #ifdef W3_del - write(*,'(A,2I6,4F7.2)') '1+:',line,numpart+1,invar1,invar2,invar3,invar4 + write(*,'(A,2I6,4F7.2)') '1+:',line,numpart+1,invar1, & + invar2,invar3,invar4 #endif - readln = readln+1 - END DO - ELSE - DO line = 1,numpart+1 - READ (11,END=111,ERR=802,IOSTAT=IOERR) iline,invar1,& - invar2,invar3,invar4,invar5,invar6 - readln = readln+1 - END DO - END IF - ENDDO -111 CONTINUE - CLOSE(11) - ! ===== END COUNT LOOP ===== - ! ===== START READ LOOP ===== - ALLOCATE(ts(readln)) - ALLOCATE(llat(readln)) - ALLOCATE(llon(readln)) - ALLOCATE(hs0(readln)) - ALLOCATE(tp0(readln)) - ALLOCATE(dir0(readln)) - ALLOCATE(dspr0(readln)) - ! ALLOCATE(wf0(readln)) - ALLOCATE(wndSpd0(readln)) - ALLOCATE(wndDir0(readln)) - ALLOCATE(date0(readln)) - ts(1:readln) = -1 - llat(1:readln) = 9999. - llon(1:readln) = 9999. - hs0(1:readln) = 9999. - tp0(1:readln) = 9999. - dir0(1:readln) = 9999. - dspr0(1:readln) = 9999. + readln = readln+1 + END DO + ELSE + DO line = 1,numpart+1 + READ (11,IOSTAT=IOERR) iline,invar1,& + invar2,invar3,invar4,invar5,invar6 + IF (IOERR.LT.0) THEN + loop = .false. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF + readln = readln+1 + END DO + END IF + IF (.NOT.loop) EXIT + ENDDO + END IF ! loop + ! + IF (.NOT.endloop) THEN + CLOSE(11) + ! ===== END COUNT LOOP ===== + ! ===== START READ LOOP ===== + ALLOCATE(ts(readln)) + ALLOCATE(llat(readln)) + ALLOCATE(llon(readln)) + ALLOCATE(hs0(readln)) + ALLOCATE(tp0(readln)) + ALLOCATE(dir0(readln)) + ALLOCATE(dspr0(readln)) + ! ALLOCATE(wf0(readln)) + ALLOCATE(wndSpd0(readln)) + ALLOCATE(wndDir0(readln)) + ALLOCATE(date0(readln)) + ts(1:readln) = -1 + llat(1:readln) = 9999. + llon(1:readln) = 9999. + hs0(1:readln) = 9999. + tp0(1:readln) = 9999. + dir0(1:readln) = 9999. + dspr0(1:readln) = 9999. - IF (FLFORM) THEN - OPEN(unit=11,file=filename,status='old') - ELSE - OPEN(unit=11,file=filename,status='old', & - form='unformatted', convert=file_endian) - END IF - line = 1 - tstep = 1 - !/ ------------------------------------------------- - !/ Skip to start time - !/ ------------------------------------------------- - IF (FLFORM) THEN - DO i = 1,skipln - READ (11, *) - END DO - ELSE - ! --- Repeat from above since access='DIRECT' - ! does not support fseek and ftell. --- - READ(11,END=112,ERR=802,IOSTAT=IOERR) IDSTR,VERPRT - READ(11,END=112,ERR=802,IOSTAT=IOERR) headln1 - READ(11,END=112,ERR=802,IOSTAT=IOERR) headln2 - !/ --- allocate buffer for all partition parameters - !/ for a single grid point --- - IF (.NOT.ALLOCATED(PHS)) ALLOCATE(PHS(maxPart)) - IF (.NOT.ALLOCATED(PTP)) ALLOCATE(PTP(maxPart)) - IF (.NOT.ALLOCATED(PDIR)) ALLOCATE(PDIR(maxPart)) - IF (.NOT.ALLOCATED(PSPR)) ALLOCATE(PSPR(maxPart)) - IF (.NOT.ALLOCATED(PWF)) ALLOCATE(PWF(maxPart)) - - ttest = 0 - - DO WHILE (ttest.LT.tstart) - READ (11,END=112,ERR=802,IOSTAT=IOERR) DATETIME, & - invar1,invar2,dummy,numpart,invar3, & - invar4,invar5,invar6,invar7 - date1=dble(DATETIME(1)) - date2=dble(DATETIME(2)) - ttest = date1 + date2*1.0E-6 - !/ --- reset buffer --- - PHS(:) = 0. - PTP(:) = 0. - PDIR(:) = 0. - PSPR(:) = 0. - PWF(:) = 0. - - !/ --- fill buffer with partition data --- - READ (11,END=112,ERR=802,IOSTAT=IOERR) iline,invar1, & - invar2,invar3,invar4,invar5,invar6 - DO i = 1,numpart - READ (11,END=112,ERR=802,IOSTAT=IOERR) iline, & - phs(i),ptp(i),invar3,pdir(i),pspr(i),pwf(i) - END DO - END DO - !/ --- move buffer content to data array --- - DO i=1,numpart - hs0(line) = phs(i) - tp0(line) = ptp(i) - dir0(line) = pdir(i) - dspr0(line) = pspr(i) - date0(line) = date1 + date2*1.0E-6 - ts(line) = tstep - llat(line) = x - llon(line) = y - wndSpd0(line) = wnd - wndDir0(line) = wnddir - - line = line + 1 - END DO - - END IF - !/ ------------------------------------------------- - ! Read file for ntint time levels - !/ ------------------------------------------------- - ttemp = tstart - DO WHILE (line.LE.readln) IF (FLFORM) THEN - READ (11,1000,END=112) date1,date2,x,y,numpart, & - wnd,wnddir,invar6,invar7 + OPEN(unit=11,file=filename,status='old') ELSE - READ (11,ERR=802,IOSTAT=IOERR) DATETIME,x,y, & - dummy,numpart,wnd,wnddir,invar5,invar6,invar7 - date1=dble(DATETIME(1)) - date2=dble(DATETIME(2)) + OPEN(unit=11,file=filename,status='old', & + form='unformatted', convert=file_endian) END IF - - ttest = date1 + date2*1.0E-6 - IF (ttest.GT.ttemp) THEN - tstep = tstep+1 - ttemp = ttest - IF (tstep.GT.ntint) EXIT - END IF - + line = 1 + tstep = 1 + !/ ------------------------------------------------- + !/ Skip to start time + !/ ------------------------------------------------- IF (FLFORM) THEN - READ (11,1010,END=112) invar1,invar2,invar3,invar4 ! Skip total integral parameters - DO i = 1,numpart - IF (line.LE.readln) THEN - READ (11,1010,END=112) hs0(line),tp0(line), & - dir0(line),dspr0(line) - date0(line) = ttest + DO i = 1,skipln + READ (11, *) + END DO + ELSE + ! --- Repeat from above since access='DIRECT' + ! does not support fseek and ftell. --- + READ(11,IOSTAT=IOERR) IDSTR,VERPRT + IF (IOERR.NE.0) endloop = .true. + IF (.not.endloop) THEN + READ(11,IOSTAT=IOERR) headln1 + IF (IOERR.NE.0) endloop = .true. + END IF + IF (.not.endloop) THEN + READ(11,IOSTAT=IOERR) headln2 + IF (IOERR.LT.0) endloop = .true. + END IF + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + IF (.NOT.endloop) THEN + !/ --- allocate buffer for all partition parameters + !/ for a single grid point --- + IF (.NOT.ALLOCATED(PHS)) ALLOCATE(PHS(maxPart)) + IF (.NOT.ALLOCATED(PTP)) ALLOCATE(PTP(maxPart)) + IF (.NOT.ALLOCATED(PDIR)) ALLOCATE(PDIR(maxPart)) + IF (.NOT.ALLOCATED(PSPR)) ALLOCATE(PSPR(maxPart)) + IF (.NOT.ALLOCATED(PWF)) ALLOCATE(PWF(maxPart)) + + ttest = 0 + END IF + DO WHILE (ttest.LT.tstart .AND. .NOT.endloop) + READ (11,IOSTAT=IOERR) DATETIME, & + invar1,invar2,dummy,numpart,invar3, & + invar4,invar5,invar6,invar7 + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF + date1=dble(DATETIME(1)) + date2=dble(DATETIME(2)) + ttest = date1 + date2*1.0E-6 + !/ --- reset buffer --- + PHS(:) = 0. + PTP(:) = 0. + PDIR(:) = 0. + PSPR(:) = 0. + PWF(:) = 0. + + !/ --- fill buffer with partition data --- + READ (11,IOSTAT=IOERR) iline,invar1, & + invar2,invar3,invar4,invar5,invar6 + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + ELSE + DO i = 1,numpart + READ (11,IOSTAT=IOERR) iline, & + phs(i),ptp(i),invar3,pdir(i),pspr(i),pwf(i) + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF + END DO + END IF + END DO + !/ --- move buffer content to data array --- + IF (.NOT.endloop) THEN + DO i=1,numpart + hs0(line) = phs(i) + tp0(line) = ptp(i) + dir0(line) = pdir(i) + dspr0(line) = pspr(i) + date0(line) = date1 + date2*1.0E-6 ts(line) = tstep llat(line) = x llon(line) = y wndSpd0(line) = wnd wndDir0(line) = wnddir - line = line+1 + line = line + 1 + END DO + END IF + + END IF + END IF ! endloop + IF (.NOT.endloop) THEN + !/ ------------------------------------------------- + ! Read file for ntint time levels + !/ ------------------------------------------------- + ttemp = tstart + DO WHILE (line.LE.readln .AND. .NOT. endloop) + IF (FLFORM) THEN + READ (11,1000,IOSTAT=IOERR) date1,date2,x,y,numpart, & + wnd,wnddir,invar6,invar7 + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT END IF - END DO - ELSE - READ (11,ERR=802,IOSTAT=IOERR) k,invar1,invar2, & - invar3,invar4,invar5 - DO i = 1,numpart - IF (line.LE.readln) THEN - READ (11,END=112,ERR=802,IOSTAT=IOERR) k, & - hs0(line),tp0(line),invar3,dir0(line), & - dspr0(line) - date0(line) = ttest + ELSE + READ (11,IOSTAT=IOERR) DATETIME,x,y, & + dummy,numpart,wnd,wnddir,invar5,invar6,invar7 + IF (IOERR.NE.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) + date1=dble(DATETIME(1)) + date2=dble(DATETIME(2)) + END IF - ts(line) = tstep - llat(line) = x - llon(line) = y - wndSpd0(line) = wnd - wndDir0(line) = wnddir + ttest = date1 + date2*1.0E-6 + IF (ttest.GT.ttemp) THEN + tstep = tstep+1 + ttemp = ttest + IF (tstep.GT.ntint) EXIT + END IF - line = line+1 + IF (FLFORM) THEN + READ (11,1010,IOSTAT=IOERR) invar1,invar2,invar3,invar4 ! Skip total integral parameters + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT END IF - END DO - END IF - END DO -110 IERR = -1 - CLOSE(11) + DO i = 1,numpart + IF (line.LE.readln) THEN + READ (11,1010,IOSTAT=IOERR) hs0(line),tp0(line), & + dir0(line),dspr0(line) + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT + END IF + date0(line) = ttest + + ts(line) = tstep + llat(line) = x + llon(line) = y + wndSpd0(line) = wnd + wndDir0(line) = wnddir + + line = line+1 + END IF + END DO + ELSE + READ (11,IOSTAT=IOERR) k,invar1,invar2, & + invar3,invar4,invar5 + IF (IOERR.GT.0) CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',1) + DO i = 1,numpart + IF (line.LE.readln) THEN + READ (11,IOSTAT=IOERR) k, & + hs0(line),tp0(line),invar3,dir0(line), & + dspr0(line) + IF (IOERR.LT.0) THEN + endloop = .true. + EXIT + ELSE IF (IOERR.GT.0) THEN + CALL EXTIOF(6,IOERR,'W3STRKMD','PARTITION',IOERR) + END IF + date0(line) = ttest -112 CONTINUE + ts(line) = tstep + llat(line) = x + llon(line) = y + wndSpd0(line) = wnd + wndDir0(line) = wnddir + + line = line+1 + END IF + END DO + END IF + END DO + IF (.not.endloop) THEN + IERR = -1 + CLOSE(11) + END IF + ! + END IF ! endloop + ! IF (line.EQ.1) THEN WRITE(20,2002) WRITE(6,2002) @@ -1002,6 +1104,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & l = 1 DO WHILE (l.LE.line) + endloop = .false. DO j = 1,maxJ DO i = 1,maxI !>042916 IF ( (llat(l).EQ.mlat(i,j)).AND. & @@ -1039,14 +1142,15 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & iline = iline + 1 if (iline.GT.line) EXIT END DO - ! --- Account for increment at the end of loop (400 CONTINUE) + ! --- Account for increment at the end of loop ! and go one element back in list because of increment. --- l = iline-1 - GOTO 400 + endloop = .true. + exit END IF END DO + if (endloop) exit END DO -400 CONTINUE IF (l+1.le.line) THEN IF (ts(l).LT.ts(l+1)) THEN K = line-l @@ -1711,13 +1815,6 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! RETURN ! -802 CONTINUE - WRITE (6,990) IOERR - STOP 1 - -990 FORMAT (/' *** WAVEWATCH III ERROR IN W3STRKMD : '/ & - ' ERROR IN READING FROM PARTITION FILE'/ & - ' IOSTAT =',I5/) 1000 FORMAT (F9.0,F7.0,F8.3,F8.3,14X,I3,7X,F5.1,F6.1,F5.1,F6.1) 1010 FORMAT (3X,F8.2,F8.2,8X,F9.2,F9.2) 1200 FORMAT (/' *** WAVEWATCH III ERROR IN W3STRKMD : '/ & @@ -1978,6 +2075,7 @@ SUBROUTINE timeTrackingV2 (sysA ,maxSys ,tpTimeKnob , & !/ 03-Feb-2012 : Origination, based on Matlab code ( version 4.05 ) !/ by Jeff Hanson & Eve-Marie Devaliere !/ 04-Jan-2013 : Inclusion in trunk ( version 4.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -2095,7 +2193,7 @@ SUBROUTINE timeTrackingV2 (sysA ,maxSys ,tpTimeKnob , & ! No non-empty systems found IF (ts1.GT.SIZE(sysA)) THEN maxGroup = 0 - GOTO 2000 + RETURN END IF END DO WRITE(20,*) 'TS = ',ts1 @@ -2667,7 +2765,6 @@ SUBROUTINE timeTrackingV2 (sysA ,maxSys ,tpTimeKnob , & END DO CLOSE(27) -2000 CONTINUE RETURN END SUBROUTINE timeTrackingV2 !/ End of timeTrackingV2 --------------------------------------------- / @@ -3693,6 +3790,7 @@ SUBROUTINE combineSys (wsdat ,sys ,maxSys ,maxI , & !/ 03-Feb-2012 : Origination, based on Matlab code ( version 4.05 ) !/ by Jeff Hanson & Eve-Marie Devaliere !/ 04-Jan-2013 : Inclusion in trunk ( version 4.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -3978,13 +4076,13 @@ SUBROUTINE combineSys (wsdat ,sys ,maxSys ,maxI , & deltaPerB = (m2*1. + 3)*1. !Remove dHs limitation from criteria deltaHsB = 9999. - GOTO 500 + EXIT END IF END IF END DO + IF (DIST.LT.3.) EXIT END DO END IF -500 CONTINUE !051612 --- Land mask addition absHs = ABS( SUM(sys(ss)%hs(indSys1))/lsys - & diff --git a/model/src/w3tidemd.F90 b/model/src/w3tidemd.F90 index 00b7b047da..22bbdc4534 100644 --- a/model/src/w3tidemd.F90 +++ b/model/src/w3tidemd.F90 @@ -12,6 +12,7 @@ MODULE W3TIDEMD !/ 01-Sep-2012 : Origination. ( version 4.07 ) !/ 04-Mar-2013 : Correction of FAST and new VFAST ( version 4.08 ) !/ 21-Apr-2020 : Correction of time and implicit none( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -1161,29 +1162,31 @@ SUBROUTINE dsvdcmp(a,m,n,mp,np,w,v) do its=1,30 do l=k,1,-1 nm=l-1 - IF ((abs(rv1(l))+anorm).eq.anorm) goto 2 - IF ((abs(w(nm))+anorm).eq.anorm) goto 1 + IF ((abs(rv1(l))+anorm.eq.anorm) .or. & + (abs(w(nm)) +anorm.eq.anorm)) exit end do -1 c=0.0d0 - s=1.0d0 - do i=l,k - f=s*rv1(i) - rv1(i)=c*rv1(i) - IF ((abs(f)+anorm).eq.anorm) goto 2 - g=w(i) - h=dpythag(f,g) - w(i)=h - h=1.0d0/h - c= (g*h) - s=-(f*h) - do j=1,m - y=a(j,nm) - z=a(j,i) - a(j,nm)=(y*c)+(z*s) - a(j,i)=-(y*s)+(z*c) + if ((abs(rv1(l))+anorm).ne.anorm) then + c=0.0d0 + s=1.0d0 + do i=l,k + f=s*rv1(i) + rv1(i)=c*rv1(i) + IF ((abs(f)+anorm).eq.anorm) exit + g=w(i) + h=dpythag(f,g) + w(i)=h + h=1.0d0/h + c= (g*h) + s=-(f*h) + do j=1,m + y=a(j,nm) + z=a(j,i) + a(j,nm)=(y*c)+(z*s) + a(j,i)=-(y*s)+(z*c) + end do end do - end do -2 z=w(k) + end if + z=w(k) IF (l.eq.k)then IF (z.lt.0.0d0)then w(k)=-z @@ -1191,7 +1194,7 @@ SUBROUTINE dsvdcmp(a,m,n,mp,np,w,v) v(j,k)=-v(j,k) end do endif - goto 3 + exit endif IF (ITS.eq.30) THEN WRITE(6,*) 'no convergence in svdcmp' @@ -1247,7 +1250,6 @@ SUBROUTINE dsvdcmp(a,m,n,mp,np,w,v) rv1(k)=f w(k)=x end do -3 continue end do return END SUBROUTINE dsvdcmp @@ -1377,30 +1379,31 @@ subroutine svd(q,u,v,cov,w,p,b,sig,ic,m,n,mm,N2,toler,jc & b(i)=q(i,N2) enddo ! no need to solve if only rhs has changed - IF (ic.eq.2) go to 10 - ! define a "design matrix" u(=a) and set-up working arrays - do j=1,N2 - do i=1,mm - u(i,j)=q(i,j) + if (ic.ne.2) then + ! define a "design matrix" u(=a) and set-up working arrays + do j=1,N2 + do i=1,mm + u(i,j)=q(i,j) + enddo enddo - enddo - ! compute svd decomposition of u(=a), with a being replaced by its upper - ! matrix u, viz a=u*w*transpose(v), and vector w is output of a diagonal - ! matrix of singular values w(i), i=1,n. - call dsvdcmp(u,m,n,mm,N2,w,v) - ! check for small singular values - wmax=0. - do j=1,n - IF (w(j).gt.wmax) wmax=w(j) - enddo - thresh=toler*wmax - do j=1,n - IF (w(j).lt.thresh) then - w(j)=0.d0 - IF (jc.lt.1) jc=j - endif - enddo -10 eps=1.d-10 + ! compute svd decomposition of u(=a), with a being replaced by its upper + ! matrix u, viz a=u*w*transpose(v), and vector w is output of a diagonal + ! matrix of singular values w(i), i=1,n. + call dsvdcmp(u,m,n,mm,N2,w,v) + ! check for small singular values + wmax=0. + do j=1,n + IF (w(j).gt.wmax) wmax=w(j) + enddo + thresh=toler*wmax + do j=1,n + IF (w(j).lt.thresh) then + w(j)=0.d0 + IF (jc.lt.1) jc=j + endif + enddo + end if + eps=1.d-10 ! compute summation weights (wti, used below) do j=1,n wti(j)=0.d0 @@ -1717,15 +1720,16 @@ SUBROUTINE VUF (KONX,Vx,ux,FX,ITIME) INTEGER :: K DO K=1,NTOTAL_CON - IF (TIDECON_ALLNAMES(K).eq.KONX) go to 40 + IF (TIDECON_ALLNAMES(K).eq.KONX) THEN + VX=V_ARG(K,ITIME) + UX=U_ARG(k,ITIME) + FX=F_ARG(K,ITIME) + RETURN + END IF END DO WRITE(NDSET,30) KONX 30 FORMAT('ERROR IN VUF: STOP.',A5) STOP -40 VX=V_ARG(K,ITIME) - UX=U_ARG(k,ITIME) - FX=F_ARG(K,ITIME) - RETURN ! !*********************************************************************** !* THE ASTRONOMICAL ARGUMENTS AND THEIR RATES OF CHANGE, @@ -1780,8 +1784,8 @@ SUBROUTINE OPNVUF(filename) 60 FORMAT(6X,A5,1X,6I3,F5.2,I4) !WRITE(995,'(I4,A5,1X,6I3,F5.2,I4)') K,TIDECON_ALLNAMES(K),II(K),JJ(K),KK(K),LL(K),MM(K),NN(K),SEMI(K), & ! NJ(K) - IF (TIDECON_ALLNAMES(K).eq.KBLANK) go to 100 -70 J1=JBASE+1 + IF (TIDECON_ALLNAMES(K).eq.KBLANK) exit + J1=JBASE+1 IF (NJ(K).LT.1) THEN NJ(K)=1 JL=J1 @@ -1816,7 +1820,7 @@ SUBROUTINE OPNVUF(filename) END IF JBASE=JL end do -100 NTIDAL_CON=K-1 + NTIDAL_CON=K-1 JLM=JL ! @@ -1838,11 +1842,11 @@ SUBROUTINE OPNVUF(filename) READ(KR,130)TIDECON_ALLNAMES(K),NJ(K),(COEF_CON(J),KONCO_CON(J),J=J1,J4) 130 FORMAT(6X,A5,I1,2X,4(F5.2,A5,5X)) !WRITE(995,130)TIDECON_ALLNAMES(K),NJ(K),(COEF_CON(J),KONCO_CON(J),J=J1,J4) - IF (TIDECON_ALLNAMES(K).eq.KBLANK) go to 170 + IF (TIDECON_ALLNAMES(K).eq.KBLANK) exit JBASE=JBASE+NJ(K) end do -170 NTOTAL_CON=K-1 + NTOTAL_CON=K-1 ! Write out for cut and paste ... ! WRITE(6,*) 'Numbers:',NTIDAL_CON, NTOTAL_CON, JLM, J1, J4 @@ -2285,7 +2289,6 @@ subroutine flex_tidana_webpage(IX,IY,XLON,XLAT,KD1,KD2,ndef, itrend, RES, SSQ, R SDEV=SDEV/(MEQ-1) SDEV=SQRT(SDEV) SDEV0(IDEF)=SDEV -109 CONTINUE ! ! USE SINGULAR-VALUE-DECOMPOSITION TO SOLVE THE OVERDETERMINED SYSTEM ! diff --git a/model/src/w3timemd.F90 b/model/src/w3timemd.F90 index 0041866dbf..5c989c4545 100644 --- a/model/src/w3timemd.F90 +++ b/model/src/w3timemd.F90 @@ -92,6 +92,7 @@ SUBROUTINE TICK21 ( TIME, DTIME ) !/ !/ 23-Mar-1993 : Final FORTRAN 77 ( version 1.18 ) !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -169,19 +170,15 @@ SUBROUTINE TICK21 ( TIME, DTIME ) ! ! Check change of date : ! -100 CONTINUE - IF (NSEC.GE.86400) THEN + DO WHILE (NSEC.GE.86400) NSEC = NSEC - 86400 NYMD = IYMD21 (NYMD,1) - GOTO 100 - END IF + END DO ! -200 CONTINUE - IF (NSEC.LT.00000) THEN + DO WHILE (NSEC.LT.00000) NSEC = 86400 + NSEC NYMD = IYMD21 (NYMD,-1) - GOTO 200 - END IF + END DO ! NHMS = NSEC/3600*10000 + MOD(NSEC,3600)/60*100 + MOD(NSEC,60) ! @@ -208,6 +205,7 @@ INTEGER FUNCTION IYMD21 ( NYMD ,M ) !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ 10-Jan-2017 : Add NOLEAP option, 365 day calendar ( version 6.00 ) !/ 18-Jun-2020 : Add 360-day calendar option ( version 7.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -303,20 +301,20 @@ INTEGER FUNCTION IYMD21 ( NYMD ,M ) ! ! M = 1, leap year ! - IF (ND.EQ.29 .AND. NM.EQ.2 .AND. LEAP) GO TO 20 - ! - ! next month - ! - IF (ND.GT.NDPM(NM)) THEN - ND = 1 - NM = NM + 1 - IF (NM.GT.12) THEN - NM = 1 - NY = NY + 1 - ENDIF + IF (.NOT. (ND.EQ.29 .AND. NM.EQ.2 .AND. LEAP) ) THEN + ! + ! next month + ! + IF (ND.GT.NDPM(NM)) THEN + ND = 1 + NM = NM + 1 + IF (NM.GT.12) THEN + NM = 1 + NY = NY + 1 + ENDIF + END IF + ! END IF - ! -20 CONTINUE IYMD21 = NY*10000 + NM*100 + ND ! RETURN @@ -342,6 +340,7 @@ REAL FUNCTION DSEC21 ( TIME1, TIME2 ) !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ 05-Jan-2001 : Y2K leap year error correction. ( version 2.05 ) !/ 18-Jun-2020 : Add 360-day calendar support ( version 7.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ ! 1. Purpose : @@ -423,25 +422,23 @@ REAL FUNCTION DSEC21 ( TIME1, TIME2 ) ! IF ( NY1 .NE. NY2 ) THEN NST = SIGN ( 1 , NY2-NY1 ) -100 CONTINUE - IF (NY1.EQ.NY2) GOTO 200 - IF (NST.GT.0) THEN - NY2 = NY2 - 1 - IF (TRIM(CALTYPE) .EQ. '360_day' ) THEN - ND = ND + MYMD21 ( NY2*10000 + 1230 ) - ELSE - ND = ND + MYMD21 ( NY2*10000 + 1231 ) - END IF - ELSE - IF (TRIM(CALTYPE) .EQ. '360_day' ) THEN - ND = ND - MYMD21 ( NY2*10000 + 1230 ) + DO WHILE (NY1.NE.NY2) + IF (NST.GT.0) THEN + NY2 = NY2 - 1 + IF (TRIM(CALTYPE) .EQ. '360_day' ) THEN + ND = ND + MYMD21 ( NY2*10000 + 1230 ) + ELSE + ND = ND + MYMD21 ( NY2*10000 + 1231 ) + END IF ELSE - ND = ND - MYMD21 ( NY2*10000 + 1231 ) - END IF - NY2 = NY2 + 1 - ENDIF - GOTO 100 -200 CONTINUE + IF (TRIM(CALTYPE) .EQ. '360_day' ) THEN + ND = ND - MYMD21 ( NY2*10000 + 1230 ) + ELSE + ND = ND - MYMD21 ( NY2*10000 + 1231 ) + END IF + NY2 = NY2 + 1 + ENDIF + END DO END IF ! NS = NS2 - NS1 @@ -470,6 +467,7 @@ INTEGER FUNCTION MYMD21 ( NYMD ) !/ 29-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 ) !/ 10-Jan-2017 : Add NOLEAP option, 365 day calendar ( version 6.01 ) !/ 18-Jun-2020 : Add 360-day calendar support ( version 7.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -553,13 +551,10 @@ INTEGER FUNCTION MYMD21 ( NYMD ) ! IF (NM.GT.2 .AND. LEAP) ND = ND + 1 ! -40 CONTINUE - IF (NM.LE.1) GO TO 60 - NM = NM - 1 - ND = ND + NDPM(NM) - GO TO 40 - ! -60 CONTINUE + DO WHILE (NM.GT.1) + NM = NM - 1 + ND = ND + NDPM(NM) + END DO MYMD21 = ND ! RETURN @@ -1734,6 +1729,7 @@ SUBROUTINE U2D(UNITS,DAT,IERR) !/ +-----------------------------------+ !/ !/ 15-May-2018 : Origination ( version 6.05 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -1765,7 +1761,7 @@ SUBROUTINE U2D(UNITS,DAT,IERR) ! !/ ------------------------------------------------------------------- / !/ - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTIOF USE W3ODATMD, ONLY: NDSE ! IMPLICIT NONE @@ -1800,169 +1796,195 @@ SUBROUTINE U2D(UNITS,DAT,IERR) IF (INDEX(UNITS, "seconds").NE.0) THEN ! seconds since YYYY-MM-DD hh:mm:ss IF (INDEX(UNITS, "-", .TRUE.).EQ.22) THEN - READ(UNITS(15:18),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(20:21),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(23:24),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(3) - READ(UNITS(26:27),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(29:30),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(32:33),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(15:18),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(20:21),'(I2.2)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(23:24),'(I2.2)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(26:27),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(29:30),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(32:33),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! seconds since YYYY-M-D ... ELSE IF (INDEX(UNITS, "-", .TRUE.).EQ.21) THEN - READ(UNITS(15:18),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(20:20),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(22:22),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(3) + READ(UNITS(15:18),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(20:20),'(I1.1)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(22:22),'(I1.1)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! seconds since YYYY-M-D h:m:s IF (INDEX(UNITS, ":", .FALSE.).EQ.25) THEN - READ(UNITS(24:24),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(26:26),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(28:28),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(24:24),'(I1.1)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(26:26),'(I1.1)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(28:28),'(I1.1)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! seconds since YYYY-M-D hh:mm:ss ELSE IF (INDEX(UNITS, ":", .FALSE.).EQ.26) THEN - READ(UNITS(24:25),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(27:28),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(30:31),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(24:25),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(27:28),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(30:31),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ! days ELSE IF (INDEX(UNITS, "days").NE.0) THEN ! days since YYYY-MM-DD hh:mm:ss IF (INDEX(UNITS, "-", .TRUE.).EQ.19) THEN - READ(UNITS(12:15),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(17:18),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(20:21),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(3) - READ(UNITS(23:24),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(26:27),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(29:30),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(12:15),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(17:18),'(I2.2)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(20:21),'(I2.2)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(23:24),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(26:27),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(29:30),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! days since YYYY-M-D ... ELSE IF (INDEX(UNITS, "-", .TRUE.).EQ.18) THEN - READ(UNITS(12:15),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(17:17),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(19:19),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(3) + READ(UNITS(12:15),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(17:17),'(I1.1)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(19:19),'(I1.1)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! days since YYYY-M-D h:m:s IF (INDEX(UNITS, ":", .FALSE.).EQ.22) THEN - READ(UNITS(21:21),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(23:23),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(25:25),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(21:21),'(I1.1)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(23:23),'(I1.1)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(25:25),'(I1.1)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! days since YYYY-M-D hh:mm:ss ELSE IF (INDEX(UNITS, ":", .FALSE.).EQ.23) THEN - READ(UNITS(21:22),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(24:25),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(27:28),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(21:22),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(24:25),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(27:28),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ! hours ELSE IF (INDEX(UNITS, "hours").NE.0) THEN ! hours since YYYY-MM-DD hh:mm:ss IF (INDEX(UNITS, "-", .TRUE.).EQ.20) THEN - READ(UNITS(13:16),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(18:19),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(21:22),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(3) - READ(UNITS(24:25),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(27:28),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(30:31),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(13:16),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(18:19),'(I2.2)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(21:22),'(I2.2)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(24:25),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(27:28),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(30:31),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! hours since YYYY-M-D ... ELSE IF (INDEX(UNITS, "-", .TRUE.).EQ.19) THEN - READ(UNITS(13:16),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(18:18),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(20:20),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(3) + READ(UNITS(13:16),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(18:18),'(I1.1)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(20:20),'(I1.1)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! hours since YYYY-M-D h:m:s IF (INDEX(UNITS, ":", .FALSE.).EQ.23) THEN - READ(UNITS(22:22),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(24:24),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(26:26),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(22:22),'(I1.1)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(24:24),'(I1.1)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(26:26),'(I1.1)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! hours since YYYY-M-D hh:mm:ss ELSE IF (INDEX(UNITS, ":", .FALSE.).EQ.24) THEN - READ(UNITS(22:23),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(25:26),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(28:29),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(22:23),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(25:26),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(28:29),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ! minutes ELSE IF (INDEX(UNITS, "minutes").NE.0) THEN ! minutes since YYYY-MM-DD hh:mm:ss IF (INDEX(UNITS, "-", .TRUE.).EQ.22) THEN - READ(UNITS(15:18),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(20:21),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(23:24),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(3) - READ(UNITS(26:27),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(29:30),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(32:33),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(15:18),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(20:21),'(I2.2)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(23:24),'(I2.2)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(26:27),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(29:30),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(32:33),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! minutes since YYYY-M-D ... ELSE IF (INDEX(UNITS, "-", .TRUE.).EQ.21) THEN - READ(UNITS(15:18),'(I4.4)',END=804,ERR=805,IOSTAT=IERR) DAT(1) - READ(UNITS(20:20),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(2) - READ(UNITS(22:22),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(3) + READ(UNITS(15:18),'(I4.4)',IOSTAT=IERR) DAT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(20:20),'(I1.1)',IOSTAT=IERR) DAT(2) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(22:22),'(I1.1)',IOSTAT=IERR) DAT(3) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! minutes since YYYY-M-D h:m:s IF (INDEX(UNITS, ":", .FALSE.).EQ.25) THEN - READ(UNITS(24:24),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(26:26),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(28:28),'(I1.1)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(24:24),'(I1.1)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(26:26),'(I1.1)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(28:28),'(I1.1)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ! minutes since YYYY-M-D hh:mm:ss ELSE IF (INDEX(UNITS, ":", .FALSE.).EQ.26) THEN - READ(UNITS(24:25),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(5) - READ(UNITS(27:28),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(6) - READ(UNITS(30:31),'(I2.2)',END=804,ERR=805,IOSTAT=IERR) DAT(7) + READ(UNITS(24:25),'(I2.2)',IOSTAT=IERR) DAT(5) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(27:28),'(I2.2)',IOSTAT=IERR) DAT(6) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) + READ(UNITS(30:31),'(I2.2)',IOSTAT=IERR) DAT(7) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TIMEMD','UNITS',44) ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ! nothing ELSE - GOTO 804 + CALL EXTIOF(NDSE,-1,'W3TIMEMD','UNITS',44) END IF ! - GOTO 888 - ! - ! Error escape locations - ! -804 CONTINUE - WRITE (NDSE,1004) TRIM(UNITS) - CALL EXTCDE ( 44 ) - ! -805 CONTINUE - WRITE (NDSE,1005) IERR - CALL EXTCDE ( 45 ) - ! -888 CONTINUE - - ! - ! Formats - ! -1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3TIMEMD : '/ & - ' PREMATURE END OF TIME ATTRIBUTE '/ & - ' ',A/ & - ' DIFFERS FROM CONVENTIONS ISO8601 '/ & - ' XXX since YYYY-MM-DD hh:mm:ss'/ & - ' XXX since YYYY-M-D h:m:s'/ & - ' XXX since YYYY-M-D hh:mm:ss'/) - ! -1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3TIMEMD : '/ & - ' ERROR IN READING OF TIME ATTRIBUTE '/ & - ' ',A/ & - ' DIFFERS FROM CONVENTIONS ISO8601 '/ & - ' XXX since YYYY-MM-DD hh:mm:ss'/ & - ' XXX since YYYY-M-D h:m:s'/ & - ' XXX since YYYY-M-D hh:mm:ss'/ & - ' IOSTAT =',I5/) - ! RETURN !/ !/ End of U2D ----------------------------------------------------- / @@ -2012,7 +2034,7 @@ SUBROUTINE T2ISO(TIME,ISODT) ! !/ ------------------------------------------------------------------- / !/ - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTIOF USE W3ODATMD, ONLY: NDSE ! IMPLICIT NONE diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index f2118ec246..14c9ec41ac 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -676,6 +676,7 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) !/ +-----------------------------------+ !/ !/ 14-Mar-2018 : Origination. ( version 6.02 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! ! 1. Purpose : @@ -717,7 +718,7 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NX, NY, CCON , COUNTCON USE W3ODATMD, ONLY: NDSE, NDST, NDSO - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -747,7 +748,8 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) CALL NEXTLN(COMSTR, NDS, NDSE) IERR = 0 DO WHILE (IERR.EQ.0) - READ (NDS,'(A100)',END=2001,ERR=2002,IOSTAT=IERR) LINE + READ (NDS,'(A100)',IOSTAT=IERR) LINE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'READMSHOBC',FNAME,61) READ(LINE,*,IOSTAT=IERR) Ind,ntag IF (IERR.EQ.0) THEN ALLOCATE(TAGS(ntag)) @@ -756,7 +758,8 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) TMPSTA(1,INODE)=2 DEALLOCATE(TAGS) ELSE - GOTO 2001 + WRITE (NDSE,1001) + CALL EXTCDE ( 61 ) END IF END IF END DO @@ -764,17 +767,8 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) UGOBCOK=.TRUE. RETURN ! -2001 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 61 ) - ! -2002 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 62 ) 1001 FORMAT (/' *** WAVEWATCH III ERROR IN READMSHOBC : '/ & ' PREMATURE END OF FILE IN READING ',A/) -1002 FORMAT (/' *** WAVEWATCH III ERROR IN READMSHOBC : '/ & - ' ERROR IN READING ',A,' IOSTAT =',I8/) END SUBROUTINE READMSHOBC !/ ------------------------------------------------------------------- / diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index 4e517d50a0..6286c28dc5 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -2029,6 +2029,7 @@ SUBROUTINE W3ULEV ( A, VA ) !/ activation of grid point. !/ 06-Jun-2012 : Porting bugfixes from 3.14 to 4.07 ( version 4.07 ) !/ 26-Sep-2012 : Adding update from tidal analysis ( version 4.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -2149,7 +2150,7 @@ SUBROUTINE W3ULEV ( A, VA ) #ifdef W3_T3 REAL :: OUT(NK,NTH) #endif - LOGICAL :: LOCAL + LOGICAL :: LOCAL, COND INTEGER :: IBELONG ! #ifdef W3_TIDE @@ -2404,58 +2405,61 @@ SUBROUTINE W3ULEV ( A, VA ) ! ! 2.e Redistribute discrete action density ! + COND = .TRUE. IF ( WNO(1) .LT. WN(1,ISEA) ) THEN IK0 = 1 I1 = 0 I2 = 1 -220 CONTINUE - IK0 = IK0 + 1 - IF ( IK0 .GT. NK+1 ) GOTO 251 - IF ( WNO(IK0) .GE. WN(1,ISEA) ) THEN - IK0 = IK0 - 1 - ELSE - GOTO 220 - END IF + DO + IK0 = IK0 + 1 + IF ( IK0 .GT. NK+1 ) THEN + COND = .FALSE. + EXIT + END IF + IF ( WNO(IK0) .GE. WN(1,ISEA) ) THEN + IK0 = IK0 - 1 + EXIT + END IF + END DO ELSE IK0 = 1 I1 = 1 I2 = 2 END IF ! - DO IK=IK0, NK - ! -230 CONTINUE - IF ( WNO(IK) .GT. WN(I2,ISEA) ) THEN - I1 = I1 + 1 - IF ( I1 .GT. NK ) GOTO 250 - I2 = I1 + 1 - GOTO 230 - END IF - ! - IF ( I1 .EQ. 0 ) THEN - RD1 = ( WN(1,ISEA) - WNO(IK) ) / DWN(1) - RD2 = 1. - RD1 - ELSE - RD1 = ( WN(I2,ISEA) - WNO(IK) ) / & - ( WN(I2,ISEA) - WN(I1,ISEA) ) - RD2 = 1. - RD1 - END IF - ! - IF ( I1 .GE. 1 ) THEN - DO ITH=1, NTH - A(ITH,I1,JSEA) = A(ITH,I1,JSEA) + RD1*TA(ITH,IK) + IF (COND) THEN + DO IK=IK0, NK + ! + DO WHILE ( WNO(IK) .GT. WN(I2,ISEA) ) + I1 = I1 + 1 + IF ( I1 .GT. NK ) EXIT + I2 = I1 + 1 END DO - END IF - ! - IF ( I2 .LE. NK ) THEN - DO ITH=1, NTH - A(ITH,I2,JSEA) = A(ITH,I2,JSEA) + RD2*TA(ITH,IK) - END DO - END IF - ! -250 CONTINUE - END DO -251 CONTINUE + IF ( I1 .GT. NK ) CYCLE + ! + IF ( I1 .EQ. 0 ) THEN + RD1 = ( WN(1,ISEA) - WNO(IK) ) / DWN(1) + RD2 = 1. - RD1 + ELSE + RD1 = ( WN(I2,ISEA) - WNO(IK) ) / & + ( WN(I2,ISEA) - WN(I1,ISEA) ) + RD2 = 1. - RD1 + END IF + ! + IF ( I1 .GE. 1 ) THEN + DO ITH=1, NTH + A(ITH,I1,JSEA) = A(ITH,I1,JSEA) + RD1*TA(ITH,IK) + END DO + END IF + ! + IF ( I2 .LE. NK ) THEN + DO ITH=1, NTH + A(ITH,I2,JSEA) = A(ITH,I2,JSEA) + RD2*TA(ITH,IK) + END DO + END IF + ! + END DO + END IF ! ! 2.f Convert discrete action densities to spectrum ! diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 19beb52256..a6fefb036e 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -98,6 +98,7 @@ MODULE W3WAVEMD !/ 11-Nov-2021 : Remove XYB since it is obsolete ( version 7.xx ) !/ 13-Sep-2022 : Add OMP for W3NMIN loops. Hide !/ W3NMIN in W3_DEBUGRUN for scaling. ( version 7.xx ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -1590,730 +1591,721 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_T WRITE (NDST,9022) #endif - GOTO 400 + EXIT ! exit time step loop END IF - IF ( IT.EQ.0 ) THEN - DTG = 1. - ! DTG = 60. - GOTO 370 - END IF - IF ( FLDRY .OR. IAPROC.GT.NAPROC ) THEN -#ifdef W3_T - WRITE (NDST,9023) -#endif - GOTO 380 - END IF - ! - ! Estimation of the local maximum CFL for XY propagation ! + IF (IT.NE.0 .AND. .NOT. FLDRY .AND. IAPROC.LE.NAPROC) THEN + ! + ! Estimation of the local maximum CFL for XY propagation + ! #ifdef W3_T - WRITE(NDSE,*) 'Computing CFLs .... ',NSEAL + WRITE(NDSE,*) 'Computing CFLs .... ',NSEAL #endif - IF ( FLOGRD(9,3).AND. UGDTUPDATE ) THEN - IF (FSTOTALIMP .eqv. .FALSE.) THEN - NKCFL=NK + IF ( FLOGRD(9,3).AND. UGDTUPDATE ) THEN + IF (FSTOTALIMP .eqv. .FALSE.) THEN + NKCFL=NK #ifdef W3_T - NKCFL=1 + NKCFL=1 #endif - ! + ! #ifdef W3_OMPG - !$OMP PARALLEL DO PRIVATE (JSEA,ISEA) SCHEDULE (DYNAMIC,1) + !$OMP PARALLEL DO PRIVATE (JSEA,ISEA) SCHEDULE (DYNAMIC,1) #endif - ! - DO JSEA=1, NSEAL - CALL INIT_GET_ISEA(ISEA, JSEA) + ! + DO JSEA=1, NSEAL + CALL INIT_GET_ISEA(ISEA, JSEA) #ifdef W3_PR3 - IF (GTYPE .EQ. UNGTYPE) THEN - IF ( FLOGRD(9,3) ) THEN + IF (GTYPE .EQ. UNGTYPE) THEN + IF ( FLOGRD(9,3) ) THEN #endif #ifdef W3_T - IF (MOD(ISEA,100).EQ.0) WRITE(NDSE,*) 'COMPUTING CFL FOR NODE:',ISEA + IF (MOD(ISEA,100).EQ.0) WRITE(NDSE,*) 'COMPUTING CFL FOR NODE:',ISEA #endif #ifdef W3_PDLIB - IF (.NOT. LPDLIB) THEN + IF (.NOT. LPDLIB) THEN #endif #ifdef W3_PR3 - CALL W3CFLUG ( ISEA, NKCFL, FACX, FACX, DTG, MAPFS, CFLXYMAX(JSEA), & - VGX, VGY ) + CALL W3CFLUG ( ISEA, NKCFL, FACX, FACX, DTG, MAPFS, CFLXYMAX(JSEA), & + VGX, VGY ) #endif #ifdef W3_PDLIB - ENDIF + ENDIF #endif #ifdef W3_PR3 + END IF + ELSE + CALL W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX(JSEA), VGX, VGY ) END IF - ELSE - CALL W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX(JSEA), VGX, VGY ) - END IF #endif - END DO - ! + END DO + ! #ifdef W3_OMPG - !$OMP END PARALLEL DO + !$OMP END PARALLEL DO #endif - ! + ! + END IF END IF - END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 15') - ! - - ! + call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 15') + ! #ifdef W3_T - IF (GTYPE .EQ. UNGTYPE) THEN - IF ( FLOGRD(9,3) ) THEN - DTCFL1(:)=1. - DO JSEA=1,NSEAL - INDSORT(JSEA)=FLOAT(JSEA) - DTCFL1(JSEA)=DTG/CFLXYMAX(JSEA) - END DO - CALL SSORT1 (DTCFL1, INDSORT, NSEAL, 2) - IF ( IAPROC .EQ. NAPERR ) WRITE(NDSE,*) 'Nodes requesting smallest timesteps:' - IF ( IAPROC .EQ. NAPERR ) WRITE(NDSE,'(A,10I10)') 'Nodes ',NINT(INDSORT(1:10)) - IF ( IAPROC .EQ. NAPERR ) WRITE(NDSE,'(A,10F10.2)') 'time steps ',DTCFL1(1:10) - DO JSEA = 1, MIN(NSEAL,200) - ISEA = NINT(INDSORT(JSEA)) ! will not work with MPI - IX = MAPSF(ISEA,1) - IF (JSEA.EQ.1) then - WRITE(995,*) ' IP dtmax_exp(ip) x-coord y-coord z-coord' - end if - WRITE(995,'(I10,F10.2,3F10.4)') IX, DTCFL1(JSEA), XGRD(1,IX), YGRD(2,IX), ZB(IX) - END DO ! JSEA - CLOSE(995) + IF (GTYPE .EQ. UNGTYPE) THEN + IF ( FLOGRD(9,3) ) THEN + DTCFL1(:)=1. + DO JSEA=1,NSEAL + INDSORT(JSEA)=FLOAT(JSEA) + DTCFL1(JSEA)=DTG/CFLXYMAX(JSEA) + END DO + CALL SSORT1 (DTCFL1, INDSORT, NSEAL, 2) + IF ( IAPROC .EQ. NAPERR ) WRITE(NDSE,*) 'Nodes requesting smallest timesteps:' + IF ( IAPROC .EQ. NAPERR ) WRITE(NDSE,'(A,10I10)') 'Nodes ',NINT(INDSORT(1:10)) + IF ( IAPROC .EQ. NAPERR ) WRITE(NDSE,'(A,10F10.2)') 'time steps ',DTCFL1(1:10) + DO JSEA = 1, MIN(NSEAL,200) + ISEA = NINT(INDSORT(JSEA)) ! will not work with MPI + IX = MAPSF(ISEA,1) + IF (JSEA.EQ.1) then + WRITE(995,*) ' IP dtmax_exp(ip) x-coord y-coord z-coord' + end if + WRITE(995,'(I10,F10.2,3F10.4)') IX, DTCFL1(JSEA), XGRD(1,IX), YGRD(2,IX), ZB(IX) + END DO ! JSEA + CLOSE(995) + END IF END IF - END IF #endif - - ! - ! 3.6 Perform Propagation = = = = = = = = = = = = = = = = = = = = = = = - ! 3.6.1 Preparations - ! + ! + ! 3.6 Perform Propagation = = = = = = = = = = = = = = = = = = = = = = = + ! 3.6.1 Preparations + ! #ifdef W3_SEC1 - DTGTEMP=DTG - DTG=DTG/NITERSEC1 + DTGTEMP=DTG + DTG=DTG/NITERSEC1 + END IF + ! DO ISEC1=1,NITERSEC1 + IF (IT.NE.0 .AND. .NOT. FLDRY .AND. IAPROC.LE.NAPROC) THEN #endif - NTLOC = 1 + INT( DTG/DTCFLI - 0.001 ) + NTLOC = 1 + INT( DTG/DTCFLI - 0.001 ) #ifdef W3_SEC1 - IF ( IAPROC .EQ. NAPOUT ) then - WRITE(NDSE,'(A,I4,A,I4)') ' SUBSECOND STEP:',ISEC1,' out of ',NITERSEC1 - end if + IF ( IAPROC .EQ. NAPOUT ) then + WRITE(NDSE,'(A,I4,A,I4)') ' SUBSECOND STEP:',ISEC1,' out of ',NITERSEC1 + end if #endif - ! - FACTH = DTG / (DTH*REAL(NTLOC)) - FACK = DTG / REAL(NTLOC) + ! + FACTH = DTG / (DTH*REAL(NTLOC)) + FACK = DTG / REAL(NTLOC) - TTEST(1) = TIME(1) - TTEST(2) = 0 - DTTEST = DSEC21(TTEST,TIME) - ITLOCH = ( NTLOC + 1 - MOD(NINT(DTTEST/DTG),2) ) / 2 - ! - ! 3.6.2 Intra-spectral part 1 - ! + TTEST(1) = TIME(1) + TTEST(2) = 0 + DTTEST = DSEC21(TTEST,TIME) + ITLOCH = ( NTLOC + 1 - MOD(NINT(DTTEST/DTG),2) ) / 2 + ! + ! 3.6.2 Intra-spectral part 1 + ! #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before intraspectral part 1", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before intraspectral part 1", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("Before intraspectral") + CALL PRINT_MY_TIME("Before intraspectral") #endif - IF ( FLCTH .OR. FLCK ) THEN - DO ITLOC=1, ITLOCH - ! + IF ( FLCTH .OR. FLCK ) THEN + DO ITLOC=1, ITLOCH + ! #ifdef W3_OMPG - !$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH,IXrel) - !$OMP DO SCHEDULE (DYNAMIC,1) + !$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH,IXrel) + !$OMP DO SCHEDULE (DYNAMIC,1) #endif - ! - DO JSEA=1, NSEAL - CALL INIT_GET_ISEA(ISEA, JSEA) - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) + ! + DO JSEA=1, NSEAL + CALL INIT_GET_ISEA(ISEA, JSEA) + IX = MAPSF(ISEA,1) + IY = MAPSF(ISEA,2) - IF ( GTYPE .EQ. UNGTYPE ) THEN - IF (LPDLIB) THEN + IF ( GTYPE .EQ. UNGTYPE ) THEN + IF (LPDLIB) THEN #ifdef W3_PDLIB - IF (IOBP_LOC(JSEA) .NE. 1) CYCLE + IF (IOBP_LOC(JSEA) .NE. 1) CYCLE #endif - ELSE - IF (IOBP(ISEA) .NE. 1) CYCLE + ELSE + IF (IOBP(ISEA) .NE. 1) CYCLE + ENDIF ENDIF - ENDIF - IF ( MAPSTA(IY,IX) .EQ. 1 ) THEN - DEPTH = MAX ( DMIN , DW(ISEA) ) - IF (LPDLIB) THEN - IXrel = JSEA - ELSE - IXrel = IX - END IF - ! - IF( GTYPE .EQ. SMCTYPE ) THEN - J = 1 -#ifdef W3_SMC - !!Li Refraction and GCT in theta direction is done by rotation. - CALL W3KRTN ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DHDX(ISEA), DHDY(ISEA), DHLMT(:,ISEA), & - CX(ISEA), CY(ISEA), DCXDX(IY,IX), & - DCXDY(IY,IX), DCYDX(IY,IX), DCYDY(IY,IX), & - DCDX(:,IY,IX), DCDY(:,IY,IX), VA(:,JSEA) ) -#endif - ! - ELSE - J = 1 + IF ( MAPSTA(IY,IX) .EQ. 1 ) THEN + DEPTH = MAX ( DMIN , DW(ISEA) ) + IF (LPDLIB) THEN + IXrel = JSEA + ELSE + IXrel = IX + END IF ! + IF( GTYPE .EQ. SMCTYPE ) THEN + J = 1 +#ifdef W3_SMC + !!Li Refraction and GCT in theta direction is done by rotation. + CALL W3KRTN ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DHDX(ISEA), DHDY(ISEA), DHLMT(:,ISEA), & + CX(ISEA), CY(ISEA), DCXDX(IY,IX), & + DCXDY(IY,IX), DCYDX(IY,IX), DCYDY(IY,IX), & + DCDX(:,IY,IX), DCDY(:,IY,IX), VA(:,JSEA) ) +#endif + ! + ELSE + J = 1 + ! #ifdef W3_PR1 - CALL W3KTP1 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & - CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & - DCYDX(IY,IXrel), DCYDY(IY,IXrel), & - DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) + CALL W3KTP1 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & + CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & + DCYDX(IY,IXrel), DCYDY(IY,IXrel), & + DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) #endif #ifdef W3_PR2 - CALL W3KTP2 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & - CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & - DCYDX(IY,IXrel), DCYDY(IY,IXrel), & - DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) + CALL W3KTP2 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & + CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & + DCYDX(IY,IXrel), DCYDY(IY,IXrel), & + DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) #endif #ifdef W3_PR3 - CALL W3KTP3 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & - CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & - DCYDX(IY,IXrel), DCYDY(IY,IXrel), & - DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA), & - CFLTHMAX(JSEA), CFLKMAX(JSEA) ) -#endif + CALL W3KTP3 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & + CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & + DCYDX(IY,IXrel), DCYDY(IY,IXrel), & + DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA), & + CFLTHMAX(JSEA), CFLKMAX(JSEA) ) +#endif + ! + END IF !! GTYPE ! - END IF !! GTYPE - ! - END IF - END DO - ! + END IF + END DO + ! #ifdef W3_OMPG - !$OMP END DO - !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL #endif - ! - END DO - END IF + ! + END DO + END IF - call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 16') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 16') #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before spatial advection", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before spatial advection", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("Before spatial advection") + CALL PRINT_MY_TIME("Before spatial advection") #endif - ! - ! 3.6.3 Longitude-latitude - ! (time step correction in routine) - ! - IF (GTYPE .EQ. UNGTYPE) THEN - IF (FLAGLL) THEN - FACX = 1./(DERA * RADIUS) - ELSE - FACX = 1. + ! + ! 3.6.3 Longitude-latitude + ! (time step correction in routine) + ! + IF (GTYPE .EQ. UNGTYPE) THEN + IF (FLAGLL) THEN + FACX = 1./(DERA * RADIUS) + ELSE + FACX = 1. + END IF END IF - END IF - IF (LPDLIB) THEN - ! + IF (LPDLIB) THEN + ! #ifdef W3_PDLIB - IF (FLCX .or. FLCY) THEN - IF (.NOT. FSTOTALIMP .AND. .NOT. FSTOTALEXP) THEN - DO ISPEC=1,NSPEC - CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) - END DO + IF (FLCX .or. FLCY) THEN + IF (.NOT. FSTOTALIMP .AND. .NOT. FSTOTALEXP) THEN + DO ISPEC=1,NSPEC + CALL PDLIB_W3XYPUG ( ISPEC, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) + END DO + END IF END IF - END IF #endif - ! + ! #ifdef W3_PDLIB - IF (FSTOTALIMP .and. (IT .ne. 0)) THEN + IF (FSTOTALIMP .and. (IT .ne. 0)) THEN #endif #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before Block implicit", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "Before Block implicit", 1) #endif #ifdef W3_PDLIB - CALL PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) + CALL PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PDLIB - ELSE IF(FSTOTALEXP .and. (IT .ne. 0)) THEN + ELSE IF(FSTOTALEXP .and. (IT .ne. 0)) THEN #endif #ifdef W3_PDLIB - CALL PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) + CALL PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACX, DTG, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PDLIB - ENDIF + ENDIF #endif - ELSE - IF (FLCX .or. FLCY) THEN - ! + ELSE + IF (FLCX .or. FLCY) THEN + ! #ifdef W3_MPI - IF ( NRQSG1 .GT. 0 ) THEN - CALL MPI_STARTALL (NRQSG1, IRQSG1(1,1), IERR_MPI) - CALL MPI_STARTALL (NRQSG1, IRQSG1(1,2), IERR_MPI) - END IF + IF ( NRQSG1 .GT. 0 ) THEN + CALL MPI_STARTALL (NRQSG1, IRQSG1(1,1), IERR_MPI) + CALL MPI_STARTALL (NRQSG1, IRQSG1(1,2), IERR_MPI) + END IF #endif - ! - ! - ! Initialize FIELD variable - FIELD = 0. - ! - DO ISPEC=1, NSPEC - IF ( IAPPRO(ISPEC) .EQ. IAPROC ) THEN - ! - IF( GTYPE .EQ. SMCTYPE ) THEN - IX = 1 + ! + ! + ! Initialize FIELD variable + FIELD = 0. + ! + DO ISPEC=1, NSPEC + IF ( IAPPRO(ISPEC) .EQ. IAPROC ) THEN + ! + IF( GTYPE .EQ. SMCTYPE ) THEN + IX = 1 #ifdef W3_SMC - !!Li Use SMC sub to gether field - CALL W3GATHSMC ( ISPEC, FIELD ) + !!Li Use SMC sub to gether field + CALL W3GATHSMC ( ISPEC, FIELD ) #endif - ELSE IF (.NOT.LPDLIB ) THEN - CALL W3GATH ( ISPEC, FIELD ) - END IF !! GTYPE - ! - IF (GTYPE .EQ. SMCTYPE) THEN - IX = 1 + ELSE IF (.NOT.LPDLIB ) THEN + CALL W3GATH ( ISPEC, FIELD ) + END IF !! GTYPE + ! + IF (GTYPE .EQ. SMCTYPE) THEN + IX = 1 #ifdef W3_SMC - !!Li Propagation on SMC grid uses UNO2 scheme. - CALL W3PSMC ( ISPEC, DTG, FIELD ) + !!Li Propagation on SMC grid uses UNO2 scheme. + CALL W3PSMC ( ISPEC, DTG, FIELD ) #endif - ! - ELSE IF (GTYPE .EQ. UNGTYPE) THEN - IX = 1 + ! + ELSE IF (GTYPE .EQ. UNGTYPE) THEN + IX = 1 #ifdef W3_MPI - IF (.NOT. LPDLIB) THEN + IF (.NOT. LPDLIB) THEN #endif #ifdef W3_PR1 - CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) + CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PR2 - CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) + CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_PR3 - CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) + CALL W3XYPUG ( ISPEC, FACX, FACX, DTG, FIELD, VGX, VGY, UGDTUPDATE ) #endif #ifdef W3_MPI - END IF + END IF #endif - ! - ELSE - IX = 1 + ! + ELSE + IX = 1 #ifdef W3_PR1 - CALL W3XYP1 ( ISPEC, DTG, MAPSTA, FIELD, VGX, VGY ) + CALL W3XYP1 ( ISPEC, DTG, MAPSTA, FIELD, VGX, VGY ) #endif #ifdef W3_PR2 - CALL W3XYP2 ( ISPEC, DTG, MAPSTA, MAPFS, FIELD, VGX, VGY ) + CALL W3XYP2 ( ISPEC, DTG, MAPSTA, MAPFS, FIELD, VGX, VGY ) #endif #ifdef W3_PR3 - CALL W3XYP3 ( ISPEC, DTG, MAPSTA, MAPFS, FIELD, VGX, VGY ) + CALL W3XYP3 ( ISPEC, DTG, MAPSTA, MAPFS, FIELD, VGX, VGY ) #endif + ! + END IF !! GTYPE ! - END IF !! GTYPE - ! - IF( GTYPE .EQ. SMCTYPE ) THEN - IX = 1 + IF( GTYPE .EQ. SMCTYPE ) THEN + IX = 1 #ifdef W3_SMC - !!Li Use SMC sub to scatter field - CALL W3SCATSMC ( ISPEC, MAPSTA, FIELD ) + !!Li Use SMC sub to scatter field + CALL W3SCATSMC ( ISPEC, MAPSTA, FIELD ) #endif - ELSE IF (.NOT.LPDLIB ) THEN - CALL W3SCAT ( ISPEC, MAPSTA, FIELD ) - END IF !! GTYPE + ELSE IF (.NOT.LPDLIB ) THEN + CALL W3SCAT ( ISPEC, MAPSTA, FIELD ) + END IF !! GTYPE - END IF - END DO - ! + END IF + END DO + ! #ifdef W3_MPI - IF ( NRQSG1 .GT. 0 ) THEN - ALLOCATE ( STATCO(MPI_STATUS_SIZE,NRQSG1) ) - CALL MPI_WAITALL (NRQSG1, IRQSG1(1,1), STATCO, IERR_MPI) - CALL MPI_WAITALL (NRQSG1, IRQSG1(1,2), STATCO, IERR_MPI) - DEALLOCATE ( STATCO ) - END IF + IF ( NRQSG1 .GT. 0 ) THEN + ALLOCATE ( STATCO(MPI_STATUS_SIZE,NRQSG1) ) + CALL MPI_WAITALL (NRQSG1, IRQSG1(1,1), STATCO, IERR_MPI) + CALL MPI_WAITALL (NRQSG1, IRQSG1(1,2), STATCO, IERR_MPI) + DEALLOCATE ( STATCO ) + END IF #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 17') - ! - !Li Initialise IK IX IY in case ARC option is not used to avoid warnings. - IK=1 - IX=1 - IY=1 + call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 17') + ! + !Li Initialise IK IX IY in case ARC option is not used to avoid warnings. + IK=1 + IX=1 + IY=1 #ifdef W3_SMC - !Li Find source boundary spectra and assign to SPCBAC - IF( ARCTC ) THEN - - DO IK = 1, NBAC - IF( IK .LE. (NBAC-NBGL) ) THEN - IY = ICLBAC(IK) - ELSE - IY = NGLO + IK - ENDIF + !Li Find source boundary spectra and assign to SPCBAC + IF( ARCTC ) THEN + + DO IK = 1, NBAC + IF( IK .LE. (NBAC-NBGL) ) THEN + IY = ICLBAC(IK) + ELSE + IY = NGLO + IK + ENDIF - !Li Work out root PE (ISPEC) and JSEA numbers for IY + !Li Work out root PE (ISPEC) and JSEA numbers for IY #ifdef W3_DIST - ISPEC = MOD( IY-1, NAPROC ) - JSEA = 1 + (IY - ISPEC - 1)/NAPROC + ISPEC = MOD( IY-1, NAPROC ) + JSEA = 1 + (IY - ISPEC - 1)/NAPROC #endif #ifdef W3_SHRD - ISPEC = 0 - JSEA = IY + ISPEC = 0 + JSEA = IY #endif #endif - ! W3_SMC ... - ! + ! W3_SMC ... + ! #ifdef W3_SMC - !!Li Assign boundary cell spectra. - IF( IAPROC .EQ. ISPEC+1 ) THEN - SPCBAC(:,IK)=VA(:,JSEA) - ENDIF + !!Li Assign boundary cell spectra. + IF( IAPROC .EQ. ISPEC+1 ) THEN + SPCBAC(:,IK)=VA(:,JSEA) + ENDIF #endif - ! + ! #ifdef W3_SMC - !!Li Broadcast local SPCBAC(:,IK) to all other PEs. + !!Li Broadcast local SPCBAC(:,IK) to all other PEs. #ifdef W3_MPI - CALL MPI_BCAST(SPCBAC(1,IK),NSPEC,MPI_REAL,ISPEC,MPI_COMM_WAVE,IERR_MPI) - CALL MPI_BARRIER (MPI_COMM_WAVE,IERR_MPI) + CALL MPI_BCAST(SPCBAC(1,IK),NSPEC,MPI_REAL,ISPEC,MPI_COMM_WAVE,IERR_MPI) + CALL MPI_BARRIER (MPI_COMM_WAVE,IERR_MPI) #endif #endif - ! + ! #ifdef W3_SMC - END DO !! Loop IK ends. + END DO !! Loop IK ends. #endif - ! + ! #ifdef W3_SMC - !!Li Update Arctic boundary cell spectra if within local range - ALLOCATE ( BACSPEC(NSPEC) ) - DO IK = 1, NBAC - IF( IK .LE. (NBAC-NBGL) ) THEN - IX = NGLO + IK - BACANGL = ANGARC(IK) - ELSE - IX = ICLBAC(IK) - BACANGL = - ANGARC(IK) - ENDIF + !!Li Update Arctic boundary cell spectra if within local range + ALLOCATE ( BACSPEC(NSPEC) ) + DO IK = 1, NBAC + IF( IK .LE. (NBAC-NBGL) ) THEN + IX = NGLO + IK + BACANGL = ANGARC(IK) + ELSE + IX = ICLBAC(IK) + BACANGL = - ANGARC(IK) + ENDIF - !!Li Work out boundary PE (ISPEC) and JSEA numbers for IX + !!Li Work out boundary PE (ISPEC) and JSEA numbers for IX #ifdef W3_DIST - ISPEC = MOD( IX-1, NAPROC ) - JSEA = 1 + (IX - ISPEC - 1)/NAPROC + ISPEC = MOD( IX-1, NAPROC ) + JSEA = 1 + (IX - ISPEC - 1)/NAPROC #endif #ifdef W3_SHRD - ISPEC = 0 - JSEA = IX + ISPEC = 0 + JSEA = IX #endif #endif - ! + ! #ifdef W3_SMC - IF( IAPROC .EQ. ISPEC+1 ) THEN - BACSPEC = SPCBAC(:,IK) + IF( IAPROC .EQ. ISPEC+1 ) THEN + BACSPEC = SPCBAC(:,IK) - CALL w3acturn( NTH, NK, BACANGL, BACSPEC ) + CALL w3acturn( NTH, NK, BACANGL, BACSPEC ) - VA(:,JSEA) = BACSPEC - !!Li WRITE(NDSE,*) "IAPROC, IX, JSEAx, IK=", IAPROC, IX, JSEA, IK - ENDIF + VA(:,JSEA) = BACSPEC + !!Li WRITE(NDSE,*) "IAPROC, IX, JSEAx, IK=", IAPROC, IX, JSEA, IK + ENDIF - END DO !! Loop IK ends. - DEALLOCATE ( BACSPEC ) + END DO !! Loop IK ends. + DEALLOCATE ( BACSPEC ) - ENDIF !! ARCTC + ENDIF !! ARCTC #endif + ! + ! End of test FLCX.OR.FLCY + END IF ! - ! End of test FLCX.OR.FLCY END IF - ! - END IF #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After spatial advection", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After spatial advection", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("After spatial advection") + CALL PRINT_MY_TIME("After spatial advection") #endif - ! - ! 3.6.4 Intra-spectral part 2 - ! - IF ( FLCTH .OR. FLCK ) THEN - DO ITLOC=ITLOCH+1, NTLOC - ! + ! + ! 3.6.4 Intra-spectral part 2 + ! + IF ( FLCTH .OR. FLCK ) THEN + DO ITLOC=ITLOCH+1, NTLOC + ! #ifdef W3_OMPG - !$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH,IXrel) - !$OMP DO SCHEDULE (DYNAMIC,1) + !$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DEPTH,IXrel) + !$OMP DO SCHEDULE (DYNAMIC,1) #endif - ! - DO JSEA = 1, NSEAL + ! + DO JSEA = 1, NSEAL - CALL INIT_GET_ISEA(ISEA, JSEA) - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) - DEPTH = MAX ( DMIN , DW(ISEA) ) + CALL INIT_GET_ISEA(ISEA, JSEA) + IX = MAPSF(ISEA,1) + IY = MAPSF(ISEA,2) + DEPTH = MAX ( DMIN , DW(ISEA) ) - IF ( GTYPE .EQ. UNGTYPE ) THEN - IF (LPDLIB) THEN + IF ( GTYPE .EQ. UNGTYPE ) THEN + IF (LPDLIB) THEN #ifdef W3_PDLIB - IF (IOBP_LOC(JSEA) .NE. 1) CYCLE + IF (IOBP_LOC(JSEA) .NE. 1) CYCLE #endif - ELSE - IF (IOBP(ISEA) .NE. 1) CYCLE + ELSE + IF (IOBP(ISEA) .NE. 1) CYCLE + ENDIF ENDIF - ENDIF - IF ( MAPSTA(IY,IX) .EQ. 1 ) THEN - IF (LPDLIB) THEN - IXrel = JSEA - ELSE - IXrel = IX - END IF - ! - IF( GTYPE .EQ. SMCTYPE ) THEN - J = 1 -#ifdef W3_SMC - !!Li Refraction and GCT in theta direction is done by rotation. - CALL W3KRTN ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DHDX(ISEA), DHDY(ISEA), DHLMT(:,ISEA), & - CX(ISEA), CY(ISEA), DCXDX(IY,IX), & - DCXDY(IY,IX), DCYDX(IY,IX), DCYDY(IY,IX), & - DCDX(:,IY,IX), DCDY(:,IY,IX), VA(:,JSEA) ) -#endif + IF ( MAPSTA(IY,IX) .EQ. 1 ) THEN + IF (LPDLIB) THEN + IXrel = JSEA + ELSE + IXrel = IX + END IF ! - ELSE - J = 1 + IF( GTYPE .EQ. SMCTYPE ) THEN + J = 1 +#ifdef W3_SMC + !!Li Refraction and GCT in theta direction is done by rotation. + CALL W3KRTN ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DHDX(ISEA), DHDY(ISEA), DHLMT(:,ISEA), & + CX(ISEA), CY(ISEA), DCXDX(IY,IX), & + DCXDY(IY,IX), DCYDX(IY,IX), DCYDY(IY,IX), & + DCDX(:,IY,IX), DCDY(:,IY,IX), VA(:,JSEA) ) +#endif + ! + ELSE + J = 1 #ifdef W3_PR1 - CALL W3KTP1 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & - CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & - DCYDX(IY,IXrel), DCYDY(IY,IXrel), & - DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) + CALL W3KTP1 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & + CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & + DCYDX(IY,IXrel), DCYDY(IY,IXrel), & + DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) #endif #ifdef W3_PR2 - CALL W3KTP2 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & - CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & - DCYDX(IY,IXrel), DCYDY(IY,IXrel), & - DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) + CALL W3KTP2 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & + CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & + DCYDX(IY,IXrel), DCYDY(IY,IXrel), & + DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA)) #endif #ifdef W3_PR3 - CALL W3KTP3 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & - CG(:,ISEA), WN(:,ISEA), DEPTH, & - DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & - CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & - DCYDX(IY,IXrel), DCYDY(IY,IXrel), & - DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA), & - CFLTHMAX(JSEA), CFLKMAX(JSEA) ) -#endif + CALL W3KTP3 ( ISEA, FACTH, FACK, CTHG0S(ISEA), & + CG(:,ISEA), WN(:,ISEA), DEPTH, & + DDDX(IY,IXrel), DDDY(IY,IXrel), CX(ISEA), & + CY(ISEA), DCXDX(IY,IXrel), DCXDY(IY,IXrel), & + DCYDX(IY,IXrel), DCYDY(IY,IXrel), & + DCDX(:,IY,IXrel), DCDY(:,IY,IXrel), VA(:,JSEA), & + CFLTHMAX(JSEA), CFLKMAX(JSEA) ) +#endif + ! + END IF !! GTYPE ! - END IF !! GTYPE - ! - END IF - END DO - ! + END IF + END DO + ! #ifdef W3_OMPG - !$OMP END DO - !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL #endif - ! - END DO - END IF + ! + END DO + END IF #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After intraspectral adv.", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After intraspectral adv.", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("fter intraspectral adv.") + CALL PRINT_MY_TIME("fter intraspectral adv.") #endif - - ! - UGDTUPDATE = .FALSE. - ! - ! 3.6 End propapgation = = = = = = = = = = = = = = = = = = = = = = = = + ! + UGDTUPDATE = .FALSE. + ! + ! 3.6 End propapgation = = = = = = = = = = = = = = = = = = = = = = = = + END IF ! 3.7 Calculate and integrate source terms. ! -370 CONTINUE - IF ( FLSOU ) THEN - ! - D50=0.0002 - REFLEC(:)=0. - REFLED(:)=0 - PSIC=0. + IF ( IT.EQ.0 ) DTG = 1. + ! + IF ( .NOT. FLDRY .AND. IAPROC.LE.NAPROC) THEN + IF ( FLSOU ) THEN + ! + D50=0.0002 + REFLEC(:)=0. + REFLED(:)=0 + PSIC=0. #ifdef W3_PDLIB #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'ITIME=', ITIME, ' IT=', IT - CALL ALL_VAOLD_INTEGRAL_PRINT("VAOLD before W3SRCE_IMP_POST", 1) - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA before W3SRCE_IMP_POST", 1) - IF (DEBUG_NODE .le. NSEAL) THEN - WRITE(740+IAPROC,*) ' Values for DEBUG_NODE=', DEBUG_NODE - WRITE(740+IAPROC,*) ' sum(VA)=', sum(VA(:,DEBUG_NODE)) - WRITE(740+IAPROC,*) ' sum(VAOLD)=', sum(VAOLD(:,DEBUG_NODE)) - WRITE(740+IAPROC,*) ' sum(VSTOT)=', sum(VSTOT(:,DEBUG_NODE)) - WRITE(740+IAPROC,*) ' sum(VDTOT)=', sum(VDTOT(:,DEBUG_NODE)) - END IF + WRITE(740+IAPROC,*) 'ITIME=', ITIME, ' IT=', IT + CALL ALL_VAOLD_INTEGRAL_PRINT("VAOLD before W3SRCE_IMP_POST", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA before W3SRCE_IMP_POST", 1) + IF (DEBUG_NODE .le. NSEAL) THEN + WRITE(740+IAPROC,*) ' Values for DEBUG_NODE=', DEBUG_NODE + WRITE(740+IAPROC,*) ' sum(VA)=', sum(VA(:,DEBUG_NODE)) + WRITE(740+IAPROC,*) ' sum(VAOLD)=', sum(VAOLD(:,DEBUG_NODE)) + WRITE(740+IAPROC,*) ' sum(VSTOT)=', sum(VSTOT(:,DEBUG_NODE)) + WRITE(740+IAPROC,*) ' sum(VDTOT)=', sum(VDTOT(:,DEBUG_NODE)) + END IF #endif #endif - ! + ! #ifdef W3_OMPG - !$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DELA,DELX,DELY, & - !$OMP& REFLEC,REFLED,D50,PSIC,TMP1,TMP2,TMP3,TMP4) - !$OMP DO SCHEDULE (DYNAMIC,1) + !$OMP PARALLEL PRIVATE (JSEA,ISEA,IX,IY,DELA,DELX,DELY, & + !$OMP& REFLEC,REFLED,D50,PSIC,TMP1,TMP2,TMP3,TMP4) + !$OMP DO SCHEDULE (DYNAMIC,1) #endif + ! + DO JSEA=1, NSEAL + CALL INIT_GET_ISEA(ISEA, JSEA) - ! - DO JSEA=1, NSEAL - CALL INIT_GET_ISEA(ISEA, JSEA) - - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) - DELA=1. - DELX=1. - DELY=1. + IX = MAPSF(ISEA,1) + IY = MAPSF(ISEA,2) + DELA=1. + DELX=1. + DELY=1. #ifdef W3_REF1 - IF (GTYPE.EQ.RLGTYPE) THEN - DELX=SX*CLATS(ISEA)/FACX - DELY=SY/FACX - DELA=DELX*DELY - END IF - IF (GTYPE.EQ.CLGTYPE) THEN - ! Maybe what follows works also for RLGTYPE ... to be verified - DELX=HPFAC(IY,IX)/ FACX - DELY=HQFAC(IY,IX)/ FACX - DELA=DELX*DELY - END IF + IF (GTYPE.EQ.RLGTYPE) THEN + DELX=SX*CLATS(ISEA)/FACX + DELY=SY/FACX + DELA=DELX*DELY + END IF + IF (GTYPE.EQ.CLGTYPE) THEN + ! Maybe what follows works also for RLGTYPE ... to be verified + DELX=HPFAC(IY,IX)/ FACX + DELY=HQFAC(IY,IX)/ FACX + DELA=DELX*DELY + END IF #endif - ! + ! #ifdef W3_REF1 - REFLEC=REFLC(:,ISEA) - REFLEC(4)=BERG(ISEA)*REFLEC(4) - REFLED=REFLD(:,ISEA) + REFLEC=REFLC(:,ISEA) + REFLEC(4)=BERG(ISEA)*REFLEC(4) + REFLED=REFLD(:,ISEA) #endif #ifdef W3_BT4 - D50=SED_D50(ISEA) - PSIC=SED_PSIC(ISEA) + D50=SED_D50(ISEA) + PSIC=SED_PSIC(ISEA) #endif - - IF ( MAPSTA(IY,IX) .EQ. 1 .AND. FLAGST(ISEA)) THEN - TMP1 = WHITECAP(JSEA,1:4) - TMP2 = BEDFORMS(JSEA,1:3) - TMP3 = TAUBBL(JSEA,1:2) - TMP4 = TAUICE(JSEA,1:2) + IF ( MAPSTA(IY,IX) .EQ. 1 .AND. FLAGST(ISEA)) THEN + TMP1 = WHITECAP(JSEA,1:4) + TMP2 = BEDFORMS(JSEA,1:3) + TMP3 = TAUBBL(JSEA,1:2) + TMP4 = TAUICE(JSEA,1:2) #ifdef W3_PDLIB - IF (FSSOURCE) THEN - CALL W3SRCE(srce_imp_post,IT,ISEA,JSEA,IX,IY,IMOD, & - VAOLD(:,JSEA), VA(:,JSEA), & - VSioDummy,VDioDummy,SHAVETOT(JSEA), & - ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & - CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & - U10D(ISEA), & + IF (FSSOURCE) THEN + CALL W3SRCE(srce_imp_post,IT,ISEA,JSEA,IX,IY,IMOD, & + VAOLD(:,JSEA), VA(:,JSEA), & + VSioDummy,VDioDummy,SHAVETOT(JSEA), & + ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & + CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & + U10D(ISEA), & #ifdef W3_FLX5 - TAUA(ISEA), TAUADIR(ISEA), & -#endif - AS(ISEA), UST(ISEA), & - USTDIR(ISEA), CX(ISEA), CY(ISEA), & - ICE(ISEA), ICEH(ISEA), ICEF(ISEA), & - ICEDMAX(ISEA), & - REFLEC, REFLED, DELX, DELY, DELA, & - TRNX(IY,IX), TRNY(IY,IX), BERG(ISEA), & - FPIS(ISEA), DTDYN(JSEA), & - FCUT(JSEA), DTG, TAUWX(JSEA), TAUWY(JSEA), & - TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & - TAUWIY(JSEA), TAUWNX(JSEA), & - TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & - TWS(JSEA),PHIOC(JSEA), TMP1, D50, PSIC, TMP2, & - PHIBBL(JSEA), TMP3, TMP4, PHICE(JSEA), & - TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & - RHOAIR(ISEA), ASF(ISEA)) - ELSE + TAUA(ISEA), TAUADIR(ISEA), & +#endif + AS(ISEA), UST(ISEA), & + USTDIR(ISEA), CX(ISEA), CY(ISEA), & + ICE(ISEA), ICEH(ISEA), ICEF(ISEA), & + ICEDMAX(ISEA), & + REFLEC, REFLED, DELX, DELY, DELA, & + TRNX(IY,IX), TRNY(IY,IX), BERG(ISEA), & + FPIS(ISEA), DTDYN(JSEA), & + FCUT(JSEA), DTG, TAUWX(JSEA), TAUWY(JSEA), & + TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & + TAUWIY(JSEA), TAUWNX(JSEA), & + TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & + TWS(JSEA),PHIOC(JSEA), TMP1, D50, PSIC, TMP2, & + PHIBBL(JSEA), TMP3, TMP4, PHICE(JSEA), & + TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & + RHOAIR(ISEA), ASF(ISEA)) + ELSE #endif - CALL W3SRCE(srce_direct, IT, ISEA, JSEA, IX, IY, IMOD, & - VAoldDummy, VA(:,JSEA), & - VSioDummy, VDioDummy, SHAVETOTioDummy, & - ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & - CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & - U10D(ISEA), & + CALL W3SRCE(srce_direct, IT, ISEA, JSEA, IX, IY, IMOD, & + VAoldDummy, VA(:,JSEA), & + VSioDummy, VDioDummy, SHAVETOTioDummy, & + ALPHA(1:NK,JSEA), WN(1:NK,ISEA), & + CG(1:NK,ISEA), CLATS(ISEA), DW(ISEA), U10(ISEA), & + U10D(ISEA), & #ifdef W3_FLX5 - TAUA(ISEA), TAUADIR(ISEA), & -#endif - AS(ISEA), UST(ISEA), & - USTDIR(ISEA), CX(ISEA), CY(ISEA), & - ICE(ISEA), ICEH(ISEA), ICEF(ISEA), & - ICEDMAX(ISEA), & - REFLEC, REFLED, DELX, DELY, DELA, & - TRNX(IY,IX), TRNY(IY,IX), BERG(ISEA), & - FPIS(ISEA), DTDYN(JSEA), & - FCUT(JSEA), DTG, TAUWX(JSEA), TAUWY(JSEA), & - TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & - TAUWIY(JSEA), TAUWNX(JSEA), & - TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & - TWS(JSEA), PHIOC(JSEA), TMP1, D50, PSIC,TMP2, & - PHIBBL(JSEA), TMP3, TMP4 , PHICE(JSEA), & - TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & - RHOAIR(ISEA), ASF(ISEA)) + TAUA(ISEA), TAUADIR(ISEA), & +#endif + AS(ISEA), UST(ISEA), & + USTDIR(ISEA), CX(ISEA), CY(ISEA), & + ICE(ISEA), ICEH(ISEA), ICEF(ISEA), & + ICEDMAX(ISEA), & + REFLEC, REFLED, DELX, DELY, DELA, & + TRNX(IY,IX), TRNY(IY,IX), BERG(ISEA), & + FPIS(ISEA), DTDYN(JSEA), & + FCUT(JSEA), DTG, TAUWX(JSEA), TAUWY(JSEA), & + TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & + TAUWIY(JSEA), TAUWNX(JSEA), & + TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & + TWS(JSEA), PHIOC(JSEA), TMP1, D50, PSIC,TMP2, & + PHIBBL(JSEA), TMP3, TMP4 , PHICE(JSEA), & + TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & + RHOAIR(ISEA), ASF(ISEA)) #ifdef W3_PDLIB - END IF + END IF #endif - WHITECAP(JSEA,1:4) = TMP1 - BEDFORMS(JSEA,1:3) = TMP2 - TAUBBL(JSEA,1:2) = TMP3 - TAUICE(JSEA,1:2) = TMP4 - ELSE - UST (ISEA) = UNDEF - USTDIR(ISEA) = UNDEF - DTDYN (JSEA) = UNDEF - FCUT (JSEA) = UNDEF - ! VA(:,JSEA) = 0. - END IF - END DO + WHITECAP(JSEA,1:4) = TMP1 + BEDFORMS(JSEA,1:3) = TMP2 + TAUBBL(JSEA,1:2) = TMP3 + TAUICE(JSEA,1:2) = TMP4 + ELSE + UST (ISEA) = UNDEF + USTDIR(ISEA) = UNDEF + DTDYN (JSEA) = UNDEF + FCUT (JSEA) = UNDEF + ! VA(:,JSEA) = 0. + END IF + END DO - ! + ! #ifdef W3_OMPG - !$OMP END DO - !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL #endif - ! + ! #ifdef W3_PDLIB #ifdef W3_DEBUGSRC - WRITE(740+IAPROC,*) 'ITIME=', ITIME, ' IT=', IT - CALL ALL_VAOLD_INTEGRAL_PRINT("VAOLD after W3SRCE_IMP_PRE_POST", 1) - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA after W3SRCE_IMP_PRE_POST", 1) - IF (DEBUG_NODE .le. NSEAL) THEN - WRITE(740+IAPROC,*) ' Values for DEBUG_NODE=', DEBUG_NODE - WRITE(740+IAPROC,*) ' sum(VA)=', sum(VA(:,DEBUG_NODE)) - WRITE(740+IAPROC,*) ' min/max(VA)=', minval(VA(:,DEBUG_NODE)), maxval(VA(:,DEBUG_NODE)) - END IF + WRITE(740+IAPROC,*) 'ITIME=', ITIME, ' IT=', IT + CALL ALL_VAOLD_INTEGRAL_PRINT("VAOLD after W3SRCE_IMP_PRE_POST", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "VA after W3SRCE_IMP_PRE_POST", 1) + IF (DEBUG_NODE .le. NSEAL) THEN + WRITE(740+IAPROC,*) ' Values for DEBUG_NODE=', DEBUG_NODE + WRITE(740+IAPROC,*) ' sum(VA)=', sum(VA(:,DEBUG_NODE)) + WRITE(740+IAPROC,*) ' min/max(VA)=', minval(VA(:,DEBUG_NODE)), maxval(VA(:,DEBUG_NODE)) + END IF #endif #endif - END IF + END IF #ifdef W3_DEBUGCOH - CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After source terms", 1) + CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After source terms", 1) #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("After source terms") + CALL PRINT_MY_TIME("After source terms") #endif - ! - ! End of interations for DTMAX < 1s - ! + ! + ! End of interations for DTMAX < 1s + ! + END IF #ifdef W3_SEC1 IF (IT.EQ.0) EXIT END DO - IF (IT.GT.0) DTG=DTGTEMP + IF (IT.GT.0 .AND. .NOT. FLDRY .AND. IAPROC.LE.NAPROC) DTG=DTGTEMP #endif - - - +#ifdef W3_T + IF ( FLDRY .OR. IAPROC.GT.NAPROC ) WRITE (NDST,9023) +#endif ! ! ! 3.8 Update global time step. ! (Branch point FLDRY, IT=0) ! -380 CONTINUE ! IF (IT.NE.NT) THEN DTTST = DSEC21 ( TIME , TCALC ) @@ -2342,20 +2334,20 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! END DO + IF ( .NOT. FLZERO ) THEN #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("W3WAVE, step 6.21.1") + CALL PRINT_MY_TIME("W3WAVE, step 6.21.1") #endif - ! + ! #ifdef W3_T - WRITE (NDST,9030) + WRITE (NDST,9030) #endif - call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE END TIME LOOP') + call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE END TIME LOOP') + END IF ! ! End of loop over time steps ! ==================================================================== / ! -400 CONTINUE - ! ! 4. Perform output to file if requested ---------------------------- / ! 4.a Check if time is output time ! Delay if data assimilation time. diff --git a/model/src/wmesmfmd.F90 b/model/src/wmesmfmd.F90 index 8daff8e1cb..fbeb84a9ad 100644 --- a/model/src/wmesmfmd.F90 +++ b/model/src/wmesmfmd.F90 @@ -2011,6 +2011,7 @@ subroutine DataInitialize ( gcomp, rc ) !/ +-----------------------------------+ !/ !/ 20-Jan-2017 : Origination. ( version 6.02 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -2138,71 +2139,72 @@ subroutine DataInitialize ( gcomp, rc ) ! ! If not all import dependencies are satisfied, then return ! - if (.not.allUpdated) goto 1 - ! - ! -------------------------------------------------------------------- / - ! 2. All import dependencies are satisfied, so finish initialization - ! - ! 2.a Report all import dependencies are satisfied - ! - write(msg,'(a)') trim(cname)// & - ': all inter-model data dependencies SATISFIED' - if (verbosity.gt.0) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - if (improc.eq.nmpscr) write(*,'(a)') trim(msg) - ! - ! 2.b Setup background blending mask for each import field - ! - do i = 1,numImpFields - if (.not.impFieldActive(i)) cycle - if (.not.mbgFieldActive(i)) cycle - call SetupImpBmsk(bmskField(i), impField(i), missingValue, rc) + if (allUpdated) then + ! + ! -------------------------------------------------------------------- / + ! 2. All import dependencies are satisfied, so finish initialization + ! + ! 2.a Report all import dependencies are satisfied + ! + write(msg,'(a)') trim(cname)// & + ': all inter-model data dependencies SATISFIED' + if (verbosity.gt.0) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (improc.eq.nmpscr) write(*,'(a)') trim(msg) + ! + ! 2.b Setup background blending mask for each import field + ! + do i = 1,numImpFields + if (.not.impFieldActive(i)) cycle + if (.not.mbgFieldActive(i)) cycle + call SetupImpBmsk(bmskField(i), impField(i), missingValue, rc) + if (ESMF_LogFoundError(rc, PASSTHRU)) return + enddo + ! + ! 2.c Get import fields + ! + call GetImport(gcomp, rc) if (ESMF_LogFoundError(rc, PASSTHRU)) return - enddo - ! - ! 2.c Get import fields - ! - call GetImport(gcomp, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return - ! - ! 2.d Finish initialization (compute initial state), if not restart - ! - do imod = 1,nrgrd - call w3setg ( imod, mdse, mdst ) - call w3setw ( imod, mdse, mdst ) - call w3seta ( imod, mdse, mdst ) - call w3seti ( imod, mdse, mdst ) - call w3seto ( imod, mdse, mdst ) - call wmsetm ( imod, mdse, mdst ) - local = iaproc .gt. 0 .and. iaproc .le. naproc - if ( local .and. flcold .and. fliwnd ) call w3uini( va ) - enddo - ! - ! 2.e Set export fields - ! - call SetExport(gcomp, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return - ! - ! 2.f Set Updated Field Attribute to "true", indicating to the - ! generic code to set the timestamp for these fields - ! - do i = 1,numExpFields - if (.not.expFieldActive(i)) cycle - call NUOPC_SetAttribute(expField(i), name="Updated", & + ! + ! 2.d Finish initialization (compute initial state), if not restart + ! + do imod = 1,nrgrd + call w3setg ( imod, mdse, mdst ) + call w3setw ( imod, mdse, mdst ) + call w3seta ( imod, mdse, mdst ) + call w3seti ( imod, mdse, mdst ) + call w3seto ( imod, mdse, mdst ) + call wmsetm ( imod, mdse, mdst ) + local = iaproc .gt. 0 .and. iaproc .le. naproc + if ( local .and. flcold .and. fliwnd ) call w3uini( va ) + enddo + ! + ! 2.e Set export fields + ! + call SetExport(gcomp, rc) + if (ESMF_LogFoundError(rc, PASSTHRU)) return + ! + ! 2.f Set Updated Field Attribute to "true", indicating to the + ! generic code to set the timestamp for these fields + ! + do i = 1,numExpFields + if (.not.expFieldActive(i)) cycle + call NUOPC_SetAttribute(expField(i), name="Updated", & + value="true", rc=rc) + if (ESMF_LogFoundError(rc, PASSTHRU)) return + enddo + ! + ! 2.g Set InitializeDataComplete Attribute to "true", indicating to the + ! generic code that all inter-model data dependencies are satisfied + ! + call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", & value="true", rc=rc) if (ESMF_LogFoundError(rc, PASSTHRU)) return - enddo - ! - ! 2.g Set InitializeDataComplete Attribute to "true", indicating to the - ! generic code that all inter-model data dependencies are satisfied - ! - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", & - value="true", rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return + end if ! ! -------------------------------------------------------------------- / ! Post ! -1 rc = ESMF_SUCCESS + rc = ESMF_SUCCESS call ESMF_VMWtime(wftime) wtime(iwt) = wtime(iwt) + wftime - wstime wtcnt(iwt) = wtcnt(iwt) + 1 diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 42ab47e3c6..521717818d 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -59,6 +59,7 @@ MODULE WMINITMD !/ (T. J. Campbell, NRL) !/ 15-May-2018 : Update namelist ( version 6.05 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -177,6 +178,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & !/ (T. J. Campbell, NRL) !/ 28-Oct-2020 : Add SMCTYPE for SMC sub-grid. JGLi ( version 7.13 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -237,6 +239,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! WMIOPP Subr. WMIOPOMD Initialize unified point output. ! ITRACE Subr. W3SERVMD Initialize subroutine tracing. ! STRACE Subr. Id. Subroutine tracing. + ! EXTIOF Subr. Id. Program abort if error I/O file. + ! EXTOPN Subr. Id. Program abort if error opening file. ! EXTCDE Subr. Id. Program abort. ! WWDATE Subr. Id. System date. ! WWTIME Subr. Id. System time. @@ -378,7 +382,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & USE WMINIOMD, ONLY: WMIOBS, WMIOBG, WMIOBF USE WMIOPOMD, ONLY: WMIOPP !/ - USE W3SERVMD, ONLY: ITRACE, EXTCDE, WWDATE, WWTIME, NEXTLN + USE W3SERVMD, ONLY: ITRACE, EXTCDE, EXTOPN, EXTIOF, WWDATE, WWTIME, NEXTLN #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -623,10 +627,11 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,910) IFNAME, MDSI ! - OPEN (MDSI,FILE=TRIM(FNMPRE)//IFNAME,STATUS='OLD',ERR=2000, & - IOSTAT=IERR) + OPEN (MDSI,FILE=TRIM(FNMPRE)//IFNAME,STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINIT','INPUT',2000,NAMEF=IFNAME) REWIND (MDSI) - READ (MDSI,'(A)',END=2001,ERR=2002) COMSTR + READ (MDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) IF (COMSTR.EQ.' ') COMSTR = '$' CALL WMUSET ( MDSS, MDSS, MDSI, .TRUE., 'INP', & TRIM(FNMPRE)//IFNAME, 'Model control input file') @@ -648,7 +653,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif ! IF ( IMPROC .EQ. NMPLOG ) THEN - OPEN (MDSO,FILE=TRIM(FNMPRE)//LFILE,ERR=2010,IOSTAT=IERR) + OPEN (MDSO,FILE=TRIM(FNMPRE)//LFILE,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINIT','LOG',2010) IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,911) LFILE, MDSO CALL WMUSET ( MDSS, MDSS, MDSO, .TRUE., 'OUT', & @@ -660,7 +666,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IF ( MDST.NE.MDSO .AND. MDST.NE.MDSS .AND. TSTOUT ) THEN IFT = LEN_TRIM(TFILE) - OPEN (MDST,FILE=TRIM(FNMPRE)//TFILE(:IFT),ERR=2011,IOSTAT=IERR) + OPEN (MDST,FILE=TRIM(FNMPRE)//TFILE(:IFT),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINIT','TEST',2011) CALL WMUSET ( MDSS, MDST, MDST, .TRUE., 'OUT', & TRIM(FNMPRE)//TFILE(:IFT), 'Test output file') END IF @@ -670,7 +677,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL WMUGET ( MDSS, MDST, MDSP, 'OUT' ) CALL WMUSET ( MDSS, MDST, MDSP, .TRUE., 'OUT', & TRIM(FNMPRE)//PFILE(:IFT), 'Profiling file') - OPEN (MDSP,FILE=TRIM(FNMPRE)//PFILE(:IFT),ERR=2011,IOSTAT=IERR) + OPEN (MDSP,FILE=TRIM(FNMPRE)//PFILE(:IFT),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINIT','TEST',2011) #endif ! ! 1.e Initial and test output @@ -697,8 +705,9 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! Processor set as in W3INIT to minimize communication in WMIOPO ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) NRGRD, NRINP, UNIPTS, & + READ (MDSI,*,IOSTAT=IERR) NRGRD, NRINP, UNIPTS, & IOSTYP, UPPROC, PSHARE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) IOSTYP = MAX ( 0 , MIN ( 3 , IOSTYP ) ) ! IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN @@ -728,8 +737,16 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END IF ! - IF ( NRGRD .LT. 1 ) GOTO 2020 - IF ( NRINP .LT. 0 ) GOTO 2021 + IF ( NRGRD .LT. 1 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1020) + CALL EXTCDE ( 2020 ) + RETURN + END IF + IF ( NRINP .LT. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1021) + CALL EXTCDE ( 2021 ) + RETURN + END IF IF ( NRINP.EQ.0 .AND. .NOT.UNIPTS ) NRINP = -1 ! ! 2.b Set up data structures @@ -820,7 +837,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) CALL W3SETI ( -I, MDSE, MDST ) INFLAGS1 = .FALSE. - READ (MDSI,*,END=2001,ERR=2002) MNAMES(-I), INFLAGS1(JFIRST:9) + READ (MDSI,*,IOSTAT=IERR) MNAMES(-I), INFLAGS1(JFIRST:9) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! END DO ! @@ -835,7 +853,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & NDSE = MDSE ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) MNAMES(0) + READ (MDSI,*,IOSTAT=IERR) MNAMES(0) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! IF ( IOSTYP .LE. 1 ) THEN NMPUPT = MAX(1,NMPROC-2) @@ -849,8 +868,9 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! DO I=NRGRD+1, 2*NRGRD CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) MNAMES(I), TNAMES(:), & + READ (MDSI,*,IOSTAT=IERR) MNAMES(I), TNAMES(:), & TMPRNK(I), TMPGRP(I), RP1(I), RPN(I), BCDTMP(I) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) INAMES(I,:) = TNAMES(:) RP1(I) = MAX ( 0. , MIN ( 1. , RP1(I) ) ) RPN(I) = MAX ( RP1(I) , MIN ( 1. , RPN(I) ) ) @@ -917,8 +937,16 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & EXIT END IF END DO - IF ( INPMAP(I,J) .EQ. 0 ) GOTO 2030 - IF ( .NOT. INPUTS(INPMAP(I,J))%INFLAGS1(J) ) GOTO 2031 + IF ( INPMAP(I,J) .EQ. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) + CALL EXTCDE ( 2030 ) + RETURN + END IF + IF ( .NOT. INPUTS(INPMAP(I,J))%INFLAGS1(J) ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) + CALL EXTCDE ( 2030 ) + RETURN + END IF USEINP(-INPMAP(I,J)) = .TRUE. CPLINP(-INPMAP(I,J)) = .TRUE. END IF @@ -931,8 +959,16 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & EXIT END IF END DO - IF ( INPMAP(I,J) .EQ. 0 ) GOTO 2030 - IF ( .NOT. INPUTS(-INPMAP(I,J))%INFLAGS1(J) ) GOTO 2031 + IF ( INPMAP(I,J) .EQ. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) + CALL EXTCDE ( 2030 ) + RETURN + END IF + IF ( .NOT. INPUTS(-INPMAP(I,J))%INFLAGS1(J) ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1031) INAMES(I,J), J + CALL EXTCDE ( 2031 ) + RETURN + END IF USEINP(INPMAP(I,J)) = .TRUE. END IF END IF @@ -1186,10 +1222,11 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) IF (IS_ESMF_COMPONENT) THEN - READ (MDSI,*,END=2001,ERR=2002) STMPT, ETMPT + READ (MDSI,*,IOSTAT=IERR) STMPT, ETMPT ELSE - READ (MDSI,*,END=2001,ERR=2002) STIME, ETIME + READ (MDSI,*,IOSTAT=IERR) STIME, ETIME END IF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! CALL STME21 ( STIME , DTME21 ) IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSS,941) DTME21 @@ -1204,7 +1241,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSS,943) ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) FLGHG1, FLGHG2 + READ (MDSI,*,IOSTAT=IERR) FLGHG1, FLGHG2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) FLGHG2 = FLGHG1 .AND. FLGHG2 ! IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN @@ -1272,7 +1310,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & READ(WORDS( 5 ), * ) ODAT(20,1) IF (WORDS(6) .EQ. 'T') THEN CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002)(ODAT(I,1),I=5*(8-1)+1,5*8) + READ (MDSI,*,IOSTAT=IERR)(ODAT(I,1),I=5*(8-1)+1,5*8) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ELSE ODAT(5*(8-1)+1,1)=0 ODAT(5*(8-1)+2,1)=0 @@ -1281,7 +1320,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ODAT(5*8,1)=0 END IF ELSE - READ (MDSI,*,END=2001,ERR=2002)(ODAT(I,1),I=5*(J-1)+1,5*J) + READ (MDSI,*,IOSTAT=IERR)(ODAT(I,1),I=5*(J-1)+1,5*J) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) OUTFF(J,1) = 0 END IF ! @@ -1351,14 +1391,17 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF (NPTS.GT.0) THEN ALLOCATE ( X(NPTS), Y(NPTS), PNAMES(NPTS) ) ELSE - GOTO 2054 + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1054) + CALL EXTCDE ( 2054 ) + RETURN END IF END IF ! NPTS = 0 DO CALL NEXTLN ( COMSTR , MDSI2 , MDSE2 ) - READ (MDSI2,*,END=2001,ERR=2002) XX, YY, PN + READ (MDSI2,*,IOSTAT=IERR) XX, YY, PN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! IF ( ILOOP.EQ.1 .AND. IMPROC.EQ.1 ) THEN BACKSPACE (MDSI) @@ -1406,7 +1449,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 5.e Type 3: track output ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) TFLAGI + READ (MDSI,*,IOSTAT=IERR) TFLAGI + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) IF ( .NOT. TFLAGI ) MDS(11,:) = -MDS(11,:) IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN IF ( .NOT. TFLAGI ) THEN @@ -1429,7 +1473,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 5.h Type 6: partitioned wave field data ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) IPRT(:,1), LPRT(1) + READ (MDSI,*,IOSTAT=IERR) IPRT(:,1), LPRT(1) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN WRITE (MDSS,961) IPRT(:,1) IF ( .NOT. LPRT(1) ) THEN @@ -1539,7 +1584,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! DO CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) MN, J + READ (MDSI,*,IOSTAT=IERR) MN, J + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! ! 5.j.1 Bail out loop for output type 0 ! @@ -1552,14 +1598,26 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( MN(:II) .EQ. MNAMES(I)(1:II) ) EXIT END DO ! - IF ( I .GT. NRGRD ) GOTO 2051 + IF ( I .GT. NRGRD ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1051) MN(:II) + CALL EXTCDE ( 2051 ) + RETURN + END IF IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,962) MN(1:II), I ! ! 5.j.3 Check the output type ! - IF ( J.LT.0 .OR. J.GT. NOTYPE ) GOTO 2052 - IF ( J.EQ.2 .AND. UNIPTS ) GOTO 2053 + IF ( J.LT.0 .OR. J.GT. NOTYPE ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1052) J + CALL EXTCDE ( 2052 ) + RETURN + END IF + IF ( J.EQ.2 .AND. UNIPTS ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1053) + CALL EXTCDE ( 2053 ) + RETURN + END IF IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,951) J, IDOTYP(J) ! @@ -1591,7 +1649,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF ! ELSE - READ (MDSI,*,END=2001,ERR=2002)(ODAT(II,I),II=5*(J-1)+1,5*J) + READ (MDSI,*,IOSTAT=IERR)(ODAT(II,I),II=5*(J-1)+1,5*J) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) OUTFF(J,I) = 0 END IF ! @@ -1663,7 +1722,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & OT2(I)%NPTS = 0 DO CALL NEXTLN ( COMSTR , MDSI2 , MDSE2 ) - READ (MDSI2,*,END=2001,ERR=2002) XX, YY, PN + READ (MDSI2,*,IOSTAT=IERR) XX, YY, PN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! IF ( ILOOP.EQ.1 .AND. IMPROC.EQ.1 ) THEN BACKSPACE (MDSI) @@ -1711,7 +1771,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 5.n Type 3: track output ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) TFLAGI + READ (MDSI,*,IOSTAT=IERR) TFLAGI + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) IF ( TFLAGI ) THEN MDS(11,I) = ABS(MDS(11,I)) ELSE @@ -1730,7 +1791,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 5.o Type 6: partitioned wave field data ! CALL NEXTLN ( COMSTR , MDSI , MDSE2 ) - READ (MDSI,*,END=2001,ERR=2002) IPRT(:,I), LPRT(I) + READ (MDSI,*,IOSTAT=IERR) IPRT(:,I), LPRT(I) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN WRITE (MDSS,961) IPRT(:,I) IF ( .NOT. LPRT(I) ) THEN @@ -1803,7 +1865,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & NMOVE = 0 DO CALL NEXTLN ( COMSTR , MDSI2 , MDSE2 ) - READ (MDSI2,*,END=2001,ERR=2002) IDTST + READ (MDSI2,*,IOSTAT=IERR) IDTST + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) ! IF ( ILOOP.EQ.1 .AND. IMPROC.EQ.1 ) THEN BACKSPACE (MDSI) @@ -1818,7 +1881,8 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( ILOOP .EQ. 1 ) CYCLE ! BACKSPACE (MDSI2) - READ (MDSI2,*,END=2001,ERR=2002) IDTST, TTIME, XX, YY + READ (MDSI2,*,IOSTAT=IERR) IDTST, TTIME, XX, YY + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'WMINIT','INPUT',2001) TMOVE(:,NMOVE) = TTIME AMOVE(NMOVE) = XX DMOVE(NMOVE) = YY @@ -1850,7 +1914,11 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END DO #endif ! - IF ( NMOVE .EQ. 0 ) GOTO 2060 + IF ( NMOVE .EQ. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1060) + CALL EXTCDE ( 2060 ) + RETURN + END IF ! NMVMAX = NMOVE DO I=1, NRGRD @@ -2484,7 +2552,10 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & !!Li NX, NY, GTYPE, IERR, MNAMES(I), & NX, NY, JJJ, IERR, MNAMES(I), & TRIM(FNMPRE) ) - IF ( IERR .NE. 0 ) GOTO 2080 + IF ( IERR .NE. 0 ) THEN + CALL EXTCDE ( 2080 ) + RETURN + END IF ! !!Li Print a warning message when GTYPE not matching forcing field one. IF ( (JJJ .NE. GTYPE) .AND. (IMPROC .EQ. NMPSC2) ) & @@ -2748,7 +2819,11 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 8.a.6 Check for coordinate system ! DO I=1, NRGRD-1 - IF ( GRIDS(I)%FLAGLL .NEQV. GRIDS(I+1)%FLAGLL ) GOTO 2070 + IF ( GRIDS(I)%FLAGLL .NEQV. GRIDS(I+1)%FLAGLL ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1070) + CALL EXTCDE ( 2070 ) + RETURN + END IF END DO ! ! 8.b Input files @@ -2780,7 +2855,10 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL W3FLDO ('READ', IDINP(-I,J), MDSF(-I,J), MDST, & MDSE2, NX, NY, GTYPE, IERR, & MNAMES(-I), TRIM(FNMPRE) ) - IF ( IERR .NE. 0 ) GOTO 2080 + IF ( IERR .NE. 0 ) THEN + CALL EXTCDE ( 2080 ) + RETURN + END IF IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) & WRITE (MDSS,985) IDFLDS(J) ELSE @@ -3144,93 +3222,6 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! RETURN ! - ! Escape locations read errors : - ! -2000 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1000) IFNAME, IERR - CALL EXTCDE ( 2000 ) - RETURN - ! -2001 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1001) - CALL EXTCDE ( 2001 ) - RETURN - ! -2002 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1002) IERR - CALL EXTCDE ( 2002 ) - RETURN - ! -2010 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1010) IERR - CALL EXTCDE ( 2010 ) - RETURN - ! -2011 CONTINUE - ! === no process number filtering for test file !!! === - WRITE (MDSE,1011) IERR - CALL EXTCDE ( 2011 ) - RETURN - ! -2020 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1020) - CALL EXTCDE ( 2020 ) - RETURN - ! -2021 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1021) - CALL EXTCDE ( 2021 ) - RETURN - ! -2030 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) - CALL EXTCDE ( 2030 ) - RETURN - ! -2031 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1031) INAMES(I,J), J - CALL EXTCDE ( 2031 ) - RETURN - ! - !2050 CONTINUE - ! IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1040) - ! CALL EXTCDE ( 2050 ) - ! RETURN - ! -2051 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1051) MN(:II) - CALL EXTCDE ( 2051 ) - RETURN - ! -2052 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1052) J - CALL EXTCDE ( 2052 ) - RETURN - ! -2053 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1053) - CALL EXTCDE ( 2053 ) - RETURN - ! -2054 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1054) - CALL EXTCDE ( 2054 ) - RETURN - ! -2060 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1060) - CALL EXTCDE ( 2060 ) - RETURN - ! -2070 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1070) - CALL EXTCDE ( 2070 ) - RETURN - ! -2080 CONTINUE - CALL EXTCDE ( 2080 ) - RETURN - ! ! Formats ! 900 FORMAT ( ' ========== STARTING MWW3 INITIALIZATION (WMINIT) =', & @@ -3367,22 +3358,6 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & 999 FORMAT ( ' ========== END OF MWW3 INITIALIZATION (WMINIT) ===', & '============================'/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & - ' ERROR IN OPENING INPUT FILE ',A/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) -1010 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & - ' ERROR IN OPENING LOG FILE'/ & - ' IOSTAT =',I5/) -1011 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & - ' ERROR IN OPENING TEST FILE'/ & - ' IOSTAT =',I5/) 1020 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & ' ILLEGAL NUMBER OF GRIDS ( < 1 ) '/) 1021 FORMAT (/' *** WAVEWATCH III ERROR IN WMINIT : *** '/ & @@ -3550,6 +3525,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & !/ 15-May-2018 : Update namelist ( version 6.05 ) !/ 28-Oct-2020 : Add SMCTYPE for SMC sub-grid. JGLi ( version 7.13 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -3751,7 +3727,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & USE WMINIOMD, ONLY: WMIOBS, WMIOBG, WMIOBF USE WMIOPOMD, ONLY: WMIOPP !/ - USE W3SERVMD, ONLY: ITRACE, EXTCDE, NEXTLN, WWDATE, WWTIME + USE W3SERVMD, ONLY: ITRACE, EXTCDE, EXTOPN, EXTIOF, NEXTLN, WWDATE, WWTIME #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -4051,7 +4027,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif ! IF ( IMPROC .EQ. NMPLOG ) THEN - OPEN (MDSO,FILE=TRIM(FNMPRE)//LFILE,ERR=2010,IOSTAT=IERR) + OPEN (MDSO,FILE=TRIM(FNMPRE)//LFILE,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINITNML','LOG',2010) IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,911) LFILE, MDSO CALL WMUSET ( MDSS, MDSS, MDSO, .TRUE., 'OUT', & @@ -4063,7 +4040,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IF ( MDST.NE.MDSO .AND. MDST.NE.MDSS .AND. TSTOUT ) THEN IFT = LEN_TRIM(TFILE) - OPEN (MDST,FILE=TRIM(FNMPRE)//TFILE(:IFT),ERR=2011,IOSTAT=IERR) + OPEN (MDST,FILE=TRIM(FNMPRE)//TFILE(:IFT),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINITNML','TEST',2011) CALL WMUSET ( MDSS, MDST, MDST, .TRUE., 'OUT', & TRIM(FNMPRE)//TFILE(:IFT), 'Test output file') END IF @@ -4073,7 +4051,8 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL WMUGET ( MDSS, MDST, MDSP, 'OUT' ) CALL WMUSET ( MDSS, MDST, MDSP, .TRUE., 'OUT', & TRIM(FNMPRE)//PFILE(:IFT), 'Profiling file') - OPEN (MDSP,FILE=TRIM(FNMPRE)//PFILE(:IFT),ERR=2011,IOSTAT=IERR) + OPEN (MDSP,FILE=TRIM(FNMPRE)//PFILE(:IFT),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINITNML','TEST',2011) #endif ! ! 1.e Initial and test output @@ -4133,8 +4112,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & END IF END IF ! - IF ( NRGRD .LT. 1 ) GOTO 2020 - IF ( NRINP .LT. 0 ) GOTO 2021 + IF ( NRGRD .LT. 1 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1020) + CALL EXTCDE ( 2020 ) + RETURN + END IF + IF ( NRINP .LT. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1021) + CALL EXTCDE ( 2021 ) + RETURN + END IF IF ( NRINP.EQ.0 .AND. .NOT.UNIPTS ) NRINP = -1 ! ! 2.b Set up data structures @@ -4356,8 +4343,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & EXIT END IF END DO - IF ( INPMAP(I,J) .EQ. 0 ) GOTO 2030 - IF ( .NOT. INPUTS(INPMAP(I,J))%INFLAGS1(J) ) GOTO 2031 + IF ( INPMAP(I,J) .EQ. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) + CALL EXTCDE ( 2030 ) + RETURN + END IF + IF ( .NOT. INPUTS(INPMAP(I,J))%INFLAGS1(J) ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1031) INAMES(I,J), J + CALL EXTCDE ( 2031 ) + RETURN + END IF USEINP(-INPMAP(I,J)) = .TRUE. CPLINP(-INPMAP(I,J)) = .TRUE. END IF @@ -4370,8 +4365,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & EXIT END IF END DO - IF ( INPMAP(I,J) .EQ. 0 ) GOTO 2030 - IF ( .NOT. INPUTS(-INPMAP(I,J))%INFLAGS1(J) ) GOTO 2031 + IF ( INPMAP(I,J) .EQ. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) + CALL EXTCDE ( 2030 ) + RETURN + END IF + IF ( .NOT. INPUTS(-INPMAP(I,J))%INFLAGS1(J) ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1031) INAMES(I,J), J + CALL EXTCDE ( 2031 ) + RETURN + END IF USEINP(INPMAP(I,J)) = .TRUE. END IF END IF @@ -4787,7 +4790,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CYCLE ! and if output still enabled, stop ELSE - GOTO 2055 + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1055) + CALL EXTCDE ( 2055 ) + RETURN END IF END IF @@ -4796,11 +4801,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! IF ( UNIPTS .AND. I.GE.2 ) THEN DO K=1,I-1 - IF ( NML_OUTPUT_TYPE(K)%POINT%FILE.NE.NML_OUTPUT_TYPE(I)%POINT%FILE ) GOTO 2053 + IF ( NML_OUTPUT_TYPE(K)%POINT%FILE.NE.NML_OUTPUT_TYPE(I)%POINT%FILE ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1053) + CALL EXTCDE ( 2053 ) + RETURN + END IF END DO END IF OPEN (MDSI, file=TRIM(FNMPRE)//TRIM(NML_OUTPUT_TYPE(I)%POINT%FILE), & - FORM='FORMATTED', STATUS='OLD', ERR=2104, IOSTAT=IERR) + FORM='FORMATTED', STATUS='OLD', IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'WMINITNML','POINT',1104) ! first loop to count the number of points ! second loop to allocate the array and store the points @@ -4815,13 +4825,15 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & OT2(I)%PNAMES(OT2(I)%NPTS) ) OT2(I)%NPTS = 0 ! reset it to use it as a counter for loop 2 ELSE - ALLOCATE ( OT2(I)%X(1), OT2(I)%Y(1), OT2(I)%PNAMES(1) ) - GOTO 2054 + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1054) + CALL EXTCDE ( 2054 ) + RETURN END IF END IF ! DO - READ (MDSI,*,ERR=2004,IOSTAT=IERR) TMPLINE + READ (MDSI,*,IOSTAT=IERR) TMPLINE + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'WMINITNML','POINT',2003) ! if end of file or stopstring, then exit IF ( IERR.NE.0 .OR. INDEX(TMPLINE,"STOPSTRING").NE.0 ) EXIT ! leading blanks removed and placed on the right @@ -4831,8 +4843,10 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CYCLE ELSE ! otherwise, backup to beginning of line - BACKSPACE ( MDSI, ERR=2004, IOSTAT=IERR) - READ (MDSI,*,ERR=2004,IOSTAT=IERR) XX, YY, PN + BACKSPACE ( MDSI, IOSTAT=IERR) + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'WMINITNML','POINT',2003) + READ (MDSI,*,IOSTAT=IERR) XX, YY, PN + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'WMINITNML','POINT',2003) ENDIF OT2(I)%NPTS = OT2(I)%NPTS + 1 IF ( ILOOP .EQ. 1 ) CYCLE @@ -4956,8 +4970,16 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & N_MOV = NML_HOMOG_COUNT%N_MOV N_TOT = NML_HOMOG_COUNT%N_TOT - IF ( N_MOV .EQ. 0 ) GOTO 2060 - IF ( N_MOV .GT. 99 ) GOTO 2061 + IF ( N_MOV .EQ. 0 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1060) + CALL EXTCDE ( 2060 ) + RETURN + END IF + IF ( N_MOV .GT. 99 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1061) IDTST, N_MOV + CALL EXTCDE ( 2061 ) + RETURN + END IF ALLOCATE ( TMOVE(2,N_MOV), AMOVE(N_MOV), DMOVE(N_MOV) ) ! @@ -4971,7 +4993,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,968) I, TMOVE(:,I), AMOVE(I), DMOVE(I) CASE DEFAULT - GOTO 2062 + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1062) IDTST + CALL EXTCDE ( 2062 ) + RETURN END SELECT END DO ! @@ -5615,7 +5639,10 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & !!Li NX, NY, GTYPE, IERR, MNAMES(I), & NX, NY, JJJ, IERR, MNAMES(I), & TRIM(FNMPRE) ) - IF ( IERR .NE. 0 ) GOTO 2080 + IF ( IERR .NE. 0 ) THEN + CALL EXTCDE ( 2080 ) + RETURN + END IF ! !!Li Print a warning message when GTYPE not matching forcing field one. IF ( (JJJ .NE. GTYPE) .AND. (IMPROC .EQ. NMPSC2) ) & @@ -5867,7 +5894,11 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! 8.a.6 Check for coordinate system ! DO I=1, NRGRD-1 - IF ( GRIDS(I)%FLAGLL .NEQV. GRIDS(I+1)%FLAGLL ) GOTO 2070 + IF ( GRIDS(I)%FLAGLL .NEQV. GRIDS(I+1)%FLAGLL ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1070) + CALL EXTCDE ( 2070 ) + RETURN + END IF END DO ! ! 8.b Input files @@ -5899,7 +5930,10 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & CALL W3FLDO ('READ', IDINP(-I,J), MDSF(-I,J), MDST, & MDSE2, NX, NY, GTYPE, IERR, & MNAMES(-I), TRIM(FNMPRE) ) - IF ( IERR .NE. 0 ) GOTO 2080 + IF ( IERR .NE. 0 ) THEN + CALL EXTCDE ( 2080 ) + RETURN + END IF IF ( MDSS.NE.MDSO .AND. NMPSC2.EQ.IMPROC ) & WRITE (MDSS,985) IDFLDS(J) ELSE @@ -6261,108 +6295,6 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! RETURN ! - ! Escape locations read errors : - ! -2003 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1003) - CALL EXTCDE ( 2003 ) - RETURN - ! -2104 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1104) IERR - CALL EXTCDE ( 1104 ) - RETURN - ! -2004 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1004) IERR - CALL EXTCDE ( 2004 ) - RETURN - ! -2010 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1010) IERR - CALL EXTCDE ( 2010 ) - RETURN - ! -2011 CONTINUE - ! === no process number filtering for test file !!! === - WRITE (MDSE,1011) IERR - CALL EXTCDE ( 2011 ) - RETURN - ! -2020 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1020) - CALL EXTCDE ( 2020 ) - RETURN - ! -2021 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1021) - CALL EXTCDE ( 2021 ) - RETURN - ! -2030 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1030) MNAMES(I), INAMES(I,J) - CALL EXTCDE ( 2030 ) - RETURN - ! -2031 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1031) INAMES(I,J), J - CALL EXTCDE ( 2031 ) - RETURN - ! - !2050 CONTINUE - ! IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1040) - ! CALL EXTCDE ( 2050 ) - ! RETURN - ! -2051 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1051) MN(:II) - CALL EXTCDE ( 2051 ) - RETURN - ! -2052 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1052) J - CALL EXTCDE ( 2052 ) - RETURN - ! -2053 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1053) - CALL EXTCDE ( 2053 ) - RETURN - ! -2054 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1054) - CALL EXTCDE ( 2054 ) - RETURN - ! -2055 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1055) - CALL EXTCDE ( 2055 ) - RETURN - ! -2060 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1060) - CALL EXTCDE ( 2060 ) - RETURN - ! -2061 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1061) IDTST, N_MOV - CALL EXTCDE ( 2061 ) - RETURN - ! -2062 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1062) IDTST - CALL EXTCDE ( 2062 ) - RETURN - ! -2070 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1070) - CALL EXTCDE ( 2070 ) - RETURN - ! -2080 CONTINUE - CALL EXTCDE ( 2080 ) - RETURN - ! ! Formats ! 900 FORMAT ( ' ========== STARTING MWW3 INITIALIZATION (WMINITNML) =', & @@ -6499,22 +6431,6 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & 999 FORMAT ( ' ========== END OF MWW3 INITIALIZATION (WMINITNML) ===', & '============================'/) ! -1003 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & - ' PREMATURE END OF POINT FILE'/) - ! -1104 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & - ' ERROR IN OPENING POINT FILE'/ & - ' IOSTAT =',I5/) - ! -1004 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & - ' ERROR IN READING FROM POINT FILE'/ & - ' IOSTAT =',I5/) -1010 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & - ' ERROR IN OPENING LOG FILE'/ & - ' IOSTAT =',I5/) -1011 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & - ' ERROR IN OPENING TEST FILE'/ & - ' IOSTAT =',I5/) 1020 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & ' ILLEGAL NUMBER OF GRIDS ( < 1 ) '/) 1021 FORMAT (/' *** WAVEWATCH III ERROR IN WMINITNML : *** '/ & diff --git a/model/src/wmupdtmd.F90 b/model/src/wmupdtmd.F90 index 4bb33df54e..ab9d40a806 100644 --- a/model/src/wmupdtmd.F90 +++ b/model/src/wmupdtmd.F90 @@ -36,6 +36,7 @@ MODULE WMUPDTMD !/ (R. Padilla-Hernandez, J.H. Alves, EMC/NOAA) !/ 08-Feb-2021 : Add FSWND option for SMC grid. JGLi ( version 7.13 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -114,6 +115,7 @@ SUBROUTINE WMUPDT ( IMOD ,TDATA ) !/ 20-Jan-2017 : Enable using input from coupler ( version 6.02 ) !/ (T. J. Campbell, NRL) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -404,7 +406,10 @@ SUBROUTINE WMUPDT ( IMOD ,TDATA ) ! 5. Finalize for each type ----------------------------------------- / ! 5.a Process IERR output ! - IF ( IERR.GT.0 ) GOTO 2000 + IF ( IERR.GT.0 ) THEN + CALL EXTCDE ( 2000 ) + RETURN + END IF IF ( IERR.LT.0 .AND. MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) & WRITE (MDSS,950) IDFLDS(J) ! @@ -463,12 +468,6 @@ SUBROUTINE WMUPDT ( IMOD ,TDATA ) ! RETURN ! - ! Error escape locations - ! -2000 CONTINUE - CALL EXTCDE ( 2000 ) - RETURN - ! ! Formats ! 900 FORMAT ( ' Updating input for grid',I3,' at ',A) @@ -878,6 +877,7 @@ SUBROUTINE WMUPD2 ( IMOD, J, JMOD, IERR ) !/ 14-Oct-2006 : Origination. ( version 3.10 ) !/ 10-Dec-2006 : Bug fix WMUPD2 initial fields. ( version 3.10 ) !/ 22-Mar-2021 : Add momentum and air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -1162,20 +1162,12 @@ SUBROUTINE WMUPD2 ( IMOD, J, JMOD, IERR ) CALL WMUPDS ( IMOD, INPUTS(IMOD)%RHN, & JMOD, INPUTS(JMOD)%RHN, DAIR ) ! - ! 2.g Assimilation data 0 - ! - CASE (7) - GOTO 2999 + ! 2.g,h,i Assimilation data 0,1,2 ! - ! 2.h Assimilation data 1 - ! - CASE (8) - GOTO 2999 - ! - ! 2.i Assimilation data 2 - ! - CASE (9) - GOTO 2999 + CASE (7,8,9) + IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSE,1999) + CALL EXTCDE ( 2999 ) + RETURN ! END SELECT ! @@ -1258,13 +1250,6 @@ SUBROUTINE WMUPD2 ( IMOD, J, JMOD, IERR ) ! RETURN ! - ! Error escape locations - ! -2999 CONTINUE - IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) WRITE (MDSE,1999) - CALL EXTCDE ( 2999 ) - RETURN - ! ! Formats ! 1999 FORMAT (/' *** ERROR WMUPD2: OPTION NOT YET IMPLEMENTED ***'/) diff --git a/model/src/wmwavemd.F90 b/model/src/wmwavemd.F90 index 99eec5ecae..7bab3259f4 100644 --- a/model/src/wmwavemd.F90 +++ b/model/src/wmwavemd.F90 @@ -36,6 +36,7 @@ MODULE WMWAVEMD !/ 12-Mar-2012 : Use MPI_COMM_NULL for checks. ( version 3.14 ) !/ 28-Jan-2014 : Add memory hwm to profiling. ( version 5.00 ) !/ 22-Mar-2021 : Support for air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -111,6 +112,7 @@ SUBROUTINE WMWAVE ( TEND ) !/ 12-Mar-2012 : Use MPI_COMM_NULL for checks. ( version 3.14 ) !/ 28-Jan-2014 : Add memory hwm to profiling. ( version 5.00 ) !/ 22-Mar-2021 : Support for air density input ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -316,13 +318,22 @@ SUBROUTINE WMWAVE ( TEND ) ! DO I=1, NRGRD IF ( ( GRSTAT(I).LT.0 .OR. GRSTAT(I).GT.7 ) .AND. & - GRSTAT(I).NE.99 ) GOTO 2000 + GRSTAT(I).NE.99 ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1000) I, GRSTAT(I) + CALL EXTCDE ( 2000 ) + RETURN + END IF ! ! Consistency of times for grids ! IF ( TSYNC(1,I) .NE. -1 ) THEN DTTST = DSEC21 ( TSYNC(:,I), TEND(:,I) ) - IF ( DTTST .LT. 0. ) GOTO 2001 + IF ( DTTST .LT. 0. ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1001) I, TSYNC(:,I), & + TEND(:,I) + CALL EXTCDE ( 2001 ) + RETURN + END IF END IF END DO ! @@ -331,8 +342,13 @@ SUBROUTINE WMWAVE ( TEND ) DO J=1, NRGRP DO JJ=2, INGRP(J,0) IF ( DSEC21(TSYNC(:,INGRP(J,1)),TSYNC(:,INGRP(J,JJ))).NE.0. & - .OR. DSEC21(TEND(:,INGRP(J,1)),TEND(:,INGRP(J,JJ))).NE.0. ) & - GOTO 2002 + .OR. DSEC21(TEND(:,INGRP(J,1)),TEND(:,INGRP(J,JJ))).NE.0. ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1002) J, INGRP(J,1), & + INGRP(J,JJ), TSYNC(:,INGRP(J,1)), TSYNC(:,INGRP(J,JJ)), & + TEND(:,INGRP(J,1)), TEND(:,INGRP(J,JJ)) + CALL EXTCDE ( 2002 ) + RETURN + END IF END DO IF ( GRANK(INGRP(J,1)).EQ.1 .AND. TSYNC(1,0).EQ.-1 ) & TSYNC(:,0) = TSYNC(:,INGRP(J,1)) @@ -830,7 +846,7 @@ SUBROUTINE WMWAVE ( TEND ) #ifdef W3_T IF ( INGRP(J,0) .GT. 1 ) WRITE (MDST,9006) #endif - IF ( INGRP(J,0) .GT. 1 ) GOTO 1111 + IF ( INGRP(J,0) .GT. 1 ) EXIT ! END IF ! IF ( FLAGOK ) ! @@ -909,7 +925,7 @@ SUBROUTINE WMWAVE ( TEND ) #ifdef W3_T IF ( INGRP(J,0) .GT. 1 ) WRITE (MDST,9006) #endif - IF ( INGRP(J,0) .GT. 1 ) GOTO 1111 + IF ( INGRP(J,0) .GT. 1 ) EXIT ! END IF ! IF ( FLAGOK ) ! @@ -1032,7 +1048,7 @@ SUBROUTINE WMWAVE ( TEND ) #ifdef W3_T IF ( INGRP(J,0) .GT. 1 ) WRITE (MDST,9006) #endif - IF ( INGRP(J,0) .GT. 1 ) GOTO 1111 + IF ( INGRP(J,0) .GT. 1 ) EXIT END IF ! IF ( FLAGOK ) ! END IF ! IF ( .NOT. FLEQOK(I) ) @@ -1583,8 +1599,6 @@ SUBROUTINE WMWAVE ( TEND ) ! END DO LOOP_JJ ! -1111 CONTINUE - ! END DO LOOP_J ! #ifdef W3_MPI @@ -1597,7 +1611,11 @@ SUBROUTINE WMWAVE ( TEND ) IF ( GRSTAT(I) .EQ. 9 ) GRSTAT(I) = 0 END DO ! - IF ( .NOT. DONE ) GOTO 2099 + IF ( .NOT. DONE ) THEN + IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1099) + CALL EXTCDE ( 2099 ) + RETURN + END IF IF ( MINVAL(GRSTAT) .EQ. 99 ) EXIT LOOP_OUTER END DO LOOP_OUTER ! @@ -1629,31 +1647,6 @@ SUBROUTINE WMWAVE ( TEND ) ! RETURN ! - ! Escape locations - ! -2000 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1000) I, GRSTAT(I) - CALL EXTCDE ( 2000 ) - RETURN - ! -2001 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1001) I, TSYNC(:,I), & - TEND(:,I) - CALL EXTCDE ( 2001 ) - RETURN - ! -2002 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1002) J, INGRP(J,1), & - INGRP(J,JJ), TSYNC(:,INGRP(J,1)), TSYNC(:,INGRP(J,JJ)), & - TEND(:,INGRP(J,1)), TEND(:,INGRP(J,JJ)) - CALL EXTCDE ( 2002 ) - RETURN - ! -2099 CONTINUE - IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1099) - CALL EXTCDE ( 2099 ) - RETURN - ! ! Formats ! 900 FORMAT ( ' ========== STARTING WAVE MODEL (WMWAVE) ==========', & diff --git a/model/src/ww3_bounc.F90 b/model/src/ww3_bounc.F90 index 77ac0432cb..a916a908c7 100644 --- a/model/src/ww3_bounc.F90 +++ b/model/src/ww3_bounc.F90 @@ -41,6 +41,7 @@ PROGRAM W3BOUNC !/ 21-Jul-2020 : Support rotated pole grid ( version 7.11 ) !/ 02-Jan-2025 : Change geographic distance method ( version 7.xx ) !/ 02-Jan-2025 : Add verbose=2 display output ( version 7.xx ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ !/ Copyright 2012-2013 National Weather Service (NWS), @@ -74,6 +75,8 @@ PROGRAM W3BOUNC ! ---------------------------------------------------------------- ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! WAVNU1 Subr. W3DISPMD Solve dispersion relation. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. @@ -141,7 +144,8 @@ PROGRAM W3BOUNC USE W3IOBCMD, ONLY: VERBPTBC, IDSTRBC USE W3IOGRMD, ONLY: W3IOGR USE W3TIMEMD - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, DIST_HAVERSINE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF, & + DIST_HAVERSINE #ifdef W3_RTD USE W3SERVMD, ONLY: W3EQTOLL #endif @@ -275,17 +279,23 @@ PROGRAM W3BOUNC FILE = NML_BOUND%FILE NBO2 = 0 - OPEN(NDSL,FILE=TRIM(FILE),STATUS='OLD',ERR=809,IOSTAT=IERR) + OPEN(NDSL,FILE=TRIM(FILE),STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3BOUNC','SPEC',69,NAMEF=FILE) REWIND (NDSL) DO - READ (NDSL,*,END=400,ERR=802) + READ (NDSL,*,IOSTAT=IERR) + IF (IERR.LT.0) EXIT + IF (IERR.GT.0) THEN + WRITE (NDSE,1002) IERR + CALL EXTCDE ( 62 ) + END IF NBO2 = NBO2 + 1 END DO -400 CONTINUE ALLOCATE(SPECFILES(NBO2)) REWIND (NDSL) DO I=1,NBO2 - READ (NDSL,'(A512)',END=801,ERR=802) SPECFILES(I) + READ (NDSL,'(A512)',IOSTAT=IERR) SPECFILES(I) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3BOUNC','INPUT',61,FIELD='SPECFILES') END DO CLOSE(NDSL) @@ -295,19 +305,27 @@ PROGRAM W3BOUNC ! process old ww3_bounc.inp format ! IF (.NOT. FLGNML) THEN - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_bounc.inp',STATUS='OLD',ERR=805,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_bounc.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) THEN + WRITE (NDSE,1005) TRIM(SPECFILES(IP)), NKI, NK1, NTHI, NTH1, NTI, NT1 + CALL EXTCDE ( 65 ) + END IF REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3BOUNC','INPUT',61,FIELD='COMSTR') IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) INXOUT + READ (NDSI,*,IOSTAT=IERR) INXOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3BOUNC','INPUT',61,FIELD='INXOUT') CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) INTERP + READ (NDSI,*,IOSTAT=IERR) INTERP + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3BOUNC','INPUT',61,FIELD='INTERP') CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) VERBOSE + READ (NDSI,*,IOSTAT=IERR) VERBOSE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3BOUNC','INPUT',61,FIELD='VERBOSE') CALL NEXTLN ( COMSTR , NDSI , NDSE ) ! NBO2 = 0 @@ -361,7 +379,10 @@ PROGRAM W3BOUNC OPEN(NDSB,FILE='nest.ww3',form='UNFORMATTED', convert=file_endian,status='old') READ(NDSB) IDTST, VERTEST, NK1, NTH1, XFR, FR1I, TH1I, NBI NSPEC1 = NK1 * NTH1 - IF ( IDTST .NE. IDSTRBC ) GOTO 803 + IF ( IDTST .NE. IDSTRBC ) THEN + WRITE (NDSE,1003) IDTST, IDSTRBC + CALL EXTCDE ( 63 ) + END IF WRITE(NDSO,940) VERTEST WRITE(NDSO,941) IDTST IF (VERBOSE.EQ.1) WRITE(NDSO,'(A,2I5,3F12.6,I5)') 'NK,NTH,XFR, FR1I, TH1I, NBI :', & @@ -389,7 +410,14 @@ PROGRAM W3BOUNC IF (IERR.EQ.0) THEN IF (VERBOSE.EQ.1) WRITE(NDSO,*) 'TIME2,NBI2:',TIME2, NBI2,IERR DO IP=1, NBI2 - READ (NDSB,END=803,ERR=804) ABPIN(:,IP) + READ (NDSB,IOSTAT=ICODE) ABPIN(:,IP) + IF (ICODE.LT.0) THEN + WRITE (NDSE,1003) IDTST, IDSTRBC + CALL EXTCDE ( 63 ) + ELSE IF (ICODE.GT.0) THEN + WRITE (NDSE,1004) + CALL EXTCDE ( 64 ) + END IF END DO END IF END DO @@ -513,7 +541,10 @@ PROGRAM W3BOUNC ELSE IF (NKI.NE.NK1.OR.NTHI.NE.NTH1.OR.NT1.NE.NTI & - ) GOTO 805 + ) THEN + WRITE (NDSE,1005) TRIM(SPECFILES(IP)), NKI, NK1, NTHI, NTH1, NTI, NT1 + CALL EXTCDE ( 65 ) + END IF END IF ! position variables : lon/lat or x/y @@ -763,40 +794,7 @@ PROGRAM W3BOUNC END IF ! INXOUT.EQ.'WRITE' - GOTO 888 - - ! - ! Escape locations read errors : - ! - -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 61 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 62 ) - ! -803 CONTINUE - WRITE (NDSE,1003) IDTST, IDSTRBC - CALL EXTCDE ( 63 ) - ! -804 CONTINUE - WRITE (NDSE,1004) - CALL EXTCDE ( 64 ) - ! -805 CONTINUE - WRITE (NDSE,1005) TRIM(SPECFILES(IP)), NKI, NK1, NTHI, NTH1, NTI, NT1 - CALL EXTCDE ( 65 ) - ! -809 CONTINUE - WRITE (NDSE,1009) FILE, IERR - CALL EXTCDE ( 69 ) - ! -888 CONTINUE WRITE (NDSO,999) - - ! ! Formats ! @@ -823,9 +821,6 @@ PROGRAM W3BOUNC ' ========================================='/ & ' WAVEWATCH III Boundary input '/) ! -1001 FORMAT (/' *** WAVEWATCH-III ERROR IN W3BOUNC : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUNC: '/ & ' ERROR IN READING ',A,' FROM INPUT FILE'/ & ' IOSTAT =',I5/) @@ -843,10 +838,6 @@ PROGRAM W3BOUNC ' OR NTHI =',I3,' DIFFERS FROM NTH1 =',I3/ & ' OR NTI =',I5,' DIFFERS FROM NT1 =',I5 /) ! -1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUNC : '/ & - ' ERROR IN OPENING SPEC FILE: ', A/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUNC : '/ & ' SPEC FILE DOES NOT EXIST : ',A/) ! diff --git a/model/src/ww3_bound.F90 b/model/src/ww3_bound.F90 index 74e363fa92..96df088a88 100644 --- a/model/src/ww3_bound.F90 +++ b/model/src/ww3_bound.F90 @@ -27,6 +27,7 @@ PROGRAM W3BOUND !/ 21-Jul-2020 : Support rotated pole grid ( version 7.11 ) !/ Chris Bunney, UKMO. !/ 27-May-2021 : Add namelist feature ( version 7.XX ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2012-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -59,6 +60,7 @@ PROGRAM W3BOUND ! ---------------------------------------------------------------- ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! WAVNU1 Subr. W3DISPMD Solve dispersion relation. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. @@ -124,7 +126,7 @@ PROGRAM W3BOUND USE W3IOGRMD, ONLY: W3IOGR USE W3TIMEMD USE W3NMLBOUNDMD - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, EXTOPN #ifdef W3_RTD USE W3SERVMD, ONLY: W3EQTOLL #endif @@ -288,17 +290,30 @@ PROGRAM W3BOUND BNDFILE = NML_BOUND%FILE NBO2 = 0 - OPEN(NDSL,FILE=TRIM(BNDFILE),STATUS='OLD',ERR=809,IOSTAT=IERR) + OPEN(NDSL,FILE=TRIM(BNDFILE),STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3BOUND','SPEC',69,NAMEF=BNDFILE) REWIND (NDSL) DO - READ (NDSL,*,END=400,ERR=802) + READ (NDSL,*,IOSTAT=IERR) + IF (IERR.LT.0) THEN + EXIT + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1002) IERR + CALL EXTCDE ( 62 ) + END IF NBO2 = NBO2 + 1 END DO -400 CONTINUE ALLOCATE(SPECFILES(NBO2)) REWIND (NDSL) DO I=1,NBO2 - READ (NDSL,'(A120)',END=801,ERR=802) SPECFILES(I) + READ (NDSL,'(A120)',IOSTAT=IERR) SPECFILES(I) + IF (IERR.LT.0) THEN + WRITE (NDSE,1001) + CALL EXTCDE ( 61 ) + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1002) IERR + CALL EXTCDE ( 62 ) + END IF END DO CLOSE(NDSL) @@ -308,10 +323,18 @@ PROGRAM W3BOUND ! process old ww3_bound.inp format ! IF (.NOT. FLGNML) THEN - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_bound.inp',STATUS='OLD',ERR=803,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_bound.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3BOUND','INPUT',63) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.LT.0) THEN + WRITE (NDSE,1001) + CALL EXTCDE ( 61 ) + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1002) IERR + CALL EXTCDE ( 62 ) + END IF IF (COMSTR.EQ.' ') COMSTR = '$' @@ -463,7 +486,7 @@ PROGRAM W3BOUND IF (VERBOSE.EQ.1) WRITE(NDSO,'(A,I5,3A,I5)') & 'IP, file, I/O stat:',IP,', ', & TRIM(SPECFILES(IP)), ', ',IERR - IF (IERR.NE.0) GOTO 810 + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3BOUND','SPEC',70,NAMEF=SPECFILES(IP)) READ(200+IP,'(A1,A22,A1,X,2I6)',iostat=IERR) & space,string1,space,NKI,NTHI IF (VERBOSE.EQ.1) WRITE(NDSO,'(A,3I5)') 'IP and spectral dimensions:',IP, NKI,NTHI @@ -494,7 +517,10 @@ PROGRAM W3BOUND ! ! Checks consistency of NK - IF (NKI.GT.NK) GOTO 808 + IF (NKI.GT.NK) THEN + WRITE (NDSE,1008) NK, NKI + CALL EXTCDE ( 68 ) + END IF ! ! HERE we define IFMIN IFMIN2 IFMAX and IFMAX2 frequency indices ! such that source spec SPEC (read in input) links with output spec @@ -506,14 +532,20 @@ PROGRAM W3BOUND ! IFMAX2=NK ! index of last freq. in output spectrum ! ! Checks consistency of XFR - IF (ABS((FREQ(IFMIN+1)/FREQ(IFMIN))-XFR).GT.0.005) GOTO 806 + IF (ABS((FREQ(IFMIN+1)/FREQ(IFMIN))-XFR).GT.0.005) THEN + WRITE (NDSE,1006) XFR + CALL EXTCDE ( 66 ) + END IF ! ! Checks consistency of NTH ! WARNING: check is only done on number of directions, no check ! is done on the relative offset of first direction in terms of ! the directional increment [-0.5,0.5] (last parameter of the ! spectral definition in ww3_grid.inp, on second active line) - IF (NTHI.NE.NTH) GOTO 807 + IF (NTHI.NE.NTH) THEN + WRITE (NDSE,1007) NTH, NTHI + CALL EXTCDE ( 67 ) + END IF IF ((FR1-FREQ(1))/FR1.GT. 0.03) THEN DO J=1,MIN(NK1,NK) @@ -668,43 +700,6 @@ PROGRAM W3BOUND CLOSE(NDSB) END IF END IF - STOP - ! - ! Escape locations read errors : - ! - -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 61 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 62 ) - ! -803 CONTINUE - WRITE (NDSE,1003) - CALL EXTCDE ( 63 ) - ! -806 CONTINUE - WRITE (NDSE,1006) XFR - CALL EXTCDE ( 66 ) - ! -807 CONTINUE - WRITE (NDSE,1007) NTH, NTHI - CALL EXTCDE ( 67 ) - ! -808 CONTINUE - WRITE (NDSE,1008) NK, NKI - CALL EXTCDE ( 68 ) - ! -809 CONTINUE - WRITE (NDSE,1009) BNDFILE, IERR - CALL EXTCDE ( 69 ) - ! -810 CONTINUE - WRITE (NDSE,1010) SPECFILES(IP) - CALL EXTCDE ( 70 ) - ! ! Formats ! @@ -721,10 +716,6 @@ PROGRAM W3BOUND ' ERROR IN READING ',A,' FROM INPUT FILE'/ & ' IOSTAT =',I5/) ! -1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUNC : '/ & - ' ERROR IN OPENING INPUT FILE: ', A/ & - ' IOSTAT =',I5/) - ! 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUND: '/ & ' ILLEGAL XFR, XFR =',F12.6/) ! @@ -735,15 +726,6 @@ PROGRAM W3BOUND ' ILLEGAL NK, NK =',I3,' DIFFERS FROM NKI =',I3/ & ' IT WILL BE MANAGED SOON BY SPCONV') ! -1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUND : '/ & - ' ERROR IN OPENING SPEC FILE: ', A/ & - ' IOSTAT =',I5/) - ! -1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3BOUND : '/ & - ' SPEC FILE NOT EXISTING: ', A/) - - - ! !/ !/ End of W3BOUND ---------------------------------------------------- / !/ diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index bfd2dd467b..bf4d9f743b 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -42,6 +42,7 @@ PROGRAM W3GRID_INTERP !/ 26-Jan-2021 : Added TP field (derived from FP) ( version 7.12 ) !/ 22-Mar-2021 : New coupling fields output ( version 7.13 ) !/ 02-Jun-2021 : Bug fix (*SUMGRD; Q. Liu) ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -69,6 +70,8 @@ PROGRAM W3GRID_INTERP ! W3SETG Subr. Id. Point to selected model. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. ! NEXTLN Subr. W3SERVMD Get next line from input file + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! ITRACE Subr. Id. Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. @@ -119,7 +122,7 @@ PROGRAM W3GRID_INTERP USE W3WDATMD, ONLY : W3NDAT, W3DIMW, W3SETW USE W3WDATMD, ONLY : WDATAS, TIME, WLV, ICE, ICEH, ICEF, & UST, USTDIR, ASF, RHOAIR - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -196,8 +199,8 @@ PROGRAM W3GRID_INTERP ! ! J = LEN_TRIM(FNMPRE) - OPEN(NDSI,FILE=FNMPRE(:J)//'ww3_gint.inp',STATUS='OLD', ERR=2000, & - IOSTAT=IERR) + OPEN(NDSI,FILE=FNMPRE(:J)//'ww3_gint.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'INTERP','INPUT',1) WRITE (NDSO,900) ! CALL ITRACE ( NDSTRC, NTRACE ) @@ -209,7 +212,8 @@ PROGRAM W3GRID_INTERP ! 3.a Get comment character ! REWIND (NDSI) - READ (NDSI,'(A)',END=2001,ERR=2002) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'INTERP','INPUT',2) IF ( COMSTR .EQ. ' ' ) COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -243,7 +247,8 @@ PROGRAM W3GRID_INTERP ! 3.c Read number of grids and allocate memory ! CALL NEXTLN ( COMSTR, NDSI, NDSE ) - READ (NDSI,*,END=2001,ERR=2002) NG + READ (NDSI,*,IOSTAT=IERR) NG + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'INTERP','INPUT',2) WRITE (NDSO,903) NG ! CALL W3NMOD (NG, 6, 6) @@ -259,7 +264,8 @@ PROGRAM W3GRID_INTERP CALL NEXTLN ( COMSTR, NDSI, NDSE ) ! DO IG = 1,NG - READ (NDSI,*,END=2001,ERR=2002) GRIDS(IG)%FILEXT + READ (NDSI,*,IOSTAT=IERR) GRIDS(IG)%FILEXT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'INTERP','INPUT',2) WRITE (NDSO,904) IG,GRIDS(IG)%FILEXT ! CALL W3SETO( IG, 6, 6) @@ -288,7 +294,8 @@ PROGRAM W3GRID_INTERP NOSWLL_MIN = MIN (NOSWLL_MIN,OUTPTS(NG)%NOSWLL) END IF CALL NEXTLN ( COMSTR, NDSI, NDSE ) - READ (NDSI,'(I1)',END=2001,ERR=2002) INTMETHOD + READ (NDSI,'(I1)',IOSTAT=IERR) INTMETHOD + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'INTERP','INPUT',2) WRITE (NDSO,917) INTMETHOD CLOSE(NDSI) @@ -819,8 +826,10 @@ PROGRAM W3GRID_INTERP CALL W3SETO( IG, 6, 6) CALL W3IOGO('READ',FIDOUT(IG),IOTST,IG) IF ( IOTST .NE. 0 ) THEN - GO TO 2111 - ENDIF + WRITE(NDSO,950) + WRITE(NDSO,999) + STOP + END IF END DO ! ! 5.c Setup the output flag options for the target grid @@ -869,7 +878,9 @@ PROGRAM W3GRID_INTERP DO IG = 1,NG-1 CALL W3IOGO('READ',FIDOUT(IG),IOTST,IG) IF ( IOTST .NE. 0 ) THEN - GO TO 2111 + WRITE(NDSO,950) + WRITE(NDSO,999) + STOP ENDIF END DO CYCLE @@ -894,7 +905,7 @@ PROGRAM W3GRID_INTERP CALL TICK21 ( TOUT , DTREQ ) IF ( IOUT .GE. NOUT ) EXIT END DO - GOTO 2222 + WRITE(NDSO,999) ! --- if Restart file -------- ELSE !OUTorREST=.FALSE. ! @@ -929,28 +940,11 @@ PROGRAM W3GRID_INTERP CALL W3EXGI ( NG-1, NSEA, NOSWLL_MIN, INTMETHOD, OUTorREST,MAPSTA_NG,MAPST2_NG ) - GOTO 2222 + WRITE(NDSO,999) END IF !OUTorREST ! !--------------------------------------------------------------------------- - ! Escape locations read errors : - ! -2000 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1 ) -2001 CONTINUE - WRITE(NDSE,1001) - CALL EXTCDE ( 2 ) -2002 CONTINUE - WRITE(NDSE,1002) IERR - CALL EXTCDE ( 3 ) -2111 CONTINUE - WRITE(NDSO,950) -2222 CONTINUE - WRITE(NDSO,999) - ! - !--------------------------------------------------------------------------- ! Formats ! 900 FORMAT (/15X,' *** WAVEWATCH III Grid interpolation *** '/ & @@ -991,15 +985,6 @@ PROGRAM W3GRID_INTERP 999 FORMAT (/15X,' *** End of Grid interpolation Routine *** '/ & 15X,'==============================================='/) ! -1000 FORMAT (/' *** ERROR IN WAVEGRID_INTERP : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) -1001 FORMAT (/' *** ERROR IN WAVEGRID_INTERP : '/ & - ' PREMATURE END IN INPUT FILE'/) -1002 FORMAT (/' *** ERROR IN WAVEGRID_INTERP : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! !/ !/ Internal Subroutine !/ diff --git a/model/src/ww3_grib.F90 b/model/src/ww3_grib.F90 index 5df59b1d3f..81a5208e0a 100644 --- a/model/src/ww3_grib.F90 +++ b/model/src/ww3_grib.F90 @@ -61,6 +61,7 @@ PROGRAM W3GRIB !/ (J.H. Alves) !/ 22-Mar-2021 : New coupling fields output ( version 7.13 ) !/ 09-Jun-2021 : remove grib1 support (NCEP1) ( version 7.14 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -97,6 +98,8 @@ PROGRAM W3GRIB ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -143,7 +146,7 @@ PROGRAM W3GRIB USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3IOGRMD, ONLY: W3IOGR USE W3IOGOMD, ONLY: W3READFLGRD, W3IOGO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -240,8 +243,10 @@ PROGRAM W3GRIB CALL STRACE (IENT, 'W3GRIB') #endif ! - OPEN (NDSI,FILE='ww3_grib.inp',STATUS='OLD',ERR=800,IOSTAT=IERR) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + OPEN (NDSI,FILE='ww3_grib.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GRIB','INPUT',3) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRIB','INPUT',4) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -258,7 +263,12 @@ PROGRAM W3GRIB CALL W3IOGR ( 'READ', NDSM ) WRITE (NDSO,920) GNAME ! - IF ( .NOT. FLAGLL ) GOTO 810 + IF ( .NOT. FLAGLL ) THEN + IF ( .NOT. FLAGLL ) THEN + WRITE (NDSE,1010) + CALL EXTCDE ( 10 ) + END IF + END IF ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read requests from input file. @@ -389,7 +399,8 @@ PROGRAM W3GRIB ! ... GRIB specific parameters ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) FTIME, CID, PID, GID, GDS, GDTN + READ (NDSI,*,IOSTAT=IERR) FTIME, CID, PID, GID, GDS, GDTN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRIB','INPUT',4) ! ! Check if grid type is curvilinear, and only go on if Lambert conformal ! or PolarStereo @@ -415,15 +426,14 @@ PROGRAM W3GRIB IF ( GDTN .EQ. 30 ) THEN ! This is a Lambert conformal grid, read projection parameters CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) LATAN1, LONV, DSX, DSY, & + READ (NDSI,*,IOSTAT=IERR) LATAN1, LONV, DSX, DSY, & SCNMOD, LATIN1, LATIN2, LATSP, LONSP + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRIB','INPUT',4) ELSEIF ( GDTN .EQ. 20 ) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) LATAN1, LONV, DSX, DSY, & + READ (NDSI,*,IOSTAT=IERR) LATAN1, LONV, DSX, DSY, & SCNMOD -#endif - -#ifdef W3_NCEP2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GRIB','INPUT',4) ENDIF #endif ! @@ -762,7 +772,7 @@ PROGRAM W3GRIB CALL W3IOGO ( 'READ', NDSOG, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,942) - GOTO 888 + EXIT END IF CYCLE END IF @@ -800,35 +810,8 @@ PROGRAM W3GRIB IF ( IOUT .GE. NOUT ) EXIT END DO ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 3 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 4 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 5 ) - ! -810 CONTINUE - IF ( .NOT. FLAGLL ) THEN - WRITE (NDSE,1010) - CALL EXTCDE ( 10 ) - END IF - ! -888 CONTINUE WRITE (NDSO,999) ! -#ifdef W3_NCO - ! CALL W3TAGE('WAVEGRIB') -#endif - ! ! Formats ! 900 FORMAT (/15X,' *** WAVEWATCH III GRIB output postp. *** '/ & @@ -881,17 +864,6 @@ PROGRAM W3GRIB ' ',6I6) #endif ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRIB : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRIB : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRIB : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRIB : '/ & ' GRIB REQUIRES SPHERICAL GRID'/) #ifdef W3_NCEP2 @@ -930,6 +902,7 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) !/ 16-Jul-2007 : Adding GRIB2 capability ( version 3.11 ) !/ (A. Chawla) !/ 22-Mar-2021 : New coupling fields output ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -1570,16 +1543,28 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) END DO #ifdef W3_NCEP2 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,YY(:,0), NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) #endif ! @@ -1597,16 +1582,28 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) END DO #ifdef W3_NCEP2 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,YY(:,I), NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) #endif END DO @@ -1624,16 +1621,28 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) END DO #ifdef W3_NCEP2 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,YY(:,I), NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) #endif END DO @@ -1653,16 +1662,28 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) ! #ifdef W3_NCEP2 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,X1, NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) #endif ! @@ -1673,58 +1694,106 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) END DO #ifdef W3_NCEP2 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,X1, NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) #endif #ifdef W3_NCEP2 KPDS(2) = 0 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,X2, NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) KPDS(2) = 2 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,XX, NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) KPDS(2) = 3 CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO) - IF (IO .NE. 0) GOTO 810 + IF (IO .NE. 0) THEN + WRITE (NDSE,1010) IO + CALL EXTCDE ( 20 ) + END IF CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, & IDEFNUM, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, & COORDLIST, NUMCOORD, IDRSNUM, IDRS, & 200,XY, NDATA, IBMP, BITMAP, IO) - IF (IO .NE. 0) GOTO 820 + IF (IO .NE. 0) THEN + WRITE (NDSE,1020) IO + CALL EXTCDE ( 30 ) + END IF CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO) - IF (IO .NE. 0) GOTO 830 + IF (IO .NE. 0) THEN + WRITE (NDSE,1030) IO + CALL EXTCDE ( 40 ) + END IF CALL WRYTE (NDSDAT, LENGRIB, CGRIB) #endif ! @@ -1741,20 +1810,6 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) END DO ! RETURN - ! - ! Error escape locations - ! -#ifdef W3_NCEP2 -810 CONTINUE - WRITE (NDSE,1010) IO - CALL EXTCDE ( 20 ) -820 CONTINUE - WRITE (NDSE,1020) IO - CALL EXTCDE ( 30 ) -830 CONTINUE - WRITE (NDSE,1030) IO - CALL EXTCDE ( 40 ) -#endif ! ! Formats ! @@ -1762,12 +1817,6 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) ' PLEASE UPDATE FIELDS !!! '/) ! #ifdef W3_NCEP2 -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/ & - ' ERROR IN OPENING OUTPUT FILE'/ & - ' IOSTAT =',I5/) -#endif - ! -#ifdef W3_NCEP2 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/ & ' ERROR CREATING NEW GRIB2 FIELD'/ & ' IOSTAT =',I5/) diff --git a/model/src/ww3_gspl.F90 b/model/src/ww3_gspl.F90 index db41523340..86fbbe9c5b 100644 --- a/model/src/ww3_gspl.F90 +++ b/model/src/ww3_gspl.F90 @@ -51,6 +51,7 @@ PROGRAM W3GSPL !/ 04-Mar-2013 : Adding GrADS output. ( version 4.10 ) !/ 05-Aug-2013 : Add UQ/UNO for distances. ( version 4.12 ) !/ 18-Nov-2013 : Add user-defined halo extension. ( version 4.14 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2012-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -96,6 +97,8 @@ PROGRAM W3GSPL ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. ! @@ -182,7 +185,7 @@ PROGRAM W3GSPL ! USE W3GDATMD, ONLY: W3NMOD, W3SETG USE W3ADATMD, ONLY: W3NAUX, W3SETA USE W3ODATMD, ONLY: W3NOUT, W3SETO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF USE W3ARRYMD, ONLY : OUTA2I, OUTA2R #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -283,9 +286,11 @@ PROGRAM W3GSPL ! J = LEN_TRIM(FNMPRE) OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_gspl.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL','INPUT',40) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -293,7 +298,8 @@ PROGRAM W3GSPL ! 2. Read model definition file. ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) FEXT + READ (NDSI,*,IOSTAT=IERR) FEXT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) ! CALL W3IOGR ( 'READ', NDSM, 1, FEXT ) CLOSE (NDSM) @@ -310,10 +316,12 @@ PROGRAM W3GSPL CASE (UNGTYPE) WRITE ( NDSO,903) 'unstructured' IDGRID = 'UNST' - GOTO 820 + WRITE (NDSE,1020) GTYPE + CALL EXTCDE ( 20 ) CASE DEFAULT WRITE ( NDSO,903) 'not recognized' - GOTO 821 + WRITE (NDSE,1021) GTYPE + CALL EXTCDE ( 21 ) END SELECT ! SELECT CASE (ICLOSE) @@ -329,20 +337,27 @@ PROGRAM W3GSPL WRITE ( NDSO,904) 'global (tripolar)' IDCLSE = 'TRPL' GLOBAL = .TRUE. - GOTO 822 + WRITE (NDSE,1022) ICLOSE + CALL EXTCDE ( 22 ) CASE DEFAULT WRITE ( NDSO,904) 'not recognized' - GOTO 823 + WRITE (NDSE,1023) ICLOSE + CALL EXTCDE ( 23 ) END SELECT ! WRITE (NDSO,905) NX, NY, NSEA - IF ( NSEA .EQ. 0 ) GOTO 824 + IF ( NSEA .EQ. 0 ) THEN + WRITE (NDSE,1024) + CALL EXTCDE ( 24 ) + END IF + ! ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Read options from input file. ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NG, NITMAX, STARG, NHEXT + READ (NDSI,*,IOSTAT=IERR) NG, NITMAX, STARG, NHEXT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) NG = MAX ( 2, NG ) NITMAX = MAX ( 1, NITMAX ) STARG = MAX ( 0. , STARG ) @@ -350,8 +365,9 @@ PROGRAM W3GSPL WRITE (NDSO,930) NG, NITMAX, STARG, NHEXT ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) IDLA1, IDFM1, & + READ (NDSI,*,IOSTAT=IERR) IDLA1, IDFM1, & VSC1, RFORM1 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) IF (IDLA1.LT.1 .OR. IDLA1.GT.4) IDLA1 = 1 IF (IDFM1.LT.1 .OR. IDFM1.GT.3) IDFM1 = 1 IF ( ABS(VSC1) .LT. 1.E-15 ) VSC1 = 1. @@ -359,8 +375,9 @@ PROGRAM W3GSPL WRITE (NDSO,931) IDLA1, IDFM1, VSC1, RFORM1 ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) IDLA2, IDFM2, & + READ (NDSI,*,IOSTAT=IERR) IDLA2, IDFM2, & VSC2, RFORM2 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) IF (IDLA2.LT.1 .OR. IDLA2.GT.4) IDLA2 = 1 IF (IDFM2.LT.1 .OR. IDFM2.GT.3) IDFM2 = 1 IF ( ABS(VSC2) .LT. 1.E-15 ) VSC2 = 1. @@ -371,19 +388,25 @@ PROGRAM W3GSPL END IF ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) IDLA3, IDFM3, & + READ (NDSI,*,IOSTAT=IERR) IDLA3, IDFM3, & VSC3, RFORM3 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) IF (IDLA3.LT.1 .OR. IDLA3.GT.4) IDLA3 = 1 IF (IDFM3.LT.1 .OR. IDFM3.GT.3) IDFM3 = 1 IF ( VSC3 .EQ. 0 ) VSC3 = 1 WRITE (NDSO,934) IDLA3, IDFM3, VSC3, RFORM3 ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) FRACL, FRACH, FRFLAG + READ (NDSI,*,IOSTAT=IERR) FRACL, FRACH, FRFLAG + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3GSPL','INPUT',41) FRACL = MAX ( 0. , FRACL ) FRACH = MIN ( 1. , FRACH ) WRITE (NDSO,935) FRACL, FRACH - IF ( FRACL .GT. FRACH ) GOTO 830 + IF ( FRACL .GT. FRACH ) THEN + WRITE (NDSE,1030) + CALL EXTCDE ( 30 ) + END IF + ! IF ( .NOT. FRFLAG ) WRITE (NDSO,936) ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -516,7 +539,10 @@ PROGRAM W3GSPL DO J=1, IG MINGRD = MINGRD + INGRD(J) END DO - IF ( MINGRD .NE. NSEA ) GOTO 825 + IF ( MINGRD .NE. NSEA ) THEN + WRITE (NDSE,1025) MINGRD, NSEA + CALL EXTCDE ( 25 ) + END IF ! #ifdef W3_T WRITE (NDST,9043) IG, NG @@ -660,7 +686,10 @@ PROGRAM W3GSPL WRITE (NDSO,951) 0, MSTATS%NMIN, MSTATS%NMAX, & 100.*MSTATS%RSTD/XMEAN G0ID = '5.a' - IF ( MSTATS%NMIN .EQ. 0 ) GOTO 850 + IF ( MSTATS%NMIN .EQ. 0 ) THEN + WRITE (NDSE,1050) G0ID + CALL EXTCDE ( 50 ) + END IF INGMIN = MSTATS%NMIN INGMAX = MSTATS%NMAX INGMNC = 0 @@ -691,7 +720,10 @@ PROGRAM W3GSPL IF ( MSTOLD%NMIN .NE. MSTATS%NMIN ) THEN WRITE (NDSO,951) IIT, MSTATS%NMIN, MSTATS%NMAX, & 100.*MSTATS%RSTD/XMEAN - IF ( MSTATS%NMIN .EQ. 0 ) GOTO 850 + IF ( MSTATS%NMIN .EQ. 0 ) THEN + WRITE (NDSE,1050) G0ID + CALL EXTCDE ( 50 ) + END IF #ifdef W3_O16 WRITE ( NDSG ) ((REAL(MSPLIT(IY,IX)),IX=1,NX),IY=1,NY) NTGRDS = NTGRDS + 1 @@ -701,7 +733,10 @@ PROGRAM W3GSPL ELSE WRITE (NDSO,952) MSTATS%NMIN, MSTATS%NMAX, & 100.*MSTATS%RSTD/XMEAN - IF ( MSTATS%NMIN .EQ. 0 ) GOTO 850 + IF ( MSTATS%NMIN .EQ. 0 ) THEN + WRITE (NDSE,1050) G0ID + CALL EXTCDE ( 50 ) + END IF END IF ! END IF @@ -748,7 +783,10 @@ PROGRAM W3GSPL #endif ! G0ID = '5.g' - IF ( MSTATS%NMIN .EQ. 0 ) GOTO 850 + IF ( MSTATS%NMIN .EQ. 0 ) THEN + WRITE (NDSE,1050) G0ID + CALL EXTCDE ( 50 ) + END IF ! ! 5.h Optional GrADS output ! @@ -934,10 +972,11 @@ PROGRAM W3GSPL ! IF ( IDFM1 .EQ. 3 ) THEN OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), & - form='UNFORMATTED', convert=file_endian,ERR=860,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) ELSE - OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), ERR=860,IOSTAT=IERR) + OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5),IOSTAT=IERR) END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL',FNMPRE(:J)//FNAME(:J5),60) REWIND (NDSM) CALL OUTA2R ( PGRID(IG)%ZBIN, PGRID(IG)%NX, PGRID(IG)%NY, & 1, PGRID(IG)%NX, 1, PGRID(IG)%NY, NDSM, NDST, & @@ -956,11 +995,12 @@ PROGRAM W3GSPL ! IF ( IDFM2 .EQ. 3 ) THEN OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), & - form='UNFORMATTED', convert=file_endian,ERR=860,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) ELSE OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), & - ERR=860,IOSTAT=IERR) + IOSTAT=IERR) END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL',FNMPRE(:J)//FNAME(:J5),60) REWIND (NDSM) CALL OUTA2R ( PGRID(IG)%OBSX, PGRID(IG)%NX, PGRID(IG)%NY, & 1, PGRID(IG)%NX, 1, PGRID(IG)%NY, NDSM, & @@ -980,10 +1020,11 @@ PROGRAM W3GSPL ! IF ( IDFM3 .EQ. 3 ) THEN OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), & - form='UNFORMATTED', convert=file_endian,ERR=860,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) ELSE - OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), ERR=860,IOSTAT=IERR) + OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5),IOSTAT=IERR) END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL',FNMPRE(:J)//FNAME(:J5),60) REWIND (NDSM) CALL OUTA2I ( PGRID(IG)%MASK, PGRID(IG)%NX, PGRID(IG)%NY, & 1, PGRID(IG)%NX, 1, PGRID(IG)%NY, NDSM, NDST, & @@ -996,7 +1037,8 @@ PROGRAM W3GSPL FNAME(J4+1:J5) = '.tmpl' WRITE (NDSO,962) FNAME(:J5) ! - OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5), ERR=860,IOSTAT=IERR) + OPEN (NDSM,FILE=FNMPRE(:J)//FNAME(:J5),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL',FNMPRE(:J)//FNAME(:J5),60) ! GNAME(31-J2:30) = AEXT GNAME(30-J2:30-J2) = 'p' @@ -1033,7 +1075,8 @@ PROGRAM W3GSPL ! J5 = 11+J1+J2 INAME(:J5) = 'ww3_multi.'//FEXT(:J1)//'.'//AEXT(:J2) - OPEN (NDSM,FILE=FNMPRE(:J)//INAME(:J5), ERR=870,IOSTAT=IERR) + OPEN (NDSM,FILE=FNMPRE(:J)//INAME(:J5),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL',FNMPRE(:J)//INAME(:J5),70) ! DO IG=1, NG WRITE (AEXT,NRFMT) IG @@ -1054,7 +1097,8 @@ PROGRAM W3GSPL ! J5 = 10+J1+J2 INAME(:J5) = 'ww3_mask.'//FEXT(:J1)//'.'//AEXT(:J2) - OPEN (NDSM,FILE=FNMPRE(:J)//INAME(:J5), ERR=870,IOSTAT=IERR) + OPEN (NDSM,FILE=FNMPRE(:J)//INAME(:J5),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3GSPL',FNMPRE(:J)//INAME(:J5),70) ! DO IY=1, NY WRITE (NDSM,980) MSPLIT(IY,:) @@ -1073,63 +1117,6 @@ PROGRAM W3GSPL !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 9. End of program ! - GOTO 888 - ! - ! Error escape locations - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 41 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 42 ) - ! -820 CONTINUE - WRITE (NDSE,1020) GTYPE - CALL EXTCDE ( 20 ) - ! -821 CONTINUE - WRITE (NDSE,1021) GTYPE - CALL EXTCDE ( 21 ) - ! -822 CONTINUE - WRITE (NDSE,1022) ICLOSE - CALL EXTCDE ( 22 ) - ! -823 CONTINUE - WRITE (NDSE,1023) ICLOSE - CALL EXTCDE ( 23 ) - ! -824 CONTINUE - WRITE (NDSE,1024) - CALL EXTCDE ( 24 ) - ! -825 CONTINUE - WRITE (NDSE,1025) MINGRD, NSEA - CALL EXTCDE ( 25 ) - ! -830 CONTINUE - WRITE (NDSE,1030) - CALL EXTCDE ( 30 ) - ! -850 CONTINUE - WRITE (NDSE,1050) G0ID - CALL EXTCDE ( 50 ) - ! -860 CONTINUE - WRITE (NDSE,1060) FNMPRE(:J)//FNAME(:J5), IERR - CALL EXTCDE ( 60 ) - ! -870 CONTINUE - WRITE (NDSE,1070) FNMPRE(:J)//INAME(:J5), IERR - CALL EXTCDE ( 70 ) - ! -888 CONTINUE WRITE (NDSO,999) ! ! Formats @@ -1220,17 +1207,6 @@ PROGRAM W3GSPL ' ========================================='/ & ' WAVEWATCH III Grid splitting '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1020 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & ' SPLITTING NOT AVAILABLE FOR GRID TYPE'/ & ' GTYPE =',I5/) @@ -1260,14 +1236,6 @@ PROGRAM W3GSPL 1050 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & ' SHOULD NOT HAVE ZERO GRID SIZE (',A,') ...'/) ! -1060 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & - ' ERROR IN OPENING FILE ',A/ & - ' IOSTAT =',I5/) - ! -1070 FORMAT (/' *** WAVEWATCH III ERROR IN W3GSPL : '/ & - ' ERROR IN OPENING FILE ',A/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9040 FORMAT ( 'TEST W3GSPL: CHECKERBOARD X-Y:',2I8) 9041 FORMAT ( 'TEST W3GSPL: FILLING CHECKERBOARD TRY:',I3/ & diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index a2ff83e269..1ee8e51b2f 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -67,6 +67,7 @@ PROGRAM W3OUNF !/ 02-Sep-2021 : Added coordinates attribute ( version 7.12 ) !/ 14-Feb-2023 : Added QKK output ( version 7.12 ) !/ 03-Mar-2024 : Added SKEW & EMBIAS output ( version 7.xx ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -103,6 +104,8 @@ PROGRAM W3OUNF ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -162,7 +165,7 @@ PROGRAM W3OUNF USE W3WDATMD, ONLY: W3NDAT, W3SETW USE W3ADATMD, ONLY: W3NAUX, W3SETA USE W3ODATMD, ONLY: W3NOUT, W3SETO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, STR_TO_UPPER + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF, STR_TO_UPPER #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -343,7 +346,7 @@ PROGRAM W3OUNF FLDOUT = NML_FIELD%LIST CALL W3FLGRDFLAG ( NDSO, SCREEN, NDSE, FLDOUT, FLG1D, & FLG2D, 1, 1, IERR ) - IF (IERR.NE.0) GOTO 800 + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUNF','INPUT',10) ! 4.3 Output type NCTYPE = NML_FILE%NETCDF @@ -379,21 +382,28 @@ PROGRAM W3OUNF ! process old ww3_ounf.inp format ! IF (.NOT. FLGNML) THEN - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_ounf.inp',STATUS='OLD',ERR=800,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_ounf.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUNF','INPUT',10) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR CALL NEXTLN ( COMSTR , NDSI , NDSE ) ! 4.1 Time setup - READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT + READ (NDSI,*,IOSTAT=IERR) TOUT, DTREQ, NOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) ! 4.1.1 Forecast period and forecast reference time ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - ! READ (NDSI,*,END=801,ERR=802) FLGFC - ! IF( FLGFC ) READ(NDSI,*,END=801,ERR=802) TREF + ! READ (NDSI,*,IOSTAT=IERR) FLGFC + ! IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) + ! IF( FLGFC ) THEN + ! READ(NDSI,*,IOSTAT=IERR) TREF + ! IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) + ! END IF ! ! ChrisB: Forecast variables flag and reference time ! only configurable via namelist input. Set forecast @@ -403,15 +413,18 @@ PROGRAM W3OUNF ! 4.2 Output fields CALL W3READFLGRD ( NDSI, NDSO, SCREEN, NDSE, COMSTR, FLG1D, & FLG2D, 1, 1, IERR ) - IF (IERR.NE.0) GOTO 800 + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUNF','INPUT',10) ! 4.3 Output type CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) NCTYPE, NCVARTYPE + READ (NDSI,*,IOSTAT=IERR) NCTYPE, NCVARTYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,'(A)',END=801,ERR=802) STRINGIPART + READ (NDSI,'(A)',IOSTAT=IERR) STRINGIPART + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) TOGETHER + READ (NDSI,*,IOSTAT=IERR) TOGETHER + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) ! The following are only configurable via the namelist input ! and are hardcoded for .inp files: @@ -422,29 +435,36 @@ PROGRAM W3OUNF CALL NEXTLN ( COMSTR , NDSI , NDSE ) FILEPREFIX= 'ww3.' - READ (NDSI,*,END=801,ERR=802) FILEPREFIX + READ (NDSI,*,IOSTAT=IERR) FILEPREFIX + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) S3 + READ (NDSI,*,IOSTAT=IERR) S3 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) CALL NEXTLN ( COMSTR , NDSI , NDSE ) IF(SMCGRD) THEN #ifdef W3_SMC ! SMC output type (1 or 2) - READ (NDSI,*,END=801,ERR=802) SMCOTYPE + READ (NDSI,*,IOSTAT=IERR) SMCOTYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) IF(SMCOTYPE .EQ. 1) THEN ! Flat sea point output CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) SXO, SYO, EXO, EYO + READ (NDSI,*,IOSTAT=IERR) SXO, SYO, EXO, EYO + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) ELSE IF(SMCOTYPE .EQ. 2) THEN ! Regular grid output CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) SXO, SYO, EXO, EYO, CELFAC + READ (NDSI,*,IOSTAT=IERR) SXO, SYO, EXO, EYO, CELFAC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) ENDIF SMCNOVAL = NOVAL #endif ELSE - READ (NDSI,*,END=801,ERR=802) IX1, IXN, IY1, IYN + READ (NDSI,*,IOSTAT=IERR) IX1, IXN, IY1, IYN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNF','INPUT',11) ENDIF - CLOSE(NDSI,ERR=800,IOSTAT=IERR) + CLOSE(NDSI,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUNF','INPUT',10) END IF ! .NOT. FLGNML CALL STR_TO_UPPER(TTYPE) @@ -534,7 +554,8 @@ PROGRAM W3OUNF ENDIF NBIPART = NBIPART + 1 IF(NBIPART .GT. NOSWLL + 1) THEN - GOTO 803 + WRITE (NDSE,1003) NBIPART, NOSWLL + CALL EXTCDE (13) ENDIF TABIPART(NBIPART) = IPART ENDDO @@ -711,27 +732,6 @@ PROGRAM W3OUNF END DO ! IFI ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 10 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 11 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 12 ) - ! -803 CONTINUE - WRITE (NDSE,1003) NBIPART, NOSWLL - CALL EXTCDE (13) - ! -888 CONTINUE WRITE (NDSO,999) ! ! Formats @@ -787,17 +787,6 @@ PROGRAM W3OUNF ! ! Error format strings ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1003 FORMAT (/' *** WAVEWATCH III WERROR IN W3OUNF : '/ & ' OUT OF RANGE REQUEST FOR NBIPART =',I2, / & ' MAX SWELL PARTITIONS (NOSW) =',I2 /) @@ -882,6 +871,7 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & !/ and alternative dir/mag output. !/ 02-Feb-2021 : Make default global meta optional ( version 7.12 ) !/ 22-Mar-2021 : New coupling fields output ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -1029,6 +1019,7 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! LOGICAL :: FLFRQ, FLDIR, FEXIST, FREMOVE LOGICAL :: CUSTOMFRQ=.FALSE. + LOGICAL :: LOOP #ifdef W3_T LOGICAL :: LTEMP(NGRPP) #endif @@ -1179,1538 +1170,1398 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! Loop over IPART for partition variables -555 CONTINUE + LOOP = .TRUE. + DO WHILE(LOOP) + + LOOP = .FALSE. - ! Initializes the index of field and group at the first flag FLG2D at .TRUE. - IF (I1.EQ.0) I1=IFI - IF (J1.EQ.0) J1=IFJ - FORMF = '(1X,32I5)' + ! Initializes the index of field and group at the first flag FLG2D at .TRUE. + IF (I1.EQ.0) I1=IFI + IF (J1.EQ.0) J1=IFJ + FORMF = '(1X,32I5)' #ifdef W3_T - WRITE (NDST,9020) IDOUT(IFI,IFJ) -#endif - ! - ! 2.1 Set output arrays and parameters - ! - ! Initializes the flags for freq and direction dimensions - FLFRQ = .FALSE. - FLDIR = .FALSE. - IF (NCVARTYPEI.EQ.3) NCVARTYPE=2 - ! - ! Depth - IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN - CALL S2GRID(DW(1:NSEA), X1) - - ! Surface current - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN - !! Note - CX and CY read in from .ww3 file are X-Y vectors -#ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, CX(1:NSEA), CY(1:NSEA), AnglD) + WRITE (NDST,9020) IDOUT(IFI,IFJ) #endif ! - IF( .NOT. VECTOR ) THEN - CALL UV_TO_MAG_DIR(CX(1:NSEA), CY(1:NSEA), NSEA, & - TOLERANCE=0.05, CONV='O') - ENDIF + ! 2.1 Set output arrays and parameters ! - CALL S2GRID(CX(1:NSEA), XX) - CALL S2GRID(CY(1:NSEA), XY) - NFIELD=2 + ! Initializes the flags for freq and direction dimensions + FLFRQ = .FALSE. + FLDIR = .FALSE. + IF (NCVARTYPEI.EQ.3) NCVARTYPE=2 ! - ! Wind - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN - !! Note - UA and UD read in from .ww3 file are UX,UY + ! Depth + IF ( IFI .EQ. 1 .AND. IFJ .EQ. 1 ) THEN + CALL S2GRID(DW(1:NSEA), X1) + + ! Surface current + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 2 ) THEN + !! Note - CX and CY read in from .ww3 file are X-Y vectors #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UA(1:NSEA), UD(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, CX(1:NSEA), CY(1:NSEA), AnglD) #endif - ! - IF( .NOT. VECTOR ) THEN - CALL UV_TO_MAG_DIR(UA(1:NSEA), UD(1:NSEA), NSEA, & - TOLERANCE=1.0, CONV='N') - ENDIF - ! - CALL S2GRID(UA(1:NSEA), XX) - CALL S2GRID(UD(1:NSEA), XY) - NFIELD=2 - ! - ! Air-sea temperature difference - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN - CALL S2GRID(AS(1:NSEA), X1) - ! - ! Sea surface height above sea level - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN - CALL S2GRID(WLV, X1) - ! - ! Sea ice area fraction - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN - CALL S2GRID(ICE(1:NSEA), X1) - - ! Icebergs_damping - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN - CALL S2GRID(BERG, X1) - WHERE ( X1.NE.UNDEF) X1 = X1*0.1 - ! - ! Atmospheric momentum - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 8 ) THEN - !! Note - TAUA and TAUADIR read in from .ww3 file are TAUAX,TAUAY + ! + IF( .NOT. VECTOR ) THEN + CALL UV_TO_MAG_DIR(CX(1:NSEA), CY(1:NSEA), NSEA, & + TOLERANCE=0.05, CONV='O') + ENDIF + ! + CALL S2GRID(CX(1:NSEA), XX) + CALL S2GRID(CY(1:NSEA), XY) + NFIELD=2 + ! + ! Wind + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 3 ) THEN + !! Note - UA and UD read in from .ww3 file are UX,UY +#ifdef W3_RTD + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UA(1:NSEA), UD(1:NSEA), AnglD) +#endif + ! + IF( .NOT. VECTOR ) THEN + CALL UV_TO_MAG_DIR(UA(1:NSEA), UD(1:NSEA), NSEA, & + TOLERANCE=1.0, CONV='N') + ENDIF + ! + CALL S2GRID(UA(1:NSEA), XX) + CALL S2GRID(UD(1:NSEA), XY) + NFIELD=2 + ! + ! Air-sea temperature difference + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 4 ) THEN + CALL S2GRID(AS(1:NSEA), X1) + ! + ! Sea surface height above sea level + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN + CALL S2GRID(WLV, X1) + ! + ! Sea ice area fraction + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN + CALL S2GRID(ICE(1:NSEA), X1) + + ! Icebergs_damping + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 7 ) THEN + CALL S2GRID(BERG, X1) + WHERE ( X1.NE.UNDEF) X1 = X1*0.1 + ! + ! Atmospheric momentum + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 8 ) THEN + !! Note - TAUA and TAUADIR read in from .ww3 file are TAUAX,TAUAY #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUA(1:NSEA), TAUADIR(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUA(1:NSEA), TAUADIR(1:NSEA), AnglD) #endif - IF( SMCGRD ) THEN + IF( SMCGRD ) THEN #ifdef W3_SMC - CALL W3S2XY_SMC( TAUA (1:NSEA), XX ) - CALL W3S2XY_SMC( TAUADIR(1:NSEA), XY ) -#endif - ELSE ! IF(SMCGRD) - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUA(1:NSEA) & - , MAPSF, XX ) - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUADIR(1:NSEA) & - , MAPSF, XY ) - ENDIF - NFIELD=2 - ! - ! Air density - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 9 ) THEN - IF( SMCGRD ) THEN + CALL W3S2XY_SMC( TAUA (1:NSEA), XX ) + CALL W3S2XY_SMC( TAUADIR(1:NSEA), XY ) +#endif + ELSE ! IF(SMCGRD) + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUA(1:NSEA) & + , MAPSF, XX ) + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUADIR(1:NSEA) & + , MAPSF, XY ) + ENDIF + NFIELD=2 + ! + ! Air density + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 9 ) THEN + IF( SMCGRD ) THEN #ifdef W3_SMC - CALL W3S2XY_SMC(RHOAIR, X1) + CALL W3S2XY_SMC(RHOAIR, X1) #endif - ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, RHOAIR, MAPSF, X1 ) - ENDIF - ! + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, RHOAIR, MAPSF, X1 ) + ENDIF + ! #ifdef W3_BT4 - ! Krumbein phi scale - ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 10 ) THEN - CALL S2GRID(SED_D50, X1) - WHERE ( X1.NE.UNDEF) X1 = -LOG(X1/0.001)/LOG2 - NFIELD=1 + ! Krumbein phi scale + ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 10 ) THEN + CALL S2GRID(SED_D50, X1) + WHERE ( X1.NE.UNDEF) X1 = -LOG(X1/0.001)/LOG2 + NFIELD=1 #endif - ! + ! #ifdef W3_IS2 - ! Ice thickness - ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 11 ) THEN - CALL S2GRID(ICEH(1:NSEA), X1) - NFIELD=1 + ! Ice thickness + ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 11 ) THEN + CALL S2GRID(ICEH(1:NSEA), X1) + NFIELD=1 #endif - ! + ! #ifdef W3_IS2 - ! Maximum ice floe diameter - ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 12 ) THEN - CALL S2GRID(ICEF(1:NSEA), X1) - NFIELD=1 + ! Maximum ice floe diameter + ELSE IF (IFI .EQ. 1 .AND. IFJ .EQ. 12 ) THEN + CALL S2GRID(ICEF(1:NSEA), X1) + NFIELD=1 #endif - ! Significant wave height - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=2 - CALL S2GRID(HS, X1) + ! Significant wave height + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 1 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=2 + CALL S2GRID(HS, X1) - ! Mean wave length - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN - CALL S2GRID(WLM, X1) - ! - ! Mean period T02 - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN - CALL S2GRID(T02, X1) - ! - ! Mean period T0m1 - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN - CALL S2GRID(T0M1, X1) - ! - ! Mean period T01 - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN - CALL S2GRID(T01, X1) - ! - ! Wave peak frequency - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 6 ) THEN - CALL S2GRID(FP0, X1) - ! - ! Wave mean direction - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN + ! Mean wave length + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 2 ) THEN + CALL S2GRID(WLM, X1) + ! + ! Mean period T02 + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 3 ) THEN + CALL S2GRID(T02, X1) + ! + ! Mean period T0m1 + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 4 ) THEN + CALL S2GRID(T0M1, X1) + ! + ! Mean period T01 + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 5 ) THEN + CALL S2GRID(T01, X1) + ! + ! Wave peak frequency + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 6 ) THEN + CALL S2GRID(FP0, X1) + ! + ! Wave mean direction + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 7 ) THEN #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, THM, AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, THM, AnglD, .FALSE.) #endif - CALL S2GRID(THM, X1, .TRUE.) - ! - ! Directional spread - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN - CALL S2GRID(THS, X1) - ! - ! Peak direction - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN + CALL S2GRID(THM, X1, .TRUE.) + ! + ! Directional spread + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN + CALL S2GRID(THS, X1) + ! + ! Peak direction + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, THP0, AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, THP0, AnglD, .FALSE.) #endif - CALL S2GRID(THP0, X1, .TRUE.) - ! - ! Infragravity wave height - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 10 ) THEN - CALL S2GRID(HSIG, X1) - ! - ! Expected maximum sea surface elevation - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 11 ) THEN - CALL S2GRID(STMAXE, X1) - ! - ! Standard deviation of maximum sea surface elevation - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 12 ) THEN - CALL S2GRID(STMAXD, X1) - ! - ! Expected maximum wave height - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 13 ) THEN - CALL S2GRID(HMAXE, X1) - ! - ! Expected maximum wave height from crest - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 14 ) THEN - CALL S2GRID(HCMAXE, X1) - ! - ! STD of maximum wave height - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 15 ) THEN - CALL S2GRID(HMAXD, X1) - ! - ! STD of maximum wave height from crest - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 16 ) THEN - CALL S2GRID(HCMAXD, X1) - ! - ! Dominant wave breaking probability - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 17 ) THEN - CALL S2GRID(WBT, X1) - ! - ! Wave peak period (derived from peak freq field) - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 18 ) THEN - DO I=1,NSEA - IF(FP0(I) .NE. UNDEF) THEN - AUX1(I) = 1.0 / FP0(I) - ELSE - AUX1(I) = UNDEF - ENDIF - ENDDO - ! - CALL S2GRID(AUX1, X1) - ! - ! Mean wave number - ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 19 ) THEN - IF( SMCGRD ) THEN + CALL S2GRID(THP0, X1, .TRUE.) + ! + ! Infragravity wave height + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 10 ) THEN + CALL S2GRID(HSIG, X1) + ! + ! Expected maximum sea surface elevation + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 11 ) THEN + CALL S2GRID(STMAXE, X1) + ! + ! Standard deviation of maximum sea surface elevation + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 12 ) THEN + CALL S2GRID(STMAXD, X1) + ! + ! Expected maximum wave height + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 13 ) THEN + CALL S2GRID(HMAXE, X1) + ! + ! Expected maximum wave height from crest + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 14 ) THEN + CALL S2GRID(HCMAXE, X1) + ! + ! STD of maximum wave height + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 15 ) THEN + CALL S2GRID(HMAXD, X1) + ! + ! STD of maximum wave height from crest + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 16 ) THEN + CALL S2GRID(HCMAXD, X1) + ! + ! Dominant wave breaking probability + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 17 ) THEN + CALL S2GRID(WBT, X1) + ! + ! Wave peak period (derived from peak freq field) + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 18 ) THEN + DO I=1,NSEA + IF(FP0(I) .NE. UNDEF) THEN + AUX1(I) = 1.0 / FP0(I) + ELSE + AUX1(I) = UNDEF + ENDIF + ENDDO + ! + CALL S2GRID(AUX1, X1) + ! + ! Mean wave number + ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 19 ) THEN + IF( SMCGRD ) THEN #ifdef W3_SMC - CALL W3S2XY_SMC( WNMEAN, X1 ) + CALL W3S2XY_SMC( WNMEAN, X1 ) #endif - ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WNMEAN, MAPSF, X1 ) - END IF - ! - ! Wave elevation spectrum - ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 1 ) THEN - ! Information for spectral - FLFRQ = .TRUE. - I1F=E3DF(2,1) - I2F=E3DF(3,1) - DO IK=I1F,I2F - CALL S2GRID(EF(:,IK), XX) - IF (NCVARTYPE.EQ.2) WHERE ( XX.GE.0.) XX = ALOG10(XX+1E-12) - XK(:,:,IK)=XX - END DO - ! - ! Mean wave direction frequency spectrum - ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 2 ) THEN - ! Information for spectral - FLFRQ = .TRUE. - I1F=E3DF(2,2) - I2F=E3DF(3,2) - DO IK=I1F,I2F + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WNMEAN, MAPSF, X1 ) + END IF + ! + ! Wave elevation spectrum + ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 1 ) THEN + ! Information for spectral + FLFRQ = .TRUE. + I1F=E3DF(2,1) + I2F=E3DF(3,1) + DO IK=I1F,I2F + CALL S2GRID(EF(:,IK), XX) + IF (NCVARTYPE.EQ.2) WHERE ( XX.GE.0.) XX = ALOG10(XX+1E-12) + XK(:,:,IK)=XX + END DO + ! + ! Mean wave direction frequency spectrum + ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 2 ) THEN + ! Information for spectral + FLFRQ = .TRUE. + I1F=E3DF(2,2) + I2F=E3DF(3,2) + DO IK=I1F,I2F #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, TH1M(:,IK), AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, TH1M(:,IK), AnglD, .FALSE.) #endif - CALL S2GRID(TH1M(:,IK), XX) - XK(:,:,IK)=XX - END DO - ! - ! Spreading frequency spectrum - ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 3 ) THEN - ! Information for spectral - FLFRQ = .TRUE. - I1F=E3DF(2,3) - I2F=E3DF(3,3) - DO IK=I1F,I2F - CALL S2GRID(STH1M(:,IK), XX) - XK(:,:,IK)=XX - END DO - ! - ! Second mean wave direction frequency spectrum - ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 4 ) THEN - ! Information for spectral - FLFRQ = .TRUE. - I1F=E3DF(2,4) - I2F=E3DF(3,4) - DO IK=I1F,I2F + CALL S2GRID(TH1M(:,IK), XX) + XK(:,:,IK)=XX + END DO + ! + ! Spreading frequency spectrum + ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 3 ) THEN + ! Information for spectral + FLFRQ = .TRUE. + I1F=E3DF(2,3) + I2F=E3DF(3,3) + DO IK=I1F,I2F + CALL S2GRID(STH1M(:,IK), XX) + XK(:,:,IK)=XX + END DO + ! + ! Second mean wave direction frequency spectrum + ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 4 ) THEN + ! Information for spectral + FLFRQ = .TRUE. + I1F=E3DF(2,4) + I2F=E3DF(3,4) + DO IK=I1F,I2F #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, TH2M(:,IK), AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, TH2M(:,IK), AnglD, .FALSE.) #endif - CALL S2GRID(TH2M(:,IK), XX) - XK(:,:,IK)=XX - END DO - ! - ! Second spreading frequency spectrum - ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 5 ) THEN - ! Information for spectral - FLFRQ = .TRUE. - I1F=E3DF(2,5) - I2F=E3DF(3,5) - DO IK=I1F,I2F - CALL S2GRID(STH2M(:,IK), XX) - XK(:,:,IK)=XX - END DO - ! - ! Wave numbers - ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 6 ) THEN - ! Information for spectral - FLFRQ = .TRUE. - I1F=1 - I2F=NK - DO IK=1,NK - CALL S2GRID(WN(IK,:), XX) - XK(:,:,IK)=XX - END DO - ! - ! Partition wave significant height - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN - CALL S2GRID(PHS(:,IPART), X1) - ! - ! Partition peak period - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN - CALL S2GRID(PTP(:,IPART), X1) + CALL S2GRID(TH2M(:,IK), XX) + XK(:,:,IK)=XX + END DO + ! + ! Second spreading frequency spectrum + ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 5 ) THEN + ! Information for spectral + FLFRQ = .TRUE. + I1F=E3DF(2,5) + I2F=E3DF(3,5) + DO IK=I1F,I2F + CALL S2GRID(STH2M(:,IK), XX) + XK(:,:,IK)=XX + END DO + ! + ! Wave numbers + ELSE IF ( IFI .EQ. 3 .AND. IFJ .EQ. 6 ) THEN + ! Information for spectral + FLFRQ = .TRUE. + I1F=1 + I2F=NK + DO IK=1,NK + CALL S2GRID(WN(IK,:), XX) + XK(:,:,IK)=XX + END DO + ! + ! Partition wave significant height + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN + CALL S2GRID(PHS(:,IPART), X1) + ! + ! Partition peak period + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN + CALL S2GRID(PTP(:,IPART), X1) - ! Partition peak wave length - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN - CALL S2GRID(PLP(:,IPART), X1) - ! - ! Partition wave mean direction - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN + ! Partition peak wave length + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN + CALL S2GRID(PLP(:,IPART), X1) + ! + ! Partition wave mean direction + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, PDIR(:,IPART), AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, PDIR(:,IPART), AnglD, .FALSE.) #endif - CALL S2GRID(PDIR(:,IPART), X1, .TRUE.) - ! - ! Partition directional spread - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN - CALL S2GRID(PSI(:,IPART), X1) - ! - ! Partition wind sea fraction - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN - CALL S2GRID(PWS(:,IPART), X1) - ! - ! Partition peak direction - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN + CALL S2GRID(PDIR(:,IPART), X1, .TRUE.) + ! + ! Partition directional spread + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN + CALL S2GRID(PSI(:,IPART), X1) + ! + ! Partition wind sea fraction + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN + CALL S2GRID(PWS(:,IPART), X1) + ! + ! Partition peak direction + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 7 ) THEN #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, PTHP0(:,IPART), AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, PTHP0(:,IPART), AnglD, .FALSE.) #endif - CALL S2GRID(PTHP0(:,IPART), X1, .TRUE.) - ! - ! Partition peakedness - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN - CALL S2GRID(PQP(:,IPART), X1) - ! - ! Partition peak enhancement factor - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 9 ) THEN - CALL S2GRID(PPE(:,IPART), X1) - ! - ! Partition frequency width - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 10 ) THEN - CALL S2GRID(PGW(:,IPART), X1) - ! - ! Partition spectral width - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 11 ) THEN - CALL S2GRID(PSW(:,IPART), X1) - ! - ! Partition mean period Tm10 - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 12 ) THEN - CALL S2GRID(PTM1(:,IPART), X1) - ! - ! Partition mean period T01 - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 13 ) THEN - CALL S2GRID(PT1(:,IPART), X1) - ! - ! Partition mean period T02 - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 14 ) THEN - CALL S2GRID(PT2(:,IPART), X1) - ! - ! Partition energy at peak frequency - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 15 ) THEN - CALL S2GRID(PEP(:,IPART), X1) - NFIELD=1 - ! - ! Partition wind sea fraction - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16 ) THEN - CALL S2GRID(PWST(:), X1) - ! - ! Number of wave partitions - ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17 ) THEN - CALL S2GRID(PNR(:), X1) - ! - ! Friction velocity - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 1 ) THEN - !! Note - UST and USTDIR read in from .ww3 file are X-Y vectors - DO ISEA=1, NSEA - UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2) - IF (UABS.GE.10.) THEN - UST(ISEA)=UNDEF - USTDIR(ISEA)=UNDEF - END IF - END DO + CALL S2GRID(PTHP0(:,IPART), X1, .TRUE.) + ! + ! Partition peakedness + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 8 ) THEN + CALL S2GRID(PQP(:,IPART), X1) + ! + ! Partition peak enhancement factor + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 9 ) THEN + CALL S2GRID(PPE(:,IPART), X1) + ! + ! Partition frequency width + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 10 ) THEN + CALL S2GRID(PGW(:,IPART), X1) + ! + ! Partition spectral width + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 11 ) THEN + CALL S2GRID(PSW(:,IPART), X1) + ! + ! Partition mean period Tm10 + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 12 ) THEN + CALL S2GRID(PTM1(:,IPART), X1) + ! + ! Partition mean period T01 + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 13 ) THEN + CALL S2GRID(PT1(:,IPART), X1) + ! + ! Partition mean period T02 + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 14 ) THEN + CALL S2GRID(PT2(:,IPART), X1) + ! + ! Partition energy at peak frequency + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 15 ) THEN + CALL S2GRID(PEP(:,IPART), X1) + NFIELD=1 + ! + ! Partition wind sea fraction + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16 ) THEN + CALL S2GRID(PWST(:), X1) + ! + ! Number of wave partitions + ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17 ) THEN + CALL S2GRID(PNR(:), X1) + ! + ! Friction velocity + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 1 ) THEN + !! Note - UST and USTDIR read in from .ww3 file are X-Y vectors + DO ISEA=1, NSEA + UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2) + IF (UABS.GE.10.) THEN + UST(ISEA)=UNDEF + USTDIR(ISEA)=UNDEF + END IF + END DO #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UST(1:NSEA), USTDIR(1:NSEA), AnglD) -#endif - CALL S2GRID(UST(1:NSEA), XX) - CALL S2GRID(USTDIR(1:NSEA), XY) - !! Commented out unnecessary statements below for time being - !! UST,USTDIR are in north-east convention and X1,X2 - !! are not actually written out below - !DO ISEA=1, NSEA - ! UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2) - ! IF ( UST(ISEA) .EQ. UNDEF ) THEN - ! USTDIR(ISEA) = UNDEF - ! UABS = UNDEF - ! ELSE IF ( UABS .GT. 0.05 ) THEN - ! USTDIR(ISEA) = MOD ( 630. - & - ! RADE*ATAN2(USTDIR(ISEA),UST(ISEA)) , 360. ) - ! ELSE - ! USTDIR(ISEA) = UNDEF - ! END IF - ! UST(ISEA) = UABS - ! END DO - !CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) , MAPSF, X1 ) - !CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) , MAPSF, X2 ) - NFIELD=2 - ! - ! Charnock coefficient - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN - CALL S2GRID(CHARN(1:NSEA), X1) - ! - ! Wave energy flux - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN - DO ISEA=1, NSEA - IF ( CGE(ISEA) .NE. UNDEF ) & - CGE(ISEA) = 0.001 * CGE(ISEA) ! from W / m to kW / m - END DO - CALL S2GRID(CGE(1:NSEA), X1) - ! - ! Wind to wave energy flux - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - CALL S2GRID(PHIAW(1:NSEA), X1) - ! - ! Wave supported wind stress - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UST(1:NSEA), USTDIR(1:NSEA), AnglD) +#endif + CALL S2GRID(UST(1:NSEA), XX) + CALL S2GRID(USTDIR(1:NSEA), XY) + !! Commented out unnecessary statements below for time being + !! UST,USTDIR are in north-east convention and X1,X2 + !! are not actually written out below + !DO ISEA=1, NSEA + ! UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2) + ! IF ( UST(ISEA) .EQ. UNDEF ) THEN + ! USTDIR(ISEA) = UNDEF + ! UABS = UNDEF + ! ELSE IF ( UABS .GT. 0.05 ) THEN + ! USTDIR(ISEA) = MOD ( 630. - & + ! RADE*ATAN2(USTDIR(ISEA),UST(ISEA)) , 360. ) + ! ELSE + ! USTDIR(ISEA) = UNDEF + ! END IF + ! UST(ISEA) = UABS + ! END DO + !CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) , MAPSF, X1 ) + !CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) , MAPSF, X2 ) + NFIELD=2 + ! + ! Charnock coefficient + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 2 ) THEN + CALL S2GRID(CHARN(1:NSEA), X1) + ! + ! Wave energy flux + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 3 ) THEN + DO ISEA=1, NSEA + IF ( CGE(ISEA) .NE. UNDEF ) & + CGE(ISEA) = 0.001 * CGE(ISEA) ! from W / m to kW / m + END DO + CALL S2GRID(CGE(1:NSEA), X1) + ! + ! Wind to wave energy flux + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 4 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 + CALL S2GRID(PHIAW(1:NSEA), X1) + ! + ! Wave supported wind stress + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 5 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUWIX(1:NSEA), TAUWIY(1:NSEA), AnglD) -#endif - CALL S2GRID(TAUWIX(1:NSEA), XX) - CALL S2GRID(TAUWIY(1:NSEA), XY) - - !! Commented out unnecessary statements below for time being - !! TAUWIX, TAUWIY are in north-east convention and X1,X2 - !! are not actually written out below - !DO ISEA=1, NSEA - ! CABS = SQRT(TAUWIX(ISEA)**2+TAUWIY(ISEA)**2) - ! IF ( CABS .NE. UNDEF ) THEN - ! TAUWIY(ISEA) = MOD ( 630. - & - ! RADE*ATAN2(TAUWIY(ISEA),TAUWIX(ISEA)) , 360. ) - ! ELSE - ! TAUWIY(ISEA) = UNDEF - ! END IF - ! TAUWIX(ISEA) = CABS - ! END DO - !CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX, MAPSF, X1 ) - !CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY, MAPSF, X2 ) - NFIELD=2 - ! - ! Wave to wind stress - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUWIX(1:NSEA), TAUWIY(1:NSEA), AnglD) +#endif + CALL S2GRID(TAUWIX(1:NSEA), XX) + CALL S2GRID(TAUWIY(1:NSEA), XY) + + !! Commented out unnecessary statements below for time being + !! TAUWIX, TAUWIY are in north-east convention and X1,X2 + !! are not actually written out below + !DO ISEA=1, NSEA + ! CABS = SQRT(TAUWIX(ISEA)**2+TAUWIY(ISEA)**2) + ! IF ( CABS .NE. UNDEF ) THEN + ! TAUWIY(ISEA) = MOD ( 630. - & + ! RADE*ATAN2(TAUWIY(ISEA),TAUWIX(ISEA)) , 360. ) + ! ELSE + ! TAUWIY(ISEA) = UNDEF + ! END IF + ! TAUWIX(ISEA) = CABS + ! END DO + !CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX, MAPSF, X1 ) + !CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY, MAPSF, X2 ) + NFIELD=2 + ! + ! Wave to wind stress + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 6 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUWNX(1:NSEA), TAUWNY(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUWNX(1:NSEA), TAUWNY(1:NSEA), AnglD) #endif - CALL S2GRID(TAUWNX(1:NSEA), XX) - CALL S2GRID(TAUWNY(1:NSEA), XY) - NFIELD=2 - ! - ! Whitecap coverage - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,1), X1) - ! - ! Whitecap foam thickness - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,2), X1) - ! - ! Significant breaking wave height - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,3), X1) - ! - ! Whitecap moment - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,4), X1) - ! - ! Wind sea mean period T0M1 - ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN - CALL S2GRID(TWS(1:NSEA), X1) - ! - ! Radiation stress - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN + CALL S2GRID(TAUWNX(1:NSEA), XX) + CALL S2GRID(TAUWNY(1:NSEA), XY) + NFIELD=2 + ! + ! Whitecap coverage + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN + CALL S2GRID(WHITECAP(1:NSEA,1), X1) + ! + ! Whitecap foam thickness + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN + CALL S2GRID(WHITECAP(1:NSEA,2), X1) + ! + ! Significant breaking wave height + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN + CALL S2GRID(WHITECAP(1:NSEA,3), X1) + ! + ! Whitecap moment + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN + CALL S2GRID(WHITECAP(1:NSEA,4), X1) + ! + ! Wind sea mean period T0M1 + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN + CALL S2GRID(TWS(1:NSEA), X1) + ! + ! Radiation stress + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 1 ) THEN #ifdef W3_RTD - ! Radition stress components are always left on rotated pole - ! at present - need to confirm how to de-rotate + ! Radition stress components are always left on rotated pole + ! at present - need to confirm how to de-rotate #endif - CALL S2GRID(SXX(1:NSEA), X1) - CALL S2GRID(SYY(1:NSEA), X2) - CALL S2GRID(SXY(1:NSEA), XY) - NFIELD=3 - ! - ! Wave to ocean stress - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN + CALL S2GRID(SXX(1:NSEA), X1) + CALL S2GRID(SYY(1:NSEA), X2) + CALL S2GRID(SXY(1:NSEA), XY) + NFIELD=3 + ! + ! Wave to ocean stress + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 2 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUOX(1:NSEA), TAUOY(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUOX(1:NSEA), TAUOY(1:NSEA), AnglD) #endif - CALL S2GRID(TAUOX(1:NSEA), XX) - CALL S2GRID(TAUOY(1:NSEA), XY) - NFIELD=2 - ! - ! Radiation pressure (Bernouilli Head) - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 3 ) THEN - CALL S2GRID(BHD(1:NSEA), X1) - ! - ! Wave to ocean energy flux - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - DO ISEA=1, NSEA - PHIOC(ISEA)=MIN(3000.,PHIOC(ISEA)) - END DO - CALL S2GRID(PHIOC(1:NSEA), X1) - ! - ! Stokes transport - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN + CALL S2GRID(TAUOX(1:NSEA), XX) + CALL S2GRID(TAUOY(1:NSEA), XY) + NFIELD=2 + ! + ! Radiation pressure (Bernouilli Head) + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 3 ) THEN + CALL S2GRID(BHD(1:NSEA), X1) + ! + ! Wave to ocean energy flux + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 4 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 + DO ISEA=1, NSEA + PHIOC(ISEA)=MIN(3000.,PHIOC(ISEA)) + END DO + CALL S2GRID(PHIOC(1:NSEA), X1) + ! + ! Stokes transport + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 5 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TUSX(1:NSEA), TUSY(1:NSEA), AnglD) -#endif - CALL S2GRID(TUSX(1:NSEA), XX) - CALL S2GRID(TUSY(1:NSEA), XY) - ! X1, X2 will not be output when NFIELD == 2 - ! ( Like for .cur, .wnd, .ust, .taw, and .uss ) (CHA at FCOO 2019-06-13): - !! Commented out unnecessary statements below for time being - !! (...) X1,X2 are not actually written out below - !DO ISEA=1, NSEA - ! CABS = SQRT(TUSX(ISEA)**2+TUSY(ISEA)**2) - ! IF ( CABS .NE. UNDEF ) THEN - ! TUSY(ISEA) = MOD ( 630. - & - ! RADE*ATAN2(TUSY(ISEA),TUSX(ISEA)) , 360. ) - ! ELSE - ! TUSY(ISEA) = UNDEF - ! END IF - ! TUSX(ISEA) = CABS - ! END DO - !IF( SMCGRD ) THEN + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TUSX(1:NSEA), TUSY(1:NSEA), AnglD) +#endif + CALL S2GRID(TUSX(1:NSEA), XX) + CALL S2GRID(TUSY(1:NSEA), XY) + ! X1, X2 will not be output when NFIELD == 2 + ! ( Like for .cur, .wnd, .ust, .taw, and .uss ) (CHA at FCOO 2019-06-13): + !! Commented out unnecessary statements below for time being + !! (...) X1,X2 are not actually written out below + !DO ISEA=1, NSEA + ! CABS = SQRT(TUSX(ISEA)**2+TUSY(ISEA)**2) + ! IF ( CABS .NE. UNDEF ) THEN + ! TUSY(ISEA) = MOD ( 630. - & + ! RADE*ATAN2(TUSY(ISEA),TUSX(ISEA)) , 360. ) + ! ELSE + ! TUSY(ISEA) = UNDEF + ! END IF + ! TUSX(ISEA) = CABS + ! END DO + !IF( SMCGRD ) THEN #ifdef W3_SMC - !CALL W3S2XY_SMC( TUSX(:), X1 ) - !CALL W3S2XY_SMC( TUSY(:), X2 ) ! TODO: CHRISB: TUSY is in degrees....W3S2XY_SMC expects radians... -#endif - !ELSE - ! CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSX,MAPSF, X1 ) - ! CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSY,MAPSF, X2 ) - !ENDIF ! SMCGRD - NFIELD=2 - ! - ! Surface stokes drift - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN - DO ISEA=1, NSEA - USSX(ISEA)=MAX(-0.9998,MIN(0.9998,USSX(ISEA))) - USSY(ISEA)=MAX(-0.9998,MIN(0.9998,USSY(ISEA))) - END DO -#ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, USSX(1:NSEA), USSY(1:NSEA), AnglD) -#endif - CALL S2GRID(USSX(1:NSEA), XX) - CALL S2GRID(USSY(1:NSEA), XY) - !! Commented out unnecessary statements below for time being - !! TAUWIX, TAUWIY are in north-east convention and X1,X2 - !! are not actually written out below - !DO ISEA=1, NSEA - ! CABS = SQRT(USSX(ISEA)**2+USSY(ISEA)**2) - ! IF ( CABS .NE. UNDEF ) THEN - ! USSY(ISEA) = MOD ( 630. - & - ! RADE*ATAN2(USSY(ISEA),USSX(ISEA)) , 360. ) - ! ELSE - ! USSY(ISEA) = UNDEF - ! END IF - ! USSX(ISEA) = CABS - ! END DO - !CALL W3S2XY ( NSEA, NSEA, NX+1, NY,USSX,MAPSF, X1 ) - !CALL W3S2XY ( NSEA, NSEA, NX+1, NY,USSY,MAPSF, X2 ) - NFIELD=2 - ! - ! Power spectral density of equivalent surface pressure - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN - NFIELD=2 - CALL S2GRID(PRMS(1:NSEA), XX) - CALL S2GRID(TPMS(1:NSEA), XY) - ! - ! Spectral variance of surface stokes drift - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 8 ) THEN - ! Information for spectral distribution of surface Stokes drift (2nd file) - FLFRQ=.TRUE. - NFIELD=2 - I1F=US3DF(2) - I2F=US3DF(3) - DO IK= I1F,I2F + !CALL W3S2XY_SMC( TUSX(:), X1 ) + !CALL W3S2XY_SMC( TUSY(:), X2 ) ! TODO: CHRISB: TUSY is in degrees....W3S2XY_SMC expects radians... +#endif + !ELSE + ! CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSX,MAPSF, X1 ) + ! CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSY,MAPSF, X2 ) + !ENDIF ! SMCGRD + NFIELD=2 + ! + ! Surface stokes drift + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 6 ) THEN + DO ISEA=1, NSEA + USSX(ISEA)=MAX(-0.9998,MIN(0.9998,USSX(ISEA))) + USSY(ISEA)=MAX(-0.9998,MIN(0.9998,USSY(ISEA))) + END DO #ifdef W3_RTD ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, US3D(:,IK), US3D(:,NK+IK), AnglD) + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, USSX(1:NSEA), USSY(1:NSEA), AnglD) +#endif + CALL S2GRID(USSX(1:NSEA), XX) + CALL S2GRID(USSY(1:NSEA), XY) + !! Commented out unnecessary statements below for time being + !! TAUWIX, TAUWIY are in north-east convention and X1,X2 + !! are not actually written out below + !DO ISEA=1, NSEA + ! CABS = SQRT(USSX(ISEA)**2+USSY(ISEA)**2) + ! IF ( CABS .NE. UNDEF ) THEN + ! USSY(ISEA) = MOD ( 630. - & + ! RADE*ATAN2(USSY(ISEA),USSX(ISEA)) , 360. ) + ! ELSE + ! USSY(ISEA) = UNDEF + ! END IF + ! USSX(ISEA) = CABS + ! END DO + !CALL W3S2XY ( NSEA, NSEA, NX+1, NY,USSX,MAPSF, X1 ) + !CALL W3S2XY ( NSEA, NSEA, NX+1, NY,USSY,MAPSF, X2 ) + NFIELD=2 + ! + ! Power spectral density of equivalent surface pressure + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 7 ) THEN + NFIELD=2 + CALL S2GRID(PRMS(1:NSEA), XX) + CALL S2GRID(TPMS(1:NSEA), XY) + ! + ! Spectral variance of surface stokes drift + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 8 ) THEN + ! Information for spectral distribution of surface Stokes drift (2nd file) + FLFRQ=.TRUE. + NFIELD=2 + I1F=US3DF(2) + I2F=US3DF(3) + DO IK= I1F,I2F +#ifdef W3_RTD + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, US3D(:,IK), US3D(:,NK+IK), AnglD) #endif - CALL S2GRID(US3D(:,IK), XX) - CALL S2GRID(US3D(:,NK+IK), XY) - XXK(:,:,IK)=XX - XYK(:,:,IK)=XY - END DO - ! - ! Base10 logarithm of power spectral density of equivalent surface pressure - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN - ! Information for spectral microseismic generation data (2nd file) - FLFRQ=.TRUE. - I1F=P2MSF(2) - I2F=P2MSF(3) - DO IK=I1F,I2F - CALL S2GRID(P2SMS(:,IK), XX) - - IF (NCVARTYPE.EQ.2) THEN - WHERE ( XX.GE.0.) XX = ALOG10(XX*(DWAT*GRAV)**2+1E-12) - ELSE - WHERE ( XX.GE.0.) XX = XX*(DWAT*GRAV)**2 - END IF + CALL S2GRID(US3D(:,IK), XX) + CALL S2GRID(US3D(:,NK+IK), XY) + XXK(:,:,IK)=XX + XYK(:,:,IK)=XY + END DO + ! + ! Base10 logarithm of power spectral density of equivalent surface pressure + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN + ! Information for spectral microseismic generation data (2nd file) + FLFRQ=.TRUE. + I1F=P2MSF(2) + I2F=P2MSF(3) + DO IK=I1F,I2F + CALL S2GRID(P2SMS(:,IK), XX) - XK(:,:,IK)=XX - END DO - ! - ! Wave to sea ice stress - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN + IF (NCVARTYPE.EQ.2) THEN + WHERE ( XX.GE.0.) XX = ALOG10(XX*(DWAT*GRAV)**2+1E-12) + ELSE + WHERE ( XX.GE.0.) XX = XX*(DWAT*GRAV)**2 + END IF + + XK(:,:,IK)=XX + END DO + ! + ! Wave to sea ice stress + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUICE(1:NSEA,1), TAUICE(1:NSEA,2), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUICE(1:NSEA,1), TAUICE(1:NSEA,2), AnglD) #endif - CALL S2GRID(TAUICE(1:NSEA,1), XX) - CALL S2GRID(TAUICE(1:NSEA,2), XY) - NFIELD=2 - ! - ! Wave to sea ice energy flux - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - CALL S2GRID(PHICE(1:NSEA), X1) - ! - ! Partitioned surface stokes drift - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN - ! Information for spectral distribution of surface Stokes drift (2nd file) - FLFRQ=.TRUE. - IF (USSPF(1)==1) THEN - CUSTOMFRQ=.TRUE. - ENDIF - NFIELD=2 - I1F=1 - I2F=USSPF(2) - DO IK= I1F,I2F + CALL S2GRID(TAUICE(1:NSEA,1), XX) + CALL S2GRID(TAUICE(1:NSEA,2), XY) + NFIELD=2 + ! + ! Wave to sea ice energy flux + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 + CALL S2GRID(PHICE(1:NSEA), X1) + ! + ! Partitioned surface stokes drift + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN + ! Information for spectral distribution of surface Stokes drift (2nd file) + FLFRQ=.TRUE. + IF (USSPF(1)==1) THEN + CUSTOMFRQ=.TRUE. + ENDIF + NFIELD=2 + I1F=1 + I2F=USSPF(2) + DO IK= I1F,I2F #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, USSP(:,IK), USSP(:,NK+IK), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, USSP(:,IK), USSP(:,NK+IK), AnglD) #endif - CALL S2GRID(USSP(:,IK), XX) - CALL S2GRID(USSP(:,NK+IK), XY) - XXK(:,:,IK) = XX - XYK(:,:,IK) = XY - END DO - ! - ! Total momentum to the ocean - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN + CALL S2GRID(USSP(:,IK), XX) + CALL S2GRID(USSP(:,NK+IK), XY) + XXK(:,:,IK) = XX + XYK(:,:,IK) = XY + END DO + ! + ! Total momentum to the ocean + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUOCX(1:NSEA), TAUOCY(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUOCX(1:NSEA), TAUOCY(1:NSEA), AnglD) #endif - IF( SMCGRD ) THEN + IF( SMCGRD ) THEN #ifdef W3_SMC - CALL W3S2XY_SMC( TAUOCX(1:NSEA), XX ) - CALL W3S2XY_SMC( TAUOCY(1:NSEA), XY ) + CALL W3S2XY_SMC( TAUOCX(1:NSEA), XX ) + CALL W3S2XY_SMC( TAUOCY(1:NSEA), XY ) #endif - ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOCX(1:NSEA) & - , MAPSF, XX ) - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOCY(1:NSEA) & - , MAPSF, XY ) - ENDIF ! SMCGRD - NFIELD=2 - ! - ! RMS of bottom displacement amplitude - ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 1 ) THEN - ! NB: ABA and ABD are the X and Y components of the bottom displacement + ELSE + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOCX(1:NSEA) & + , MAPSF, XX ) + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUOCY(1:NSEA) & + , MAPSF, XY ) + ENDIF ! SMCGRD + NFIELD=2 + ! + ! RMS of bottom displacement amplitude + ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 1 ) THEN + ! NB: ABA and ABD are the X and Y components of the bottom displacement #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, ABA(1:NSEA), ABD(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, ABA(1:NSEA), ABD(1:NSEA), AnglD) #endif - CALL S2GRID(ABA(1:NSEA), XX) - CALL S2GRID(ABD(1:NSEA), XY) - NFIELD=2 - ! - ! RMS of bottom velocity amplitude - ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN - ! NB: UBA and UBD are the X and Y components of the bottom velocity + CALL S2GRID(ABA(1:NSEA), XX) + CALL S2GRID(ABD(1:NSEA), XY) + NFIELD=2 + ! + ! RMS of bottom velocity amplitude + ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 2 ) THEN + ! NB: UBA and UBD are the X and Y components of the bottom velocity #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UBA(1:NSEA), UBD(1:NSEA), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UBA(1:NSEA), UBD(1:NSEA), AnglD) #endif - CALL S2GRID(UBA(1:NSEA), XX) - CALL S2GRID(UBD(1:NSEA), XY) - NFIELD=2 - ! - ! Bottom roughness - ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN -#ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, BEDFORMS(1:NSEA,2), & - BEDFORMS(1:NSEA,3), AnglD) -#endif - CALL S2GRID(BEDFORMS(1:NSEA,1), X1) - CALL S2GRID(BEDFORMS(1:NSEA,2), X2) - CALL S2GRID(BEDFORMS(1:NSEA,3), XY) - NFIELD=3 - ! - ! Wave dissipation in bottom boundary layer - ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN - CALL S2GRID(PHIBBL(1:NSEA), X1) - ! - ! Wave to bottom boundary layer stress - ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN + CALL S2GRID(UBA(1:NSEA), XX) + CALL S2GRID(UBD(1:NSEA), XY) + NFIELD=2 + ! + ! Bottom roughness + ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 3 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUBBL(1:NSEA,1), & - TAUBBL(1:NSEA,2), AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, BEDFORMS(1:NSEA,2), & + BEDFORMS(1:NSEA,3), AnglD) #endif - CALL S2GRID(TAUBBL(1:NSEA,1), XX) - CALL S2GRID(TAUBBL(1:NSEA,2), XY) - NFIELD=2 - ! - ! Mean square slope - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN + CALL S2GRID(BEDFORMS(1:NSEA,1), X1) + CALL S2GRID(BEDFORMS(1:NSEA,2), X2) + CALL S2GRID(BEDFORMS(1:NSEA,3), XY) + NFIELD=3 + ! + ! Wave dissipation in bottom boundary layer + ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN + CALL S2GRID(PHIBBL(1:NSEA), X1) + ! + ! Wave to bottom boundary layer stress + ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, MSSX, MSSY, AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUBBL(1:NSEA,1), & + TAUBBL(1:NSEA,2), AnglD) #endif - CALL S2GRID(MSSX, XX) - CALL S2GRID(MSSY, XY) - NFIELD=2 - ! - ! Phillips constant - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN + CALL S2GRID(TAUBBL(1:NSEA,1), XX) + CALL S2GRID(TAUBBL(1:NSEA,2), XY) + NFIELD=2 + ! + ! Mean square slope + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 1 ) THEN #ifdef W3_RTD - ! Rotate x,y vector back to standard pole - IF ( FLAGUNR ) CALL W3XYRTN(NSEA, MSCX, MSCY, AnglD) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, MSSX, MSSY, AnglD) #endif - CALL S2GRID(MSCX, XX) - CALL S2GRID(MSCY, XY) - NFIELD=2 - ! - ! u direction for mss - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 3 ) THEN + CALL S2GRID(MSSX, XX) + CALL S2GRID(MSSY, XY) + NFIELD=2 + ! + ! Phillips constant + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 2 ) THEN #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, MSSD, AnglD, .FALSE.) + ! Rotate x,y vector back to standard pole + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, MSCX, MSCY, AnglD) #endif - DO ISEA=1, NSEA - IF ( MSSD(ISEA) .NE. UNDEF ) THEN - MSSD(ISEA) = MOD ( 630. - RADE*MSSD(ISEA) , 180. ) - END IF - END DO - CALL S2GRID(MSSD, X1) - ! - ! x direction for msc - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 4 ) THEN + CALL S2GRID(MSCX, XX) + CALL S2GRID(MSCY, XY) + NFIELD=2 + ! + ! u direction for mss + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 3 ) THEN #ifdef W3_RTD - ! Rotate direction back to standard pole - IF ( FLAGUNR ) CALL W3THRTN(NSEA, MSCD, AnglD, .FALSE.) + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, MSSD, AnglD, .FALSE.) #endif - DO ISEA=1, NSEA - IF ( MSCD(ISEA) .NE. UNDEF ) THEN - MSCD(ISEA) = MOD ( 630. - RADE*MSCD(ISEA) , 180. ) - END IF - END DO - CALL S2GRID(MSCD, X1) - ! - ! Peakedness - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN - CALL S2GRID(QP, X1) - ! - ! k bandwidth - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN - CALL S2GRID(QKK, X1) - ! - ! surface elevation skewness lambda_3,0,0 - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN - CALL S2GRID(SKEW, X1) - ! - ! em bias param 1 - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN - CALL S2GRID(EMBIA1, X1) - ! - ! em bias param 2 - ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN - CALL S2GRID(EMBIA2, X1) - ! - ! Dynamic time step - ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN - DO ISEA=1, NSEA - IF ( DTDYN(ISEA) .NE. UNDEF ) THEN - DTDYN(ISEA) = DTDYN(ISEA) / 60. - END IF - END DO - CALL S2GRID(DTDYN, X1) - ! - ! Cut off frequency - ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN - CALL S2GRID(FCUT, X1) - ! - ! Maximum CFL for spatial advection - ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - CALL S2GRID(CFLXYMAX, X1) - ! - ! Maximum CFL for direction advection - ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - CALL S2GRID(CFLTHMAX, X1) - ! - ! Maximum CFL for frequency advection - ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN - IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 - CALL S2GRID(CFLKMAX, X1) - ! - ! User defined... - ELSE IF ( IFI .EQ. 10 ) THEN - !CB WRITE (ENAME,'(A2,I2.2)') '.u', IFJ - CALL S2GRID(USERO(:,IFJ), X1) - ELSE - WRITE (NDSE,999) IFI, IFJ - CALL EXTCDE ( 1 ) - ! - END IF ! IFI AND IFJ - - ! CB Get netCDF metadata for IFI, IFJ combination (all components). - DO I=1,NFIELD - META(I) = GETMETA(IFI, IFJ, ICOMP=I, IPART=IPART) - ENDDO - - ! 2.2 Make map - - ! CB: TODO - need to handle MAPSTA differently for SMC grid output. - IF( .NOT. SMCGRD ) THEN - DO IX=1, NX - DO IY=1, NY - MAPOUT(IX,IY)=INT2(MAPSTA(IY,IX) + 8*MAPST2(IY,IX)) - IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN - X1(IX,IY) = UNDEF - X2(IX,IY) = UNDEF - XX(IX,IY) = UNDEF - XY(IX,IY) = UNDEF + DO ISEA=1, NSEA + IF ( MSSD(ISEA) .NE. UNDEF ) THEN + MSSD(ISEA) = MOD ( 630. - RADE*MSSD(ISEA) , 180. ) END IF - IF ( X1(IX,IY) .EQ. UNDEF ) THEN - MAP(IX,IY) = 0 - ELSE - MAP(IX,IY) = 1 + END DO + CALL S2GRID(MSSD, X1) + ! + ! x direction for msc + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 4 ) THEN +#ifdef W3_RTD + ! Rotate direction back to standard pole + IF ( FLAGUNR ) CALL W3THRTN(NSEA, MSCD, AnglD, .FALSE.) +#endif + DO ISEA=1, NSEA + IF ( MSCD(ISEA) .NE. UNDEF ) THEN + MSCD(ISEA) = MOD ( 630. - RADE*MSCD(ISEA) , 180. ) END IF - IF ( X2(IX,IY) .EQ. UNDEF ) THEN - MP2(IX,IY) = 0 - ELSE - MP2(IX,IY) = 1 + END DO + CALL S2GRID(MSCD, X1) + ! + ! Peakedness + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 5 ) THEN + CALL S2GRID(QP, X1) + ! + ! k bandwidth + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 6 ) THEN + CALL S2GRID(QKK, X1) + ! + ! surface elevation skewness lambda_3,0,0 + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 7 ) THEN + CALL S2GRID(SKEW, X1) + ! + ! em bias param 1 + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 8 ) THEN + CALL S2GRID(EMBIA1, X1) + ! + ! em bias param 2 + ELSE IF ( IFI .EQ. 8 .AND. IFJ .EQ. 9 ) THEN + CALL S2GRID(EMBIA2, X1) + ! + ! Dynamic time step + ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN + DO ISEA=1, NSEA + IF ( DTDYN(ISEA) .NE. UNDEF ) THEN + DTDYN(ISEA) = DTDYN(ISEA) / 60. END IF END DO - END DO - ENDIF ! CB + CALL S2GRID(DTDYN, X1) + ! + ! Cut off frequency + ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN + CALL S2GRID(FCUT, X1) + ! + ! Maximum CFL for spatial advection + ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 + CALL S2GRID(CFLXYMAX, X1) + ! + ! Maximum CFL for direction advection + ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 + CALL S2GRID(CFLTHMAX, X1) + ! + ! Maximum CFL for frequency advection + ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 5 ) THEN + IF (NCVARTYPEI.EQ.3) NCVARTYPE=4 + CALL S2GRID(CFLKMAX, X1) + ! + ! User defined... + ELSE IF ( IFI .EQ. 10 ) THEN + !CB WRITE (ENAME,'(A2,I2.2)') '.u', IFJ + CALL S2GRID(USERO(:,IFJ), X1) + ELSE + WRITE (NDSE,999) IFI, IFJ + CALL EXTCDE ( 1 ) + ! + END IF ! IFI AND IFJ + + ! CB Get netCDF metadata for IFI, IFJ combination (all components). + DO I=1,NFIELD + META(I) = GETMETA(IFI, IFJ, ICOMP=I, IPART=IPART) + ENDDO + + ! 2.2 Make map + + ! CB: TODO - need to handle MAPSTA differently for SMC grid output. + IF( .NOT. SMCGRD ) THEN + DO IX=1, NX + DO IY=1, NY + MAPOUT(IX,IY)=INT2(MAPSTA(IY,IX) + 8*MAPST2(IY,IX)) + IF ( MAPSTA(IY,IX) .EQ. 0 ) THEN + X1(IX,IY) = UNDEF + X2(IX,IY) = UNDEF + XX(IX,IY) = UNDEF + XY(IX,IY) = UNDEF + END IF + IF ( X1(IX,IY) .EQ. UNDEF ) THEN + MAP(IX,IY) = 0 + ELSE + MAP(IX,IY) = 1 + END IF + IF ( X2(IX,IY) .EQ. UNDEF ) THEN + MP2(IX,IY) = 0 + ELSE + MP2(IX,IY) = 1 + END IF + END DO + END DO + ENDIF ! CB - ! 2.3 Setups the output type 4 ( NetCDF file ) + ! 2.3 Setups the output type 4 ( NetCDF file ) - S2=LEN_TRIM(META(1)%ENAME) - S1=LEN_TRIM(FILEPREFIX)+S4 - FNAMENC(S1+1:128)=' ' - FNAMENC(S1+1:S1+1) = '_' + S2=LEN_TRIM(META(1)%ENAME) + S1=LEN_TRIM(FILEPREFIX)+S4 + FNAMENC(S1+1:128)=' ' + FNAMENC(S1+1:S1+1) = '_' - ! If flag TOGETHER and not variable with freq dim & - ! (ef, p2l, ...), no variable name in file name - IF (TOGETHER.AND.(.NOT.FLFRQ)) THEN - S2=0 - ! If NOT flag TOGETHER or variable with freq dim & - ! (ef, p2l, ...), add variable name in file name - ELSE - FNAMENC(S1+2:S1+S2) = META(1)%ENAME(2:S2) - ENDIF - ! Defines the netcdf extension - FNAMENC(S1+S2+1:S1+S2+3) = '.nc' - FNAMENC(S1+S2+4:S1+S2+6) = ' ' - ! If the flag frequency is .TRUE., defines the fourth dimension - IF (FLFRQ) THEN - DIMLN(4)=I2F-I1F+1 - EXTRADIM=1 - ELSE - DIMLN(4)=0 - EXTRADIM=0 - END IF + ! If flag TOGETHER and not variable with freq dim & + ! (ef, p2l, ...), no variable name in file name + IF (TOGETHER.AND.(.NOT.FLFRQ)) THEN + S2=0 + ! If NOT flag TOGETHER or variable with freq dim & + ! (ef, p2l, ...), add variable name in file name + ELSE + FNAMENC(S1+2:S1+S2) = META(1)%ENAME(2:S2) + ENDIF + ! Defines the netcdf extension + FNAMENC(S1+S2+1:S1+S2+3) = '.nc' + FNAMENC(S1+S2+4:S1+S2+6) = ' ' + ! If the flag frequency is .TRUE., defines the fourth dimension + IF (FLFRQ) THEN + DIMLN(4)=I2F-I1F+1 + EXTRADIM=1 + ELSE + DIMLN(4)=0 + EXTRADIM=0 + END IF - ! If regular grid, initializes the lat/lon or x/y dimension lengths - IF (GTYPE.NE.UNGTYPE) THEN - IF( SMCGRD ) THEN + ! If regular grid, initializes the lat/lon or x/y dimension lengths + IF (GTYPE.NE.UNGTYPE) THEN + IF( SMCGRD ) THEN #ifdef W3_SMC - IF( SMCOTYPE .EQ. 1 ) THEN - ! Flat seapoints file - !dimln(2) = NSEA - dimln(2) = SMCNOUT - dimln(3) = -1 ! not used - ELSE - ! Regular gridded lat/lon file: - dimln(2) = NXO - dimln(3) = NYO - ENDIF ! SMCOTYPE + IF( SMCOTYPE .EQ. 1 ) THEN + ! Flat seapoints file + !dimln(2) = NSEA + dimln(2) = SMCNOUT + dimln(3) = -1 ! not used + ELSE + ! Regular gridded lat/lon file: + dimln(2) = NXO + dimln(3) = NYO + ENDIF ! SMCOTYPE #endif - ELSE ! SMCGRD + ELSE ! SMCGRD + DIMLN(2)=IXN-IX1+1 + DIMLN(3)=IYN-IY1+1 + ENDIF ! SMCGRD + ! If unstructured mesh, initializes the nelem,tri dimension lengths + ELSE DIMLN(2)=IXN-IX1+1 - DIMLN(3)=IYN-IY1+1 - ENDIF ! SMCGRD - ! If unstructured mesh, initializes the nelem,tri dimension lengths - ELSE - DIMLN(2)=IXN-IX1+1 - DIMLN(3)=NTRI - ENDIF + DIMLN(3)=NTRI + ENDIF - ! Defines index of first field variable - IVAR1=21 + ! Defines index of first field variable + IVAR1=21 - ! 2.4.1 Save the id of the previous file + ! 2.4.1 Save the id of the previous file - IF (TOGETHER.AND.(.NOT.FLFRQ)) THEN - OLDNCID = NCIDS(1,1,1) - ELSE - OLDNCID = NCIDS(IFI,IFJ,IPART+1) - END IF + IF (TOGETHER.AND.(.NOT.FLFRQ)) THEN + OLDNCID = NCIDS(1,1,1) + ELSE + OLDNCID = NCIDS(IFI,IFJ,IPART+1) + END IF - ! 2.4.2 Remove the new file (if not created by the run) + ! 2.4.2 Remove the new file (if not created by the run) - INQUIRE(FILE=FNAMENC, EXIST=FEXIST) - IF (FEXIST) THEN - FREMOVE = .FALSE. - ! time splitted condition - IF (INDEX(TIMEID,OLDTIMEID).EQ.0) THEN - ! all variables in the samefile - IF (TOGETHER.AND.(.NOT.FLFRQ).AND.NCID.EQ.0) FREMOVE = .TRUE. - ! a file per variable - IF (.NOT.TOGETHER.OR.FLFRQ) FREMOVE = .TRUE. - END IF + INQUIRE(FILE=FNAMENC, EXIST=FEXIST) + IF (FEXIST) THEN + FREMOVE = .FALSE. + ! time splitted condition + IF (INDEX(TIMEID,OLDTIMEID).EQ.0) THEN + ! all variables in the samefile + IF (TOGETHER.AND.(.NOT.FLFRQ).AND.NCID.EQ.0) FREMOVE = .TRUE. + ! a file per variable + IF (.NOT.TOGETHER.OR.FLFRQ) FREMOVE = .TRUE. + END IF - IF (FREMOVE) THEN - OPEN(UNIT=1234, IOSTAT=IRET, FILE=FNAMENC, STATUS='old') - IF (IRET == 0) CLOSE(1234, STATUS='delete') - FEXIST=.FALSE. - ELSE - NCID = OLDNCID + IF (FREMOVE) THEN + OPEN(UNIT=1234, IOSTAT=IRET, FILE=FNAMENC, STATUS='old') + IF (IRET == 0) CLOSE(1234, STATUS='delete') + FEXIST=.FALSE. + ELSE + NCID = OLDNCID + END IF END IF - END IF - ! 2.4.3 Finalize the previous file (if a new one will be created) + ! 2.4.3 Finalize the previous file (if a new one will be created) - IF (.NOT.FEXIST) THEN - IF (INDEX('0000000000000000',OLDTIMEID).EQ.0 .AND. INDEX(TIMEID,OLDTIMEID).EQ.0) THEN - IRET = NF90_REDEF(OLDNCID) - CALL CHECK_ERR(IRET) - IF(FL_DEFAULT_GBL_META) THEN - IRET=NF90_PUT_ATT(OLDNCID,NF90_GLOBAL,'stop_date',STRSTOPDATE) + IF (.NOT.FEXIST) THEN + IF (INDEX('0000000000000000',OLDTIMEID).EQ.0 .AND. INDEX(TIMEID,OLDTIMEID).EQ.0) THEN + IRET = NF90_REDEF(OLDNCID) CALL CHECK_ERR(IRET) - ENDIF - IRET=NF90_CLOSE(OLDNCID) - CALL CHECK_ERR(IRET) + IF(FL_DEFAULT_GBL_META) THEN + IRET=NF90_PUT_ATT(OLDNCID,NF90_GLOBAL,'stop_date',STRSTOPDATE) + CALL CHECK_ERR(IRET) + ENDIF + IRET=NF90_CLOSE(OLDNCID) + CALL CHECK_ERR(IRET) + END IF END IF - END IF - ! 2.5 Creates the netcdf file + ! 2.5 Creates the netcdf file - IF (.NOT.FEXIST) THEN + IF (.NOT.FEXIST) THEN - ! Initializes the time dimension length - DIMLN(1)=1 + ! Initializes the time dimension length + DIMLN(1)=1 - ! If NOT unstructure mesh (i.e. regular grid) - !! CHRISB: VARNM for lat/lon not actually used below. - ! IF (GTYPE.NE.UNGTYPE) THEN - ! ! If spherical coordinate - ! IF (FLAGLL) THEN - ! VARNM(NFIELD+1)='Longitude' - ! VARNM(NFIELD+2)='Latitude' - ! ! If cartesian coordinate - ! ELSE - ! VARNM(NFIELD+1)='x' - ! VARNM(NFIELD+2)='y' - ! END IF - ! END IF + ! If NOT unstructure mesh (i.e. regular grid) + !! CHRISB: VARNM for lat/lon not actually used below. + ! IF (GTYPE.NE.UNGTYPE) THEN + ! ! If spherical coordinate + ! IF (FLAGLL) THEN + ! VARNM(NFIELD+1)='Longitude' + ! VARNM(NFIELD+2)='Latitude' + ! ! If cartesian coordinate + ! ELSE + ! VARNM(NFIELD+1)='x' + ! VARNM(NFIELD+2)='y' + ! END IF + ! END IF - ! Initializes the time iteration counter n - N=1 + ! Initializes the time iteration counter n + N=1 - ! 2.5.1 Creates the NetCDF file - CALL W3CRNC(FNAMENC,NCID,DIMID,DIMLN,VARID, & - EXTRADIM,NCTYPE,MAPSTAOUT) + ! 2.5.1 Creates the NetCDF file + CALL W3CRNC(FNAMENC,NCID,DIMID,DIMLN,VARID, & + EXTRADIM,NCTYPE,MAPSTAOUT) - ! Saves the NCID to keep the file opened to write all the variables - ! and open/close at each time step - IF (TOGETHER.AND.(.NOT.FLFRQ)) THEN - NCIDS(1,1,1)=NCID - ELSE - NCIDS(IFI,IFJ,IPART+1)=NCID - END IF + ! Saves the NCID to keep the file opened to write all the variables + ! and open/close at each time step + IF (TOGETHER.AND.(.NOT.FLFRQ)) THEN + NCIDS(1,1,1)=NCID + ELSE + NCIDS(IFI,IFJ,IPART+1)=NCID + END IF - ! If curvilinear grid, instanciates lat / lon - IF (GTYPE.EQ.CLGTYPE) THEN - IF (.NOT.ALLOCATED(LON2D)) ALLOCATE(LON2D(NX,NY),LAT2D(NX,NY)) - LON2D=TRANSPOSE(XGRD) - LAT2D=TRANSPOSE(YGRD) - IF(FL_DEFAULT_GBL_META) THEN - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'latitude_resolution','n/a') - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'longitude_resolution','n/a') - CALL CHECK_ERR(IRET) - ENDIF - ! If NOT curvilinear grid, - ELSE - IF( SMCGRD ) THEN + ! If curvilinear grid, instanciates lat / lon + IF (GTYPE.EQ.CLGTYPE) THEN + IF (.NOT.ALLOCATED(LON2D)) ALLOCATE(LON2D(NX,NY),LAT2D(NX,NY)) + LON2D=TRANSPOSE(XGRD) + LAT2D=TRANSPOSE(YGRD) + IF(FL_DEFAULT_GBL_META) THEN + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'latitude_resolution','n/a') + CALL CHECK_ERR(IRET) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'longitude_resolution','n/a') + CALL CHECK_ERR(IRET) + ENDIF + ! If NOT curvilinear grid, + ELSE + IF( SMCGRD ) THEN #ifdef W3_SMC - IF(SMCOTYPE .EQ. 1) THEN - ! Flat seapoints file - IF(.NOT.ALLOCATED(lon)) ALLOCATE(lon(SMCNOUT)) - IF(.NOT.ALLOCATED(lat)) ALLOCATE(lat(SMCNOUT)) - IF(.NOT.ALLOCATED(smccx)) ALLOCATE(smccx(SMCNOUT)) - IF(.NOT.ALLOCATED(smccy)) ALLOCATE(smccy(SMCNOUT)) - ELSE - ! Regular gridded file - IF(.NOT.ALLOCATED(lon)) ALLOCATE(lon(NXO)) - IF(.NOT.ALLOCATED(lat)) ALLOCATE(lat(NYO)) + IF(SMCOTYPE .EQ. 1) THEN + ! Flat seapoints file + IF(.NOT.ALLOCATED(lon)) ALLOCATE(lon(SMCNOUT)) + IF(.NOT.ALLOCATED(lat)) ALLOCATE(lat(SMCNOUT)) + IF(.NOT.ALLOCATED(smccx)) ALLOCATE(smccx(SMCNOUT)) + IF(.NOT.ALLOCATED(smccy)) ALLOCATE(smccy(SMCNOUT)) + ELSE + ! Regular gridded file + IF(.NOT.ALLOCATED(lon)) ALLOCATE(lon(NXO)) + IF(.NOT.ALLOCATED(lat)) ALLOCATE(lat(NYO)) #endif #ifdef W3_RTD - ! Intermediate EQUatorial lat/lon arrays for de-rotation - ! of rotated pole coordinates: - !!IF(.NOT.ALLOCATED(LON2DEQ)) ALLOCATE(LON2DEQ(NXO,NYO)) - !!IF(.NOT.ALLOCATED(LAT2DEQ)) ALLOCATE(LAT2DEQ(NXO,NYO)) - ! - ! Use local RTDNX/RTDNY variables until CPP implemented to - ! avoid compile error when SMC switch not enabled (C.Bunney): - IF(.NOT.ALLOCATED(LON2DEQ)) ALLOCATE(LON2DEQ(RTDNX,RTDNY)) - IF(.NOT.ALLOCATED(LAT2DEQ)) ALLOCATE(LAT2DEQ(RTDNX,RTDNY)) + ! Intermediate EQUatorial lat/lon arrays for de-rotation + ! of rotated pole coordinates: + !!IF(.NOT.ALLOCATED(LON2DEQ)) ALLOCATE(LON2DEQ(NXO,NYO)) + !!IF(.NOT.ALLOCATED(LAT2DEQ)) ALLOCATE(LAT2DEQ(NXO,NYO)) + ! + ! Use local RTDNX/RTDNY variables until CPP implemented to + ! avoid compile error when SMC switch not enabled (C.Bunney): + IF(.NOT.ALLOCATED(LON2DEQ)) ALLOCATE(LON2DEQ(RTDNX,RTDNY)) + IF(.NOT.ALLOCATED(LAT2DEQ)) ALLOCATE(LAT2DEQ(RTDNX,RTDNY)) #endif #ifdef W3_SMC - ENDIF + ENDIF #endif #ifdef W3_RTD - ! Arrays for de-rotated lat/lon coordinates: - IF(.NOT.ALLOCATED(LON2D)) THEN - !!ALLOCATE(LON2D(NXO,NYO), LAT2D(NXO,NYO)) - !!ALLOCATE(ANGLD2D(NXO,NYO)) - ! - ! Use local RTDNX/RTDNY variables until CPP implemented to - ! avoid compile error when SMC switch not enabled (C.Bunney): - ALLOCATE(LON2D(RTDNX,RTDNY), LAT2D(RTDNX,RTDNY)) - ALLOCATE(ANGLD2D(RTDNX,RTDNY)) - ENDIF + ! Arrays for de-rotated lat/lon coordinates: + IF(.NOT.ALLOCATED(LON2D)) THEN + !!ALLOCATE(LON2D(NXO,NYO), LAT2D(NXO,NYO)) + !!ALLOCATE(ANGLD2D(NXO,NYO)) + ! + ! Use local RTDNX/RTDNY variables until CPP implemented to + ! avoid compile error when SMC switch not enabled (C.Bunney): + ALLOCATE(LON2D(RTDNX,RTDNY), LAT2D(RTDNX,RTDNY)) + ALLOCATE(ANGLD2D(RTDNX,RTDNY)) + ENDIF #endif - ELSE ! SMCGRD - ! instanciates lon with x/lon for regular grid or nodes for unstructured mesh - IF (.NOT.ALLOCATED(LON)) ALLOCATE(LON(NX)) + ELSE ! SMCGRD + ! instanciates lon with x/lon for regular grid or nodes for unstructured mesh + IF (.NOT.ALLOCATED(LON)) ALLOCATE(LON(NX)) #ifdef W3_RTD - ! 2d longitude array for standard grid coordinates - IF ( RTDL .AND. .NOT.ALLOCATED(LON2D)) & - ALLOCATE(LON2D(NX,NY),LON2DEQ(NX,NY),ANGLD2D(NX,NY)) -#endif - IF (.NOT.ALLOCATED(LAT)) THEN - ! If regular grid, instanciates lat with y/lat - IF (GTYPE.EQ.RLGTYPE) THEN - ALLOCATE(LAT(NY)) + ! 2d longitude array for standard grid coordinates + IF ( RTDL .AND. .NOT.ALLOCATED(LON2D)) & + ALLOCATE(LON2D(NX,NY),LON2DEQ(NX,NY),ANGLD2D(NX,NY)) +#endif + IF (.NOT.ALLOCATED(LAT)) THEN + ! If regular grid, instanciates lat with y/lat + IF (GTYPE.EQ.RLGTYPE) THEN + ALLOCATE(LAT(NY)) #ifdef W3_RTD - ! 2d latitude array for standard grid coordinates - IF ( RTDL .AND. .NOT.ALLOCATED(LAT2D)) & - ALLOCATE(LAT2D(NX,NY),LAT2DEQ(NX,NY)) + ! 2d latitude array for standard grid coordinates + IF ( RTDL .AND. .NOT.ALLOCATED(LAT2D)) & + ALLOCATE(LAT2D(NX,NY),LAT2DEQ(NX,NY)) #endif - ! If unstructured mesh, instanciates lat with nodes - ELSE - ALLOCATE(LAT(NX)) + ! If unstructured mesh, instanciates lat with nodes + ELSE + ALLOCATE(LAT(NX)) + END IF END IF - END IF - END IF ! SMCGRD - END IF + END IF ! SMCGRD + END IF - ! 2.5.2 Generates Lat-Lon arrays + ! 2.5.2 Generates Lat-Lon arrays - ! If regular grid - IF (GTYPE.EQ.RLGTYPE .OR. GTYPE.EQ.SMCTYPE) THEN - IF( SMCGRD ) THEN + ! If regular grid + IF (GTYPE.EQ.RLGTYPE .OR. GTYPE.EQ.SMCTYPE) THEN + IF( SMCGRD ) THEN #ifdef W3_SMC - ! CB: Calculate lat/lons of SMC grid - IF( SMCOTYPE .EQ. 1 ) THEN - ! CB: Flat seapoints file - DO i=1,SMCNOUT - j = SMCIDX(i) - lon(i) = (X0-0.5*SX) + (IJKCel(1,j) + 0.5 * IJKCel(3,j)) * dlon - lat(i) = (Y0-0.5*SY) + (IJKCel(2,j) + 0.5 * IJKCel(4,j)) * dlat - smccx(i) = IJKCel(3,j) - smccy(i) = IJKCel(4,j) - ENDDO + ! CB: Calculate lat/lons of SMC grid + IF( SMCOTYPE .EQ. 1 ) THEN + ! CB: Flat seapoints file + DO i=1,SMCNOUT + j = SMCIDX(i) + lon(i) = (X0-0.5*SX) + (IJKCel(1,j) + 0.5 * IJKCel(3,j)) * dlon + lat(i) = (Y0-0.5*SY) + (IJKCel(2,j) + 0.5 * IJKCel(4,j)) * dlat + smccx(i) = IJKCel(3,j) + smccy(i) = IJKCel(4,j) + ENDDO #endif #ifdef W3_RTD - !!CALL W3EQTOLL(lat, lon, LAT2D(:,1), LON2D(:,1), & - !! ANGLD2D(:,1), POLAT, POLON, NYO*NXO) - ! - ! Use local RTDNX/RTDNY variables until CPP implemented to - ! avoid compile error when SMC switch not enabled (C.Bunney): - CALL W3EQTOLL(lat, lon, LAT2D(:,1), LON2D(:,1), & - ANGLD2D(:,1), POLAT, POLON, RTDNY*RTDNX) + !!CALL W3EQTOLL(lat, lon, LAT2D(:,1), LON2D(:,1), & + !! ANGLD2D(:,1), POLAT, POLON, NYO*NXO) + ! + ! Use local RTDNX/RTDNY variables until CPP implemented to + ! avoid compile error when SMC switch not enabled (C.Bunney): + CALL W3EQTOLL(lat, lon, LAT2D(:,1), LON2D(:,1), & + ANGLD2D(:,1), POLAT, POLON, RTDNY*RTDNX) #endif #ifdef W3_SMC - ELSE - ! CB: Regridded SMC data - SXD=DBLE(0.000001d0*DNINT(1d6*(DBLE(DXO)) )) - SYD=DBLE(0.000001d0*DNINT(1d6*(DBLE(DYO)) )) - X0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(SXO)) )) - Y0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(SYO)) )) - DO i=1,NXO - lon(i)=REAL(X0D+SXD*DBLE(i-1)) + ELSE + ! CB: Regridded SMC data + SXD=DBLE(0.000001d0*DNINT(1d6*(DBLE(DXO)) )) + SYD=DBLE(0.000001d0*DNINT(1d6*(DBLE(DYO)) )) + X0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(SXO)) )) + Y0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(SYO)) )) + DO i=1,NXO + lon(i)=REAL(X0D+SXD*DBLE(i-1)) #endif #ifdef W3_RTD - LON2DEQ(i,:) = lon(i) + LON2DEQ(i,:) = lon(i) #endif #ifdef W3_SMC - END DO - DO i=1,NYO - lat(i)=REAL(Y0D+SYD*DBLE(i-1)) + END DO + DO i=1,NYO + lat(i)=REAL(Y0D+SYD*DBLE(i-1)) #endif #ifdef W3_RTD - LAT2DEQ(:,i) = lat(i) + LAT2DEQ(:,i) = lat(i) #endif #ifdef W3_SMC - END DO - WRITE(STR2,'(F12.7)') DYO - STR2=ADJUSTL(STR2) - IF(FL_DEFAULT_GBL_META) THEN - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'latitude_resolution', TRIM(str2)) - WRITE(STR2,'(F12.7)') DXO + END DO + WRITE(STR2,'(F12.7)') DYO STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'longitude_resolution',TRIM(str2)) - ENDIF + IF(FL_DEFAULT_GBL_META) THEN + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'latitude_resolution', TRIM(str2)) + WRITE(STR2,'(F12.7)') DXO + STR2=ADJUSTL(STR2) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'longitude_resolution',TRIM(str2)) + ENDIF #endif #ifdef W3_RTD - !!CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, & - !! ANGLD2D, POLAT, POLON, NYO*NXO) - ! - ! Use local RTDNX/RTDNY variables until CPP implemented to - ! avoid compile error when SMC switch not enabled (C.Bunney): - CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, & - ANGLD2D, POLAT, POLON, RTDNY*RTDNX) + !!CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, & + !! ANGLD2D, POLAT, POLON, NYO*NXO) + ! + ! Use local RTDNX/RTDNY variables until CPP implemented to + ! avoid compile error when SMC switch not enabled (C.Bunney): + CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, & + ANGLD2D, POLAT, POLON, RTDNY*RTDNX) #endif #ifdef W3_SMC - ENDIF ! SMCOTYPE + ENDIF ! SMCOTYPE #endif - ELSE ! SMCGRD - SXD=DBLE(0.000001d0*DNINT(1d6*(DBLE(SX)) )) - SYD=DBLE(0.000001d0*DNINT(1d6*(DBLE(SY)) )) - X0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(X0)) )) - Y0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(Y0)) )) - DO I=1,NX - LON(I)=REAL(X0D+SXD*DBLE(I-1)) - END DO - DO I=1,NY - LAT(I)=REAL(Y0D+SYD*DBLE(I-1)) - END DO -#ifdef W3_RTD - IF ( RTDL ) THEN - ! Calculate the standard grid coordinates + ELSE ! SMCGRD + SXD=DBLE(0.000001d0*DNINT(1d6*(DBLE(SX)) )) + SYD=DBLE(0.000001d0*DNINT(1d6*(DBLE(SY)) )) + X0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(X0)) )) + Y0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(Y0)) )) DO I=1,NX - LON2DEQ(I,:)=LON(I) + LON(I)=REAL(X0D+SXD*DBLE(I-1)) END DO DO I=1,NY - LAT2DEQ(:,I)=LAT(I) + LAT(I)=REAL(Y0D+SYD*DBLE(I-1)) END DO - CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, & - ANGLD2D, POLAT, POLON, NY*NX) - END IF ! RTDL +#ifdef W3_RTD + IF ( RTDL ) THEN + ! Calculate the standard grid coordinates + DO I=1,NX + LON2DEQ(I,:)=LON(I) + END DO + DO I=1,NY + LAT2DEQ(:,I)=LAT(I) + END DO + CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, & + ANGLD2D, POLAT, POLON, NY*NX) + END IF ! RTDL #endif + IF(FL_DEFAULT_GBL_META) THEN + WRITE(STR2,'(F12.0)') SY + STR2=ADJUSTL(STR2) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'latitude_resolution', TRIM(STR2)) + CALL CHECK_ERR(IRET) + WRITE(STR2,'(F12.0)') SX + STR2=ADJUSTL(STR2) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'longitude_resolution',TRIM(STR2)) + CALL CHECK_ERR(IRET) + ENDIF + END IF ! SMCGRD + END IF + + ! If unstructured mesh + IF (GTYPE.EQ.UNGTYPE) THEN + LON(:)=XGRD(1,:) + LAT(:)=YGRD(1,:) + DIMLN(2)=NX + DIMLN(3)=NTRI IF(FL_DEFAULT_GBL_META) THEN - WRITE(STR2,'(F12.0)') SY - STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'latitude_resolution', TRIM(STR2)) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'latitude_resolution','n/a') CALL CHECK_ERR(IRET) - WRITE(STR2,'(F12.0)') SX - STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'longitude_resolution',TRIM(STR2)) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'longitude_resolution','n/a') CALL CHECK_ERR(IRET) ENDIF - END IF ! SMCGRD - END IF + END IF - ! If unstructured mesh - IF (GTYPE.EQ.UNGTYPE) THEN - LON(:)=XGRD(1,:) - LAT(:)=YGRD(1,:) - DIMLN(2)=NX - DIMLN(3)=NTRI + ! Finishes declaration part in file by adding geographical bounds IF(FL_DEFAULT_GBL_META) THEN - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'latitude_resolution','n/a') - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'longitude_resolution','n/a') + IF(SMCGRD) THEN + WRITE(STR2,'(F12.0)') MINVAL(LAT) + ELSE + WRITE(STR2,'(F12.0)') MINVAL(YGRD) + ENDIF + STR2=ADJUSTL(STR2) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'southernmost_latitude',TRIM(STR2)) CALL CHECK_ERR(IRET) - ENDIF - END IF - - ! Finishes declaration part in file by adding geographical bounds - IF(FL_DEFAULT_GBL_META) THEN - IF(SMCGRD) THEN - WRITE(STR2,'(F12.0)') MINVAL(LAT) - ELSE - WRITE(STR2,'(F12.0)') MINVAL(YGRD) - ENDIF - STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'southernmost_latitude',TRIM(STR2)) - CALL CHECK_ERR(IRET) - - IF(SMCGRD) THEN - WRITE(STR2,'(F12.0)') MAXVAL(LAT) - ELSE - WRITE(STR2,'(F12.0)') MAXVAL(YGRD) - ENDIF - STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'northernmost_latitude',TRIM(STR2)) - CALL CHECK_ERR(IRET) - - IF(SMCGRD) THEN - WRITE(STR2,'(F12.0)') MINVAL(LON) - ELSE - WRITE(STR2,'(F12.0)') MINVAL(XGRD) - ENDIF - STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'westernmost_longitude',TRIM(STR2)) - CALL CHECK_ERR(IRET) - - - IF(SMCGRD) THEN - WRITE(STR2,'(F12.0)') MAXVAL(LON) - ELSE - WRITE(STR2,'(F12.0)') MAXVAL(XGRD) - ENDIF - STR2=ADJUSTL(STR2) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'easternmost_longitude',TRIM(STR2)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'minimum_altitude','-12000 m') - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'maximum_altitude','9000 m') - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'altitude_resolution','n/a') - CALL CHECK_ERR(IRET) -#ifdef W3_RTD - IF ( RTDL ) THEN - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'grid_north_pole_latitude',POLAT) + IF(SMCGRD) THEN + WRITE(STR2,'(F12.0)') MAXVAL(LAT) + ELSE + WRITE(STR2,'(F12.0)') MAXVAL(YGRD) + ENDIF + STR2=ADJUSTL(STR2) IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & - 'grid_north_pole_longitude',POLON) - END IF -#endif - ENDIF ! FL_DEFAULT_GBL_META - - CALL T2D(TIME,STARTDATE,IERR) - WRITE(STRSTARTDATE,'(I4.4,A,4(I2.2,A),I2.2)') STARTDATE(1),'-',STARTDATE(2),'-', & - STARTDATE(3),' ',STARTDATE(5),':',STARTDATE(6),':',STARTDATE(7) + 'northernmost_latitude',TRIM(STR2)) + CALL CHECK_ERR(IRET) - ! End of define mode of NetCDF file - IRET = NF90_ENDDEF(NCID) - CALL CHECK_ERR(IRET) + IF(SMCGRD) THEN + WRITE(STR2,'(F12.0)') MINVAL(LON) + ELSE + WRITE(STR2,'(F12.0)') MINVAL(XGRD) + ENDIF + STR2=ADJUSTL(STR2) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'westernmost_longitude',TRIM(STR2)) + CALL CHECK_ERR(IRET) - ! 2.5.3 Writes longitudes, latitudes, triangles, frequency and status map (mapsta) to netcdf file - ! If regular grid - IF (GTYPE.EQ.RLGTYPE .OR. GTYPE.EQ.SMCTYPE) THEN - IF(SMCGRD) THEN ! CB: shelter original code from SMC grid -#ifdef W3_SMC - IRET=NF90_PUT_VAR(NCID,VARID(1),LON(:)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(2),LAT(:)) - CALL CHECK_ERR(IRET) - IF(SMCOTYPE .EQ. 1) THEN - ! For type 1 SCM file also put lat/lons and cell sizes: - IRET=NF90_PUT_VAR(NCID,VARID(5),SMCCX) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(6),SMCCY) - CALL CHECK_ERR(IRET) + IF(SMCGRD) THEN + WRITE(STR2,'(F12.0)') MAXVAL(LON) + ELSE + WRITE(STR2,'(F12.0)') MAXVAL(XGRD) ENDIF -#endif - ELSE ! SMCGRD - IRET=NF90_PUT_VAR(NCID,VARID(1),LON(IX1:IXN)) + STR2=ADJUSTL(STR2) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'easternmost_longitude',TRIM(STR2)) CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(2),LAT(IY1:IYN)) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'minimum_altitude','-12000 m') CALL CHECK_ERR(IRET) - ENDIF ! SMCGRD -#ifdef W3_RTD - IF ( RTDL ) THEN - IRET=NF90_PUT_VAR(NCID,VARID(7),LON2D(IX1:IXN,IY1:IYN)) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'maximum_altitude','9000 m') CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(8),LAT2D(IX1:IXN,IY1:IYN)) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'altitude_resolution','n/a') CALL CHECK_ERR(IRET) - END IF -#endif - END IF - ! If curvilinear grid - IF (GTYPE.EQ.CLGTYPE) THEN - IRET=NF90_PUT_VAR(NCID,VARID(1),LON2D(IX1:IXN,IY1:IYN)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(2),LAT2D(IX1:IXN,IY1:IYN)) - CALL CHECK_ERR(IRET) - END IF - - ! If unstructured mesh - IF (GTYPE.EQ.UNGTYPE) THEN - IRET=NF90_PUT_VAR(NCID,VARID(1),LON(IX1:IXN)) - CALL CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(2),LAT(IX1:IXN)) - CALL CHECK_ERR(IRET) - END IF - - ! Writes frequencies to netcdf file - IF (EXTRADIM.EQ.1) THEN - ALLOCATE(FREQ(I2F-I1F+1)) - !BGR Here is where we should tell it what frequencies are. - IF (CUSTOMFRQ) THEN - DO i=1,usspf(2) - FREQ(i)=sqrt(GRAV*USSP_WN(i))*TPIINV - ENDDO - ELSE - DO i=1,I2F-I1F+1 - FREQ(i)=SIG(I1F-1+i)*TPIINV - END DO - ENDIF - IRET=NF90_PUT_VAR(NCID,VARID(10),FREQ) - CALL CHECK_ERR(IRET) - DEALLOCATE(FREQ) - END IF - - ! Writes triangles to netcdf file - IF (GTYPE.EQ.UNGTYPE) THEN - IRET=NF90_PUT_VAR(NCID,VARID(4),TRIGP) - CALL CHECK_ERR(IRET) - END IF +#ifdef W3_RTD + IF ( RTDL ) THEN + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'grid_north_pole_latitude',POLAT) + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL, & + 'grid_north_pole_longitude',POLON) + END IF +#endif + ENDIF ! FL_DEFAULT_GBL_META - ! Writes status map array at variable index 2+1+coordtype+idim-4 - IF (MAPSTAOUT) THEN - START(1)=1 - START(2)=1 - COUNT(1)=IXN-IX1+1 - COUNT(2)=IYN-IY1+1 - IF (GTYPE.NE.UNGTYPE) THEN - IRET=NF90_PUT_VAR(NCID,VARID(20),MAPOUT(IX1:IXN,IY1:IYN), & - (/START(1:2)/),(/COUNT(1:2)/)) - ELSE - IRET=NF90_PUT_VAR(NCID,VARID(20),MAPOUT(IX1:IXN,1),(/START(1)/),(/COUNT(1)/)) - ENDIF - CALL CHECK_ERR(IRET) - END IF + CALL T2D(TIME,STARTDATE,IERR) + WRITE(STRSTARTDATE,'(I4.4,A,4(I2.2,A),I2.2)') STARTDATE(1),'-',STARTDATE(2),'-', & + STARTDATE(3),' ',STARTDATE(5),':',STARTDATE(6),':',STARTDATE(7) - ! Write forecast reference time, if requested: - IF (FLGFC) THEN - IF(TIMEUNIT .EQ. 'S') THEN - OUTSECS = TSUBSEC(EPOCHDATE, REFDATE) - IRET = NF90_PUT_VAR(NCID, VARID(12), OUTSECS) - ELSE - OUTJULDAY = TSUB(EPOCHDATE, REFDATE) - IRET = NF90_PUT_VAR(NCID, VARID(12), OUTJULDAY) - ENDIF + ! End of define mode of NetCDF file + IRET = NF90_ENDDEF(NCID) CALL CHECK_ERR(IRET) - ENDIF - WRITE (NDSO,973) FNAMENC + ! 2.5.3 Writes longitudes, latitudes, triangles, frequency and status map (mapsta) to netcdf file - ! 2.5.4 Defines the field(LON,LAT,time) of the variable (i.e. ucur,vcur for current variable) - - IRET = NF90_REDEF(NCID) - CALL CHECK_ERR(IRET) - DO I=1,NFIELD - IVAR=IVAR1+I - IF (COORDTYPE.EQ.1) THEN - IF (NCVARTYPE.EQ.2) THEN -#ifdef W3_SMC - IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE -#endif - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) + ! If regular grid + IF (GTYPE.EQ.RLGTYPE .OR. GTYPE.EQ.SMCTYPE) THEN + IF(SMCGRD) THEN ! CB: shelter original code from SMC grid #ifdef W3_SMC - ENDIF -#endif + IRET=NF90_PUT_VAR(NCID,VARID(1),LON(:)) CALL CHECK_ERR(IRET) - IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) - IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) - ELSE -#ifdef W3_SMC - IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN - ! SMC Flat file - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) - ELSE -#endif - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) -#ifdef W3_SMC + IRET=NF90_PUT_VAR(NCID,VARID(2),LAT(:)) + CALL CHECK_ERR(IRET) + IF(SMCOTYPE .EQ. 1) THEN + ! For type 1 SCM file also put lat/lons and cell sizes: + IRET=NF90_PUT_VAR(NCID,VARID(5),SMCCX) + CALL CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(6),SMCCY) + CALL CHECK_ERR(IRET) ENDIF #endif + ELSE ! SMCGRD + IRET=NF90_PUT_VAR(NCID,VARID(1),LON(IX1:IXN)) CALL CHECK_ERR(IRET) - IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) - IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) - END IF - ELSE - DIMFIELD(1)=DIMID(2) - DIMFIELD(2)=DIMID(4) - DIMFIELD(3)=DIMID(5) - IF (NCVARTYPE.EQ.2) THEN - IRET = NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_SHORT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) + IRET=NF90_PUT_VAR(NCID,VARID(2),LAT(IY1:IYN)) CALL CHECK_ERR(IRET) - IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) - IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) - ELSE - IRET = NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_FLOAT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) + ENDIF ! SMCGRD +#ifdef W3_RTD + IF ( RTDL ) THEN + IRET=NF90_PUT_VAR(NCID,VARID(7),LON2D(IX1:IXN,IY1:IYN)) + CALL CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(8),LAT2D(IX1:IXN,IY1:IYN)) CALL CHECK_ERR(IRET) - IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) - IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) END IF - END IF - - ! Set scale factor to 1.0 if using FLOAT variables for output - IF(NCVARTYPE .GT. 2) META(I)%FSC = 1.0 - - !! CB - USE NEW W3META MODULE - CALL WRITE_META(NCID, VARID(IVAR), META(I), IRET) ! CB - CALL CHECK_ERR(IRET) ! CB - ! - !! CHRISB: Commenting out below - will be handled by w3oundmeta module -#ifdef W3_RTD - - ! IF ( RTDL ) THEN - ! ! Add grid mapping attribute for rotated pole grids: - ! IRET=NF90_PUT_ATT(NCID,VARID(IVAR),'grid_mapping', & - ! 'rotated_pole') - ! CALL CHECK_ERR(IRET) - ! END IF - #endif - END DO - ! - ! put START date in global attribute - IF(FL_DEFAULT_GBL_META) THEN - IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL,'start_date',STRSTARTDATE) - CALL CHECK_ERR(IRET) - ENDIF - ! - IRET = NF90_ENDDEF(NCID) - CALL CHECK_ERR(IRET) + END IF + ! If curvilinear grid + IF (GTYPE.EQ.CLGTYPE) THEN + IRET=NF90_PUT_VAR(NCID,VARID(1),LON2D(IX1:IXN,IY1:IYN)) + CALL CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(2),LAT2D(IX1:IXN,IY1:IYN)) + CALL CHECK_ERR(IRET) + END IF - ! 2.6 Append data to the existing file + ! If unstructured mesh + IF (GTYPE.EQ.UNGTYPE) THEN + IRET=NF90_PUT_VAR(NCID,VARID(1),LON(IX1:IXN)) + CALL CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(2),LAT(IX1:IXN)) + CALL CHECK_ERR(IRET) + END IF - ELSE ! FEXIST + ! Writes frequencies to netcdf file + IF (EXTRADIM.EQ.1) THEN + ALLOCATE(FREQ(I2F-I1F+1)) + !BGR Here is where we should tell it what frequencies are. + IF (CUSTOMFRQ) THEN + DO i=1,usspf(2) + FREQ(i)=sqrt(GRAV*USSP_WN(i))*TPIINV + ENDDO + ELSE + DO i=1,I2F-I1F+1 + FREQ(i)=SIG(I1F-1+i)*TPIINV + END DO + ENDIF + IRET=NF90_PUT_VAR(NCID,VARID(10),FREQ) + CALL CHECK_ERR(IRET) + DEALLOCATE(FREQ) + END IF - ! 2.6.1 Get the dimensions from the netcdf header + ! Writes triangles to netcdf file + IF (GTYPE.EQ.UNGTYPE) THEN + IRET=NF90_PUT_VAR(NCID,VARID(4),TRIGP) + CALL CHECK_ERR(IRET) + END IF - ! If it is an unstructured mesh - IF (GTYPE.EQ.UNGTYPE) THEN - IRET=NF90_INQ_VARID (NCID, 'tri', VARID(4)) - CALL CHECK_ERR(IRET) - ! If it is a regular grid - ELSE - ! If it is spherical coordinate - IF (FLAGLL) THEN -#ifdef W3_SMC - IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_INQ_DIMID (NCID, 'seapoint', DIMID(2)) + ! Writes status map array at variable index 2+1+coordtype+idim-4 + IF (MAPSTAOUT) THEN + START(1)=1 + START(2)=1 + COUNT(1)=IXN-IX1+1 + COUNT(2)=IYN-IY1+1 + IF (GTYPE.NE.UNGTYPE) THEN + IRET=NF90_PUT_VAR(NCID,VARID(20),MAPOUT(IX1:IXN,IY1:IYN), & + (/START(1:2)/),(/COUNT(1:2)/)) ELSE -#endif - IRET=NF90_INQ_DIMID (NCID, 'longitude', DIMID(2)) - IRET=NF90_INQ_DIMID (NCID, 'latitude', DIMID(3)) -#ifdef W3_SMC + IRET=NF90_PUT_VAR(NCID,VARID(20),MAPOUT(IX1:IXN,1),(/START(1)/),(/COUNT(1)/)) ENDIF -#endif - IRET=NF90_INQ_VARID (NCID, 'longitude', VARID(1)) - IRET=NF90_INQ_VARID (NCID, 'latitude', VARID(2)) - ! If it is cartesian coordinate - ELSE - IRET=NF90_INQ_DIMID (NCID, 'x', DIMID(2)) - IRET=NF90_INQ_VARID (NCID, 'x', VARID(1)) - IRET=NF90_INQ_DIMID (NCID, 'y', DIMID(3)) - IRET=NF90_INQ_VARID (NCID, 'y', VARID(2)) + CALL CHECK_ERR(IRET) END IF - CALL CHECK_ERR(IRET) - END IF - ! Get the dimension time - IRET=NF90_INQ_DIMID (NCID, 'time', DIMID(4+EXTRADIM)) - IRET=NF90_INQUIRE_DIMENSION (NCID, DIMID(4+EXTRADIM),len=N) - CALL CHECK_ERR(IRET) - IRET=NF90_INQ_VARID (NCID, 'time', VARID(3)) - IF( FLGFC ) THEN - IRET = NF90_INQ_VARID(NCID, 'forecast_period', VARID(11)) - CALL CHECK_ERR(IRET) - ENDIF - ! Get the dimension f - IF (EXTRADIM.EQ.1) IRET=NF90_INQ_DIMID (NCID, 'f', DIMID(4)) - ! 2.6.2 Increments the time step for existing file + ! Write forecast reference time, if requested: + IF (FLGFC) THEN + IF(TIMEUNIT .EQ. 'S') THEN + OUTSECS = TSUBSEC(EPOCHDATE, REFDATE) + IRET = NF90_PUT_VAR(NCID, VARID(12), OUTSECS) + ELSE + OUTJULDAY = TSUB(EPOCHDATE, REFDATE) + IRET = NF90_PUT_VAR(NCID, VARID(12), OUTJULDAY) + ENDIF + CALL CHECK_ERR(IRET) + ENDIF - ! If it is the first field of the file in mode together - ! or NOT together or variable with freq dim (ef or p2l) - ! ChrisBunney: Also - check IPART=TABIPART in case first - ! requested output is a partitioned field. - IF((TOGETHER .AND. IFI.EQ.I1 .AND. IFJ.EQ.J1 .AND. IPART.EQ.TABIPART(1)) & - .OR.(.NOT.TOGETHER).OR.FLFRQ) n=n+1 + WRITE (NDSO,973) FNAMENC - ! 2.6.3 Defines or gets the variables identifiers + ! 2.5.4 Defines the field(LON,LAT,time) of the variable (i.e. ucur,vcur for current variable) - ! If it is the first time step, define all the variables and attributes - IF (N.EQ.1) THEN IRET = NF90_REDEF(NCID) CALL CHECK_ERR(IRET) - - ! Loops on all the fields of the variable (i.e. ucur/vcur for current) DO I=1,NFIELD IVAR=IVAR1+I IF (COORDTYPE.EQ.1) THEN @@ -2727,6 +2578,7 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & #endif CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) + IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) ELSE #ifdef W3_SMC IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN @@ -2747,18 +2599,18 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & DIMFIELD(2)=DIMID(4) DIMFIELD(3)=DIMID(5) IF (NCVARTYPE.EQ.2) THEN - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) + IRET = NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_SHORT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) ELSE - IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) + IRET = NF90_DEF_VAR(NCID,META(I)%VARNM, NF90_FLOAT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) CALL CHECK_ERR(IRET) IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) - CALL CHECK_ERR(IRET) + IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) END IF END IF - ! + ! Set scale factor to 1.0 if using FLOAT variables for output IF(NCVARTYPE .GT. 2) META(I)%FSC = 1.0 @@ -2769,140 +2621,242 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & !! CHRISB: Commenting out below - will be handled by w3oundmeta module #ifdef W3_RTD - ! IF ( RTDL ) THEN - ! ! Add grid mapping attribute for rotated pole grids: - ! IRET=NF90_PUT_ATT(NCID,VARID(IVAR),'grid_mapping', & - ! 'rotated_pole') - ! CALL CHECK_ERR(IRET) - ! END IF + ! IF ( RTDL ) THEN + ! ! Add grid mapping attribute for rotated pole grids: + ! IRET=NF90_PUT_ATT(NCID,VARID(IVAR),'grid_mapping', & + ! 'rotated_pole') + ! CALL CHECK_ERR(IRET) + ! END IF #endif END DO + ! + ! put START date in global attribute + IF(FL_DEFAULT_GBL_META) THEN + IRET=NF90_PUT_ATT(NCID,NF90_GLOBAL,'start_date',STRSTARTDATE) + CALL CHECK_ERR(IRET) + ENDIF + ! IRET = NF90_ENDDEF(NCID) CALL CHECK_ERR(IRET) - ! If it is not the first time step, get all VARID from the netcdf file opened - ELSE - IRET=NF90_REDEF(NCID) - CALL CHECK_ERR(IRET) - DO I=1,NFIELD - ! Get meta-data for field - !META = GETMETA(IFI, IFJ, ICOMP=I, IPART=IPART) - IVAR=IVAR1+I - IRET=NF90_INQ_VARID (NCID, META(I)%VARNM, VARID(IVAR)) + + ! 2.6 Append data to the existing file + + ELSE ! FEXIST + + ! 2.6.1 Get the dimensions from the netcdf header + + ! If it is an unstructured mesh + IF (GTYPE.EQ.UNGTYPE) THEN + IRET=NF90_INQ_VARID (NCID, 'tri', VARID(4)) CALL CHECK_ERR(IRET) - END DO - IRET=NF90_ENDDEF(NCID) + ! If it is a regular grid + ELSE + ! If it is spherical coordinate + IF (FLAGLL) THEN +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_INQ_DIMID (NCID, 'seapoint', DIMID(2)) + ELSE +#endif + IRET=NF90_INQ_DIMID (NCID, 'longitude', DIMID(2)) + IRET=NF90_INQ_DIMID (NCID, 'latitude', DIMID(3)) +#ifdef W3_SMC + ENDIF +#endif + IRET=NF90_INQ_VARID (NCID, 'longitude', VARID(1)) + IRET=NF90_INQ_VARID (NCID, 'latitude', VARID(2)) + ! If it is cartesian coordinate + ELSE + IRET=NF90_INQ_DIMID (NCID, 'x', DIMID(2)) + IRET=NF90_INQ_VARID (NCID, 'x', VARID(1)) + IRET=NF90_INQ_DIMID (NCID, 'y', DIMID(3)) + IRET=NF90_INQ_VARID (NCID, 'y', VARID(2)) + END IF + CALL CHECK_ERR(IRET) + END IF + ! Get the dimension time + IRET=NF90_INQ_DIMID (NCID, 'time', DIMID(4+EXTRADIM)) + IRET=NF90_INQUIRE_DIMENSION (NCID, DIMID(4+EXTRADIM),len=N) CALL CHECK_ERR(IRET) - END IF ! N.EQ.1 - END IF ! FEXIST - - ! 2.6.4 Defines the current time step and index - - CALL T2D(TIME,CURDATE,IERR) - WRITE(NDSO,'(A,A9,A,I6,A,I4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2,2A)') & - 'Writing new record ', META(1)%ENAME(2:) ,'number ',N, & - ' for ',CURDATE(1),':',CURDATE(2),':',CURDATE(3),'T',CURDATE(5),& - ':',CURDATE(6),':',CURDATE(7),' in file ',TRIM(FNAMENC) - - - - ! Defines starting point and size of arrays to be written - START(1)=1 - START(2)=1 - START(3)=1 - START(4)=1 - - ! Sets time index - START(3+1-COORDTYPE+EXTRADIM)=N - COUNT(1)=IXN-IX1+1 - COUNT(2)=IYN-IY1+1 - COUNT(3)=1 - COUNT(4)=1 - START1D(1)=1 - START1D(2)=N - COUNT1D(1)=IXN-IX1+1 - COUNT1D(2)=1 - - ! Puts time in NetCDF file - IF((IFI.EQ.I1.AND.IFJ.EQ.J1.AND.TOGETHER) & - .OR.(.NOT.TOGETHER).OR.FLFRQ) THEN - IVAR1 = 21 - - IF(TIMEUNIT .EQ. 'S') THEN - ! Time in seconds - OUTSECS = TSUBSEC(EPOCHDATE,CURDATE) - IRET = NF90_PUT_VAR(NCID, VARID(3), OUTSECS, (/N/)) - ELSE - ! Time in days - OUTJULDAY = TSUB(EPOCHDATE,CURDATE) - IRET = NF90_PUT_VAR(NCID, VARID(3), OUTJULDAY, (/N/)) - ENDIF - CALL CHECK_ERR(IRET) + IRET=NF90_INQ_VARID (NCID, 'time', VARID(3)) + IF( FLGFC ) THEN + IRET = NF90_INQ_VARID(NCID, 'forecast_period', VARID(11)) + CALL CHECK_ERR(IRET) + ENDIF + ! Get the dimension f + IF (EXTRADIM.EQ.1) IRET=NF90_INQ_DIMID (NCID, 'f', DIMID(4)) - ! ChrisB: Calculate forecast period w.r.t. forecast reference time: - IF (FLGFC) THEN - OUTSECS = TSUBSEC(REFDATE, CURDATE) - IRET = NF90_PUT_VAR(NCID, VARID(11), OUTSECS, (/N/)) - CALL CHECK_ERR(IRET) - ENDIF - END IF - ! - ! 2.6.5 Puts field(s) in NetCDF file - - ! NFIELD=3 - IF (NCVARTYPE.EQ.2) THEN - IF ( NFIELD.EQ.3 ) THEN - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( X1(IX,IY) .EQ. UNDEF ) THEN - MXX(IX,IY) = MFILL - MYY(IX,IY) = MFILL - MXY(IX,IY) = MFILL + ! 2.6.2 Increments the time step for existing file + + ! If it is the first field of the file in mode together + ! or NOT together or variable with freq dim (ef or p2l) + ! ChrisBunney: Also - check IPART=TABIPART in case first + ! requested output is a partitioned field. + IF((TOGETHER .AND. IFI.EQ.I1 .AND. IFJ.EQ.J1 .AND. IPART.EQ.TABIPART(1)) & + .OR.(.NOT.TOGETHER).OR.FLFRQ) n=n+1 + + ! 2.6.3 Defines or gets the variables identifiers + + ! If it is the first time step, define all the variables and attributes + IF (N.EQ.1) THEN + IRET = NF90_REDEF(NCID) + CALL CHECK_ERR(IRET) + + ! Loops on all the fields of the variable (i.e. ucur/vcur for current) + DO I=1,NFIELD + IVAR=IVAR1+I + IF (COORDTYPE.EQ.1) THEN + IF (NCVARTYPE.EQ.2) THEN +#ifdef W3_SMC + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) + ELSE +#endif + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMID(2:4+EXTRADIM), VARID(IVAR)) +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) + IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) + ELSE +#ifdef W3_SMC + IF( SMCGRD .AND. SMCOTYPE .EQ. 1 ) THEN + ! SMC Flat file + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, (/DIMID(2), DIMID(4+EXTRADIM)/), VARID(IVAR)) + ELSE +#endif + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMID(2:4+EXTRADIM), VARID(IVAR)) +#ifdef W3_SMC + ENDIF +#endif + CALL CHECK_ERR(IRET) + IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) + IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) + END IF ELSE - MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) - MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) + DIMFIELD(1)=DIMID(2) + DIMFIELD(2)=DIMID(4) + DIMFIELD(3)=DIMID(5) + IF (NCVARTYPE.EQ.2) THEN + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_SHORT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) + CALL CHECK_ERR(IRET) + IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) + IF (NCTYPE.EQ.4) CALL CHECK_ERR(IRET) + ELSE + IRET = NF90_DEF_VAR(NCID,META(I)%varnm, NF90_FLOAT, DIMFIELD(1:2+EXTRADIM), VARID(IVAR)) + CALL CHECK_ERR(IRET) + IF (NCTYPE.EQ.4) IRET = NF90_DEF_VAR_DEFLATE(NCID, VARID(IVAR), 1, 1, DEFLATE) + CALL CHECK_ERR(IRET) + END IF END IF + ! + ! Set scale factor to 1.0 if using FLOAT variables for output + IF(NCVARTYPE .GT. 2) META(I)%FSC = 1.0 + + !! CB - USE NEW W3META MODULE + CALL WRITE_META(NCID, VARID(IVAR), META(I), IRET) ! CB + CALL CHECK_ERR(IRET) ! CB + ! + !! CHRISB: Commenting out below - will be handled by w3oundmeta module +#ifdef W3_RTD + + ! IF ( RTDL ) THEN + ! ! Add grid mapping attribute for rotated pole grids: + ! IRET=NF90_PUT_ATT(NCID,VARID(IVAR),'grid_mapping', & + ! 'rotated_pole') + ! CALL CHECK_ERR(IRET) + ! END IF + +#endif END DO - END DO -#ifdef W3_SMC - IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) + IRET = NF90_ENDDEF(NCID) + CALL CHECK_ERR(IRET) + + ! If it is not the first time step, get all VARID from the netcdf file opened ELSE -#endif - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) -#ifdef W3_SMC + IRET=NF90_REDEF(NCID) + CALL CHECK_ERR(IRET) + DO I=1,NFIELD + ! Get meta-data for field + !META = GETMETA(IFI, IFJ, ICOMP=I, IPART=IPART) + IVAR=IVAR1+I + IRET=NF90_INQ_VARID (NCID, META(I)%VARNM, VARID(IVAR)) + CALL CHECK_ERR(IRET) + END DO + IRET=NF90_ENDDEF(NCID) + CALL CHECK_ERR(IRET) + END IF ! N.EQ.1 + END IF ! FEXIST + + ! 2.6.4 Defines the current time step and index + + CALL T2D(TIME,CURDATE,IERR) + WRITE(NDSO,'(A,A9,A,I6,A,I4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2,2A)') & + 'Writing new record ', META(1)%ENAME(2:) ,'number ',N, & + ' for ',CURDATE(1),':',CURDATE(2),':',CURDATE(3),'T',CURDATE(5),& + ':',CURDATE(6),':',CURDATE(7),' in file ',TRIM(FNAMENC) + + + + ! Defines starting point and size of arrays to be written + START(1)=1 + START(2)=1 + START(3)=1 + START(4)=1 + + ! Sets time index + START(3+1-COORDTYPE+EXTRADIM)=N + COUNT(1)=IXN-IX1+1 + COUNT(2)=IYN-IY1+1 + COUNT(3)=1 + COUNT(4)=1 + START1D(1)=1 + START1D(2)=N + COUNT1D(1)=IXN-IX1+1 + COUNT1D(2)=1 + + ! Puts time in NetCDF file + IF((IFI.EQ.I1.AND.IFJ.EQ.J1.AND.TOGETHER) & + .OR.(.NOT.TOGETHER).OR.FLFRQ) THEN + IVAR1 = 21 + + IF(TIMEUNIT .EQ. 'S') THEN + ! Time in seconds + OUTSECS = TSUBSEC(EPOCHDATE,CURDATE) + IRET = NF90_PUT_VAR(NCID, VARID(3), OUTSECS, (/N/)) + ELSE + ! Time in days + OUTJULDAY = TSUB(EPOCHDATE,CURDATE) + IRET = NF90_PUT_VAR(NCID, VARID(3), OUTJULDAY, (/N/)) ENDIF -#endif - ! NFIELD=2 - ELSE IF (NFIELD.EQ.2 ) THEN - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN + CALL CHECK_ERR(IRET) + + ! ChrisB: Calculate forecast period w.r.t. forecast reference time: + IF (FLGFC) THEN + OUTSECS = TSUBSEC(REFDATE, CURDATE) + IRET = NF90_PUT_VAR(NCID, VARID(11), OUTSECS, (/N/)) + CALL CHECK_ERR(IRET) + ENDIF + END IF + ! + ! 2.6.5 Puts field(s) in NetCDF file + + ! NFIELD=3 + IF (NCVARTYPE.EQ.2) THEN + IF ( NFIELD.EQ.3 ) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( XX(IX,IY) .EQ. UNDEF ) THEN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL + MXY(IX,IY) = MFILL ELSE - MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) - MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) + MXX(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) + MYY(IX,IY) = NINT(X2(IX,IY)/META(2)%FSC) + MXY(IX,IY) = NINT(XY(IX,IY)/META(3)%FSC) END IF END DO END DO @@ -2914,6 +2868,9 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) ELSE #endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & @@ -2922,160 +2879,157 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC ENDIF #endif - ! EXTRADIM=1 - ELSE - START(3+1-COORDTYPE)=0 - DO IK=I1F,I2F - START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 + ! NFIELD=2 + ELSE IF (NFIELD.EQ.2 ) THEN + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXX(IX,IY) = MFILL MYY(IX,IY) = MFILL ELSE - MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) - MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) + MXX(IX,IY) = NINT(XX(IX,IY)/META(1)%FSC) + MYY(IX,IY) = NINT(XY(IX,IY)/META(2)%FSC) END IF END DO END DO #ifdef W3_SMC IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MXY(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYY(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) ELSE #endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + MXX(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + MYY(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) #ifdef W3_SMC ENDIF #endif - END DO - END IF ! EXTRADIM - ! NFIELD=1 - ELSE - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( X1(IX,IY) .EQ. UNDEF ) THEN - MX1(IX,IY) = MFILL - ELSE - MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) - END IF - END DO - END DO -#ifdef W3_SMC - IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) + ! EXTRADIM=1 ELSE + START(3+1-COORDTYPE)=0 + DO IK=I1F,I2F + START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN + MXX(IX,IY) = MFILL + MYY(IX,IY) = MFILL + ELSE + MXX(IX,IY) = NINT(XXK(IX,IY,IK)/META(1)%FSC) + MYY(IX,IY) = NINT(XYK(IX,IY,IK)/META(2)%FSC) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MXY(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) + call CHECK_ERR(IRET) + ELSE #endif - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MXX(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC - ENDIF + ENDIF #endif - ! EXTRADIM=1 + END DO + END IF ! EXTRADIM + ! NFIELD=1 ELSE - START(3+1-COORDTYPE)=0 - DO IK=I1F,I2F - START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN MX1(IX,IY) = MFILL ELSE - MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) + MX1(IX,IY) = NINT(X1(IX,IY)/META(1)%FSC) END IF END DO END DO #ifdef W3_SMC IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) ELSE #endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + MX1(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) #ifdef W3_SMC ENDIF #endif - END DO - END IF ! EXTRADIM - END IF ! NFIELD - ! - ! Real output (NCVARTYPE.GE.3) - ! - ELSE - IF ( NFIELD.EQ.3 ) THEN - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( X1(IX,IY) .EQ. UNDEF ) THEN - MXXR(IX,IY) = MFILLR - MYYR(IX,IY) = MFILLR - MXYR(IX,IY) = MFILLR - ELSE - MXXR(IX,IY) = X1(IX,IY) - MYYR(IX,IY) = X2(IX,IY) - MXYR(IX,IY) = XY(IX,IY) - END IF - END DO - END DO + ! EXTRADIM=1 + ELSE + START(3+1-COORDTYPE)=0 + DO IK=I1F,I2F + START(3+1-COORDTYPE)=START(3+1-COORDTYPE)+1 + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN + MX1(IX,IY) = MFILL + ELSE + MX1(IX,IY) = NINT(XK(IX,IY,IK)/META(1)%FSC) + END IF + END DO + END DO #ifdef W3_SMC - IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) - ELSE + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) + call CHECK_ERR(IRET) + ELSE #endif - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & - MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC - ENDIF + ENDIF #endif - ! NFIELD=2 - ELSE IF (NFIELD.EQ.2 ) THEN - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN + END DO + END IF ! EXTRADIM + END IF ! NFIELD + ! + ! Real output (NCVARTYPE.GE.3) + ! + ELSE + IF ( NFIELD.EQ.3 ) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( XX(IX,IY) .EQ. UNDEF ) THEN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN MXXR(IX,IY) = MFILLR MYYR(IX,IY) = MFILLR + MXYR(IX,IY) = MFILLR ELSE - MXXR(IX,IY) = XX(IX,IY) - MYYR(IX,IY) = XY(IX,IY) + MXXR(IX,IY) = X1(IX,IY) + MYYR(IX,IY) = X2(IX,IY) + MXYR(IX,IY) = XY(IX,IY) END IF END DO END DO @@ -3087,6 +3041,9 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) + call CHECK_ERR(IRET) ELSE #endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & @@ -3095,127 +3052,165 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+3), & + MXYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC ENDIF #endif - ! EXTRADIM=1 - ELSE - START(4-COORDTYPE)=0 - DO IK=I1F,I2F - START(4-COORDTYPE)=START(4-COORDTYPE)+1 + ! NFIELD=2 + ELSE IF (NFIELD.EQ.2 ) THEN + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN + IF ( XX(IX,IY) .EQ. UNDEF ) THEN MXXR(IX,IY) = MFILLR MYYR(IX,IY) = MFILLR ELSE - MXXR(IX,IY) = XXK(IX,IY,IK) - MYYR(IX,IY) = XYK(IX,IY,IK) + MXXR(IX,IY) = XX(IX,IY) + MYYR(IX,IY) = XY(IX,IY) END IF END DO END DO #ifdef W3_SMC IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) ELSE #endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MXXR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + MXXR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & - MYYR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + MYYR(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) #ifdef W3_SMC ENDIF #endif - END DO - END IF ! EXTRADIM - ! NFIELD=1 - ELSE - ! EXTRADIM=0 - IF (EXTRADIM.EQ.0) THEN - DO IX=IX1, IXN - DO IY=IY1, IYN - IF ( X1(IX,IY) .EQ. UNDEF ) THEN - MX1R(IX,IY) = MFILLR - ELSE - MX1R(IX,IY) = X1(IX,IY) - END IF - END DO - END DO -#ifdef W3_SMC - IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) - call CHECK_ERR(IRET) + ! EXTRADIM=1 ELSE + START(4-COORDTYPE)=0 + DO IK=I1F,I2F + START(4-COORDTYPE)=START(4-COORDTYPE)+1 + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( XXK(IX,IY,IK) .EQ. UNDEF ) THEN + MXXR(IX,IY) = MFILLR + MYYR(IX,IY) = MFILLR + ELSE + MXXR(IX,IY) = XXK(IX,IY,IK) + MYYR(IX,IY) = XYK(IX,IY,IK) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) + call CHECK_ERR(IRET) + ELSE #endif - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) - call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MXXR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + call CHECK_ERR(IRET) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+2), & + MYYR(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + call CHECK_ERR(IRET) #ifdef W3_SMC - ENDIF + ENDIF #endif - ! EXTRADIM=1 + END DO + END IF ! EXTRADIM + ! NFIELD=1 ELSE - START(4-COORDTYPE)=0 - DO IK=I1F,I2F - START(4-COORDTYPE)=START(4-COORDTYPE)+1 + ! EXTRADIM=0 + IF (EXTRADIM.EQ.0) THEN DO IX=IX1, IXN DO IY=IY1, IYN - IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN + IF ( X1(IX,IY) .EQ. UNDEF ) THEN MX1R(IX,IY) = MFILLR ELSE - MX1R(IX,IY) = XK(IX,IY,IK) + MX1R(IX,IY) = X1(IX,IY) END IF END DO END DO #ifdef W3_SMC IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN - IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & - (/COUNT(1), COUNT(3), COUNT(4)/)) + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3)/),(/COUNT(1), COUNT(3)/)) call CHECK_ERR(IRET) ELSE #endif IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & - MX1R(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + MX1R(IX1:IXN,IY1:IYN),(/START(1:3)/),(/COUNT(1:3)/)) call CHECK_ERR(IRET) #ifdef W3_SMC ENDIF #endif - END DO - END IF ! EXTRADIM - END IF ! NFIELD - END IF ! NCVARTYPE - - ! updates the variable index - IVAR1=IVAR1+NFIELD - - - ! Loops over IPART for partition variables - ! ChrisBunney: Don't loop IPART for last two entries in section 4 - ! (16: total wind sea fraction, 17: number of parts) as these fields - ! do not have partitions. - IF (IFI .EQ. 4 .AND. IFJ .LE. NOGE(IFI) - 2) THEN -560 CONTINUE - IF (INDEXIPART.LT.NBIPART) THEN - INDEXIPART=INDEXIPART+1 - IF (TABIPART(INDEXIPART).EQ.-1) GOTO 560 - IPART=TABIPART(INDEXIPART) - GOTO 555 + ! EXTRADIM=1 + ELSE + START(4-COORDTYPE)=0 + DO IK=I1F,I2F + START(4-COORDTYPE)=START(4-COORDTYPE)+1 + DO IX=IX1, IXN + DO IY=IY1, IYN + IF ( XK(IX,IY,IK) .EQ. UNDEF ) THEN + MX1R(IX,IY) = MFILLR + ELSE + MX1R(IX,IY) = XK(IX,IY,IK) + END IF + END DO + END DO +#ifdef W3_SMC + IF(SMCGRD .AND. SMCOTYPE .EQ. 1) THEN + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1), START(3), START(4)/), & + (/COUNT(1), COUNT(3), COUNT(4)/)) + call CHECK_ERR(IRET) + ELSE +#endif + IRET=NF90_PUT_VAR(NCID,VARID(IVAR1+1), & + MX1R(IX1:IXN,IY1:IYN),(/START(1:4)/),(/COUNT(1:4)/)) + call CHECK_ERR(IRET) +#ifdef W3_SMC + ENDIF +#endif + END DO + END IF ! EXTRADIM + END IF ! NFIELD + END IF ! NCVARTYPE + + ! updates the variable index + IVAR1=IVAR1+NFIELD + + + ! Loops over IPART for partition variables + ! ChrisBunney: Don't loop IPART for last two entries in section 4 + ! (16: total wind sea fraction, 17: number of parts) as these fields + ! do not have partitions. + IF (IFI .EQ. 4 .AND. IFJ .LE. NOGE(IFI) - 2) THEN + DO WHILE (INDEXIPART.LT.NBIPART) + INDEXIPART=INDEXIPART+1 + IF (TABIPART(INDEXIPART).EQ.-1) CYCLE + IPART=TABIPART(INDEXIPART) + LOOP = .TRUE. + EXIT + END DO + ELSE + INDEXIPART=1 END IF - ELSE - INDEXIPART=1 - END IF - ! + ! + END DO ! Loop over IPART for partition variables END IF ! FLG2D(IFI,IFJ) END DO ! IFI=1, NOGRP END DO ! IFJ=1, NGRPP @@ -3232,10 +3227,6 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & #endif ! RETURN - ! - ! Error escape locations - ! - ! ! Formats ! diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index a1533c73b8..be255f76f2 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -77,6 +77,7 @@ PROGRAM W3OUNP !/ 05-Jan-2022 : Added TIMESPLIT=0 (nodate) support ( version 7.14 ) !/ 21-Jul-2022 : Correct FP0 calc for peak energy in ( version 7.14 ) !/ min/max freq band (B. Pouliot, CMC) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -112,6 +113,8 @@ PROGRAM W3OUNP ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -185,7 +188,7 @@ PROGRAM W3OUNP USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT, DIMP USE W3IOGRMD, ONLY: W3IOGR USE W3IOPOMD - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, STRSPLIT + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF, STRSPLIT #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -492,16 +495,19 @@ PROGRAM W3OUNP ! process old ww3_ounp.inp format ! IF (.NOT. FLGNML) THEN - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_ounp.inp',STATUS='OLD',ERR=800,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_ounp.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUNP','INPUT',40) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) IF (COMSTR.EQ.' ') COMSTR = '$' IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,901) COMSTR CALL NEXTLN ( COMSTR , NDSI , NDSE ) ! 4.1 Time setup IDTIME, DTREQ, NOUT - READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT + READ (NDSI,*,IOSTAT=IERR) TOUT, DTREQ, NOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) ! 4.2 Output points NOPTS ALLOCATE ( FLREQ(NOPTS) ) @@ -515,7 +521,8 @@ PROGRAM W3OUNP DO I=1, NOPTS ! reads point index CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IPOINT + READ (NDSI,*,IOSTAT=IERR) IPOINT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) ! last index IF (IPOINT .LT. 0) THEN IF (I.EQ.1) THEN @@ -536,7 +543,8 @@ PROGRAM W3OUNP ! read the 'end of list' if nopts reached before it IF ( (IPOINT .GT. 0) .AND. (NREQ .EQ. NOPTS) ) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IPOINT + READ (NDSI,*,IOSTAT=IERR) IPOINT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) END IF END DO ! check if last point index is -1 @@ -548,26 +556,35 @@ PROGRAM W3OUNP ! 4.3 Output type FILEPREFIX= 'ww3.' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) FILEPREFIX + READ (NDSI,*,IOSTAT=IERR) FILEPREFIX + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) S3 + READ (NDSI,*,IOSTAT=IERR) S3 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) NCTYPE + READ (NDSI,*,IOSTAT=IERR) NCTYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) TOGETHER, MFL + READ (NDSI,*,IOSTAT=IERR) TOGETHER, MFL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) ITYPE + READ (NDSI,*,IOSTAT=IERR) ITYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) FLWW3 + READ (NDSI,*,IOSTAT=IERR) FLWW3 + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) ORDER + READ (NDSI,*,IOSTAT=IERR) ORDER + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) ! - IF (ITYPE .EQ. 1) READ (NDSI,*,END=801,ERR=802) OTYPE, SCALE1, SCALE2, NCVARTYPE - IF (ITYPE .EQ. 2) READ (NDSI,*,END=801,ERR=802) OTYPE - IF (ITYPE .EQ. 3) READ (NDSI,*,END=801,ERR=802) OTYPE, SCALE1, SCALE2, FLSRCE, ISCALE + IF (ITYPE .EQ. 1) READ (NDSI,*,IOSTAT=IERR) OTYPE, SCALE1, SCALE2, NCVARTYPE + IF (ITYPE .EQ. 2) READ (NDSI,*,IOSTAT=IERR) OTYPE + IF (ITYPE .EQ. 3) READ (NDSI,*,IOSTAT=IERR) OTYPE, SCALE1, SCALE2, FLSRCE, ISCALE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUNP','INPUT',41) - CLOSE(NDSI,ERR=800,IOSTAT=IERR) + CLOSE(NDSI,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUNP','INPUT',40) END IF ! .NOT. FLGNML @@ -604,6 +621,7 @@ PROGRAM W3OUNP ! 4.1.3 Loops on TIME from out_pnt file to reach the first time PASTDATE + IOTEST = 0 DTEST = DSEC21 ( TIME , TOUT ) DO WHILE (DTEST.NE.0) DTEST = DSEC21 ( TIME , TOUT ) @@ -615,7 +633,7 @@ PROGRAM W3OUNP #endif IF ( IOTEST .EQ. -1 ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) - GOTO 888 + EXIT END IF CYCLE END IF @@ -624,148 +642,34 @@ PROGRAM W3OUNP CYCLE END IF END DO - WRITE(PASTDATE,'(I8.8,I6.6)') TIME(1), TIME(2) - - - ! 4.2 Output points NOPTS - ALLOCATE ( INDREQ(NREQ) ) - INDREQ(:)=INDREQTMP(1:NREQ) - DEALLOCATE(INDREQTMP) - - - ! 4.3 Output type - ! - ! S3 defines the number of characters in the date for the filename - ! S3=0 -> empty, S3=4 -> YYYY, S3=6 -> YYYYMM, S3=10 -> YYYYMMDDHH - ! - ! Setups min and max date format - IF (S3.GT.0 .AND. S3.LT.4) S3=4 - IF (S3.GT.10) S3=10 - ! - ! Defines the format of FILETIME as ISO8601 convention - S5=S3-8 - ! if S3=>YYYYMMDDHH then filetime='YYYYMMDDTHHMMSSZ' - IF (S3.EQ.0) THEN - FILETIME = '' - ELSE IF (S3.EQ.10) THEN - WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I8.8,A1,I',S5,'.',S5,',A1)' - WRITE (FILETIME,FORMAT1) TIME(1), 'T', & - FLOOR(REAL(TIME(2))/NINT(10.**(6-S5))), 'Z' - ! if S3=>YYYYMMDD then filetime='YYYYMMDD' - ELSE IF (S3.EQ.8) THEN - WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I',S3,'.',S3,')' - WRITE (FILETIME,FORMAT1) TIME(1) - ! if S3=>YYYYMM then filetime='YYYYMM' - ! or S3=>YYYY then filetime='YYYY' - ELSE - WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I',S3,'.',S3,')' - WRITE (FILETIME,FORMAT1) FLOOR(REAL(TIME(1))/NINT(10.**(8-S3))) - END IF - ! - ! order time,station - IF (ORDER) THEN - ONE=1 - TWO=2 - ! order station,time - ELSE - ONE=2 - TWO=1 - END IF ! - IF ((NCTYPE.EQ.3) .AND. (.NOT.ORDER)) GOTO 803 - IF ((NCTYPE.EQ.4) .AND. INDEX(NF90_INQ_LIBVERS(),'"3.').NE.0) GOTO 804 - - - ! 4.4 Converts direction unit in degree - ALLOCATE(THD(NTH)) - DTHD=360./NTH - RTH0=TH(1)/DTH - DO ITH=1, NTH - THD(ITH)=DTHD*(RTH0+REAL(ITH-1)) - END DO - ! - !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 5. Now creates files - ! If too many (memory problem) then makes several reads - ! - - - ! 5.1 Defines number of files/stations per file NFL - IF (TOGETHER) THEN - NFL=1 - ELSE - NFL=1+NOPTS/MFL - END IF - - - ! 5.2 Creates filename listing - SEP = '_' - IF(S3 .EQ. 0) SEP = '' ! No "_" separator if no datetime string. - WRITE(EXT,'(A)') '' - IF ((ITYPE .EQ. 1) .AND. (OTYPE.EQ.2)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' - IF ((ITYPE .EQ. 1) .AND. (OTYPE.EQ.3)) WRITE(EXT,'(A,A)') TRIM(SEP), 'spec.nc' - IF ((ITYPE .EQ. 1) .AND. (OTYPE.EQ.4)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' - IF (ITYPE .EQ. 2) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' - IF ((ITYPE .EQ. 3) .AND. (OTYPE.EQ.2)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' - IF ((ITYPE .EQ. 3) .AND. (OTYPE.EQ.3)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' - IF ((ITYPE .EQ. 3) .AND. (OTYPE.EQ.4)) WRITE(EXT,'(A,A)') TRIM(SEP), 'src.nc' - ! checks if extension exists - IF (LEN_TRIM(EXT).EQ.0) THEN - WRITE (NDSE,1006) - CALL EXTCDE ( 46 ) - END IF - - ! 5.3 Redefines netCDF type - IF((NCTYPE.EQ.4).AND.(.NOT.TOGETHER).AND.(NFL.GT.300).AND.(NREQ.GT.9000)) THEN - WRITE(NDSO,'(A)') ' WARNING : Files will be generated in netCDF3 with NF90_share mode' - WRITE(NDSO,'(A)') ' WARNING : this is due to NF90_sync memory problem with netCDF4 library' - WRITE(NDSO,'(A)') ' WARNING : to convert in netCDF4, use ncks -h -a -4 -L 9 file.nc3 file.nc4' - WRITE(NDSO,'(A)') ' WARNING : or use option "Points in same file" with value TRUE in .inp file' - WRITE(NDSO,'(A)') ' WARNING : or limit the output points list to less than 300' - NCTYPE=3 - END IF - - - - ! 5.4 Defines periodic flushing of buffer (only available for netCDF3) - NCFLUSH=FLOOR(15E7/(FLOAT(NK)*FLOAT(NTH)*FLOAT(NREQ)/NFL)) - IF (NCTYPE.EQ.3.AND.NREQ.GT.10.AND.(.NOT.TOGETHER)) WRITE(NDSO,5940) NCFLUSH + IF (IOTEST .EQ. 0) THEN + WRITE(PASTDATE,'(I8.8,I6.6)') TIME(1), TIME(2) - - ! 5.5 Removes the duplicata if "ONE file per station" mode - IF (.NOT.TOGETHER) THEN - ! defines a file name per station (NOT TOGETHER) - DO I=1,NOPTS - IF (FLREQ(I)) THEN - J = LEN_TRIM(FNMPRE) - WRITE (NCNAME, '(5A)') TRIM(FILEPREFIX), TRIM(PTNME(I)),'_', TRIM(FILETIME), TRIM(EXT) - WRITE(NCFILE(I),'(2A)') TRIM(FNMPRE(:J)), TRIM(NCNAME) ! filename - IF( SUM(index(NCFILE(:),NCFILE(I))).GT.1 ) THEN - FLREQ(I)=.FALSE. - WRITE(NDSO,5950) TRIM(PTNME(I)) - CYCLE - END IF - END IF ! FLREQ(I) - END DO ! I=1,NOPTS - END IF ! .NOT.TOGETHER + ! 4.2 Output points NOPTS + ALLOCATE ( INDREQ(NREQ) ) + INDREQ(:)=INDREQTMP(1:NREQ) + DEALLOCATE(INDREQTMP) - ! 5.6 Loops on bunch of stations NFL - DO IFL=IAPROC,NFL,NAPROC + ! 4.3 Output type ! - ! new file, so the time counter is initialized -560 CONTINUE - IOUT=0 - - - ! 5.6.1 Redefines the filetime when it's a new date defined by the date division S3 + ! S3 defines the number of characters in the date for the filename + ! S3=0 -> empty, S3=4 -> YYYY, S3=6 -> YYYYMM, S3=10 -> YYYYMMDDHH + ! + ! Setups min and max date format + IF (S3.GT.0 .AND. S3.LT.4) S3=4 + IF (S3.GT.10) S3=10 + ! + ! Defines the format of FILETIME as ISO8601 convention + S5=S3-8 ! if S3=>YYYYMMDDHH then filetime='YYYYMMDDTHHMMSSZ' IF (S3.EQ.0) THEN FILETIME = '' ELSE IF (S3.EQ.10) THEN WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I8.8,A1,I',S5,'.',S5,',A1)' WRITE (FILETIME,FORMAT1) TIME(1), 'T', & - NINT(REAL(TIME(2))/NINT(10.**(6-S5))), 'Z' + FLOOR(REAL(TIME(2))/NINT(10.**(6-S5))), 'Z' ! if S3=>YYYYMMDD then filetime='YYYYMMDD' ELSE IF (S3.EQ.8) THEN WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I',S3,'.',S3,')' @@ -774,527 +678,620 @@ PROGRAM W3OUNP ! or S3=>YYYY then filetime='YYYY' ELSE WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I',S3,'.',S3,')' - WRITE (FILETIME,FORMAT1) NINT(REAL(TIME(1))/NINT(10.**(8-S3))) + WRITE (FILETIME,FORMAT1) FLOOR(REAL(TIME(1))/NINT(10.**(8-S3))) + END IF + ! + ! order time,station + IF (ORDER) THEN + ONE=1 + TWO=2 + ! order station,time + ELSE + ONE=2 + TWO=1 + END IF + ! + IF ((NCTYPE.EQ.3) .AND. (.NOT.ORDER)) THEN + WRITE (NDSE,1003) + CALL EXTCDE ( 43 ) + END IF + IF ((NCTYPE.EQ.4) .AND. INDEX(NF90_INQ_LIBVERS(),'"3.').NE.0) THEN + WRITE (NDSE,1004) NF90_INQ_LIBVERS() + CALL EXTCDE ( 44 ) END IF + ! 4.4 Converts direction unit in degree + ALLOCATE(THD(NTH)) + DTHD=360./NTH + RTH0=TH(1)/DTH + DO ITH=1, NTH + THD(ITH)=DTHD*(RTH0+REAL(ITH-1)) + END DO + ! + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! 5. Now creates files + ! If too many (memory problem) then makes several reads + ! - ! 5.6.2 Defines the file names - ! defines unique file name (TOGETHER) + + ! 5.1 Defines number of files/stations per file NFL IF (TOGETHER) THEN - WRITE (NCNAME, '(3A)') TRIM(FILEPREFIX), TRIM(FILETIME), TRIM(EXT) - !IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1947) TRIM(NCNAME) - J = LEN_TRIM(FNMPRE) - WRITE(NCFILE(1),'(2A)') TRIM(FNMPRE(:J)), TRIM(NCNAME) ! filename + NFL=1 ELSE + NFL=1+NOPTS/MFL + END IF + + + ! 5.2 Creates filename listing + SEP = '_' + IF(S3 .EQ. 0) SEP = '' ! No "_" separator if no datetime string. + WRITE(EXT,'(A)') '' + IF ((ITYPE .EQ. 1) .AND. (OTYPE.EQ.2)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' + IF ((ITYPE .EQ. 1) .AND. (OTYPE.EQ.3)) WRITE(EXT,'(A,A)') TRIM(SEP), 'spec.nc' + IF ((ITYPE .EQ. 1) .AND. (OTYPE.EQ.4)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' + IF (ITYPE .EQ. 2) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' + IF ((ITYPE .EQ. 3) .AND. (OTYPE.EQ.2)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' + IF ((ITYPE .EQ. 3) .AND. (OTYPE.EQ.3)) WRITE(EXT,'(A,A)') TRIM(SEP), 'tab.nc' + IF ((ITYPE .EQ. 3) .AND. (OTYPE.EQ.4)) WRITE(EXT,'(A,A)') TRIM(SEP), 'src.nc' + ! checks if extension exists + IF (LEN_TRIM(EXT).EQ.0) THEN + WRITE (NDSE,1006) + CALL EXTCDE ( 46 ) + END IF + + ! 5.3 Redefines netCDF type + IF((NCTYPE.EQ.4).AND.(.NOT.TOGETHER).AND.(NFL.GT.300).AND.(NREQ.GT.9000)) THEN + WRITE(NDSO,'(A)') ' WARNING : Files will be generated in netCDF3 with NF90_share mode' + WRITE(NDSO,'(A)') ' WARNING : this is due to NF90_sync memory problem with netCDF4 library' + WRITE(NDSO,'(A)') ' WARNING : to convert in netCDF4, use ncks -h -a -4 -L 9 file.nc3 file.nc4' + WRITE(NDSO,'(A)') ' WARNING : or use option "Points in same file" with value TRUE in .inp file' + WRITE(NDSO,'(A)') ' WARNING : or limit the output points list to less than 300' + NCTYPE=3 + END IF + + + + ! 5.4 Defines periodic flushing of buffer (only available for netCDF3) + NCFLUSH=FLOOR(15E7/(FLOAT(NK)*FLOAT(NTH)*FLOAT(NREQ)/NFL)) + IF (NCTYPE.EQ.3.AND.NREQ.GT.10.AND.(.NOT.TOGETHER)) WRITE(NDSO,5940) NCFLUSH + + + ! 5.5 Removes the duplicata if "ONE file per station" mode + IF (.NOT.TOGETHER) THEN ! defines a file name per station (NOT TOGETHER) DO I=1,NOPTS IF (FLREQ(I)) THEN - WRITE (NCNAME, '(5A)') TRIM(FILEPREFIX), TRIM(PTNME(I)),'_', TRIM(FILETIME), TRIM(EXT) - !IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1947) TRIM(NCNAME) J = LEN_TRIM(FNMPRE) + WRITE (NCNAME, '(5A)') TRIM(FILEPREFIX), TRIM(PTNME(I)),'_', TRIM(FILETIME), TRIM(EXT) WRITE(NCFILE(I),'(2A)') TRIM(FNMPRE(:J)), TRIM(NCNAME) ! filename + IF( SUM(index(NCFILE(:),NCFILE(I))).GT.1 ) THEN + FLREQ(I)=.FALSE. + WRITE(NDSO,5950) TRIM(PTNME(I)) + CYCLE + END IF END IF ! FLREQ(I) END DO ! I=1,NOPTS - END IF ! TOGETHER + END IF ! .NOT.TOGETHER - ! 5.6.3 Defines number of stations and files to CREATE - ! together - IF (TOGETHER) THEN - NBFILEOUT = 1 - NBSTATION = NREQ - NREQL=NBFILEOUT - ! not together - ELSE - NBFILEOUT=MIN(MFL,NOPTS-(IFL-1)*MFL) - NBSTATION = 1 - NREQL=0 - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF ( FLREQ(I) ) THEN - NREQL = NREQL + 1 + ! 5.6 Loops on bunch of stations NFL + DO IFL=IAPROC,NFL,NAPROC + ! + ! new file, so the time counter is initialized + DO + IOUT=0 + + + ! 5.6.1 Redefines the filetime when it's a new date defined by the date division S3 + ! if S3=>YYYYMMDDHH then filetime='YYYYMMDDTHHMMSSZ' + IF (S3.EQ.0) THEN + FILETIME = '' + ELSE IF (S3.EQ.10) THEN + WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I8.8,A1,I',S5,'.',S5,',A1)' + WRITE (FILETIME,FORMAT1) TIME(1), 'T', & + NINT(REAL(TIME(2))/NINT(10.**(6-S5))), 'Z' + ! if S3=>YYYYMMDD then filetime='YYYYMMDD' + ELSE IF (S3.EQ.8) THEN + WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I',S3,'.',S3,')' + WRITE (FILETIME,FORMAT1) TIME(1) + ! if S3=>YYYYMM then filetime='YYYYMM' + ! or S3=>YYYY then filetime='YYYY' + ELSE + WRITE(FORMAT1,'(A,I1,A,I1,A)') '(I',S3,'.',S3,')' + WRITE (FILETIME,FORMAT1) NINT(REAL(TIME(1))/NINT(10.**(8-S3))) END IF - END DO - END IF - ! cycle if no file to CREATE - IF (NREQL.EQ.0) CYCLE - - ! 5.6.4 Creates netcdf file - ! ... ITYPE = 1 - IF (ITYPE .EQ. 1) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) ITYPE, '1-D and/or 2-D spectra, pass #',IFL - - ! ... OTYPE = 1 - IF (OTYPE .EQ. 1) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'print plots' - IF ( SCALE1 .LT. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '1-D' - ELSE IF ( SCALE1 .EQ. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '1-D' + ! 5.6.2 Defines the file names + ! defines unique file name (TOGETHER) + IF (TOGETHER) THEN + WRITE (NCNAME, '(3A)') TRIM(FILEPREFIX), TRIM(FILETIME), TRIM(EXT) + !IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1947) TRIM(NCNAME) + J = LEN_TRIM(FNMPRE) + WRITE(NCFILE(1),'(2A)') TRIM(FNMPRE(:J)), TRIM(NCNAME) ! filename ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '1-D', SCALE1 - END IF - IF ( SCALE2 .LT. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '2-D' - ELSE IF ( SCALE2 .EQ. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '2-D' + ! defines a file name per station (NOT TOGETHER) + DO I=1,NOPTS + IF (FLREQ(I)) THEN + WRITE (NCNAME, '(5A)') TRIM(FILEPREFIX), TRIM(PTNME(I)),'_', TRIM(FILETIME), TRIM(EXT) + !IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1947) TRIM(NCNAME) + J = LEN_TRIM(FNMPRE) + WRITE(NCFILE(I),'(2A)') TRIM(FNMPRE(:J)), TRIM(NCNAME) ! filename + END IF ! FLREQ(I) + END DO ! I=1,NOPTS + END IF ! TOGETHER + + + ! 5.6.3 Defines number of stations and files to CREATE + ! together + IF (TOGETHER) THEN + NBFILEOUT = 1 + NBSTATION = NREQ + NREQL=NBFILEOUT + ! not together ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '2-D', SCALE2 + NBFILEOUT=MIN(MFL,NOPTS-(IFL-1)*MFL) + NBSTATION = 1 + NREQL=0 + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF ( FLREQ(I) ) THEN + NREQL = NREQL + 1 + END IF + END DO END IF + ! cycle if no file to CREATE + IF (NREQL.EQ.0) CYCLE - ! ... OTYPE = 2 - ELSE IF ( OTYPE .EQ. 2 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Table of 1-D spectral data' - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! Create the netCDF file - DIMLN(1)=NF90_UNLIMITED ! time - DIMLN(2)=NBSTATION ! station - DIMLN(3)=40 ! string station name length - DIMLN(4)=NK ! FREQ - CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) - END IF - END DO - ! ... OTYPE = 3 - ELSE IF ( OTYPE .EQ. 3 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Transfer file' - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! Create the netCDF file - DIMLN(1)=NF90_UNLIMITED !time - DIMLN(2)=NBSTATION ! station - DIMLN(3)=40 ! string station name length - DIMLN(4)=NK ! FREQ - DIMLN(5)=NTH ! DIR - CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO,NCVARTYPE=NCVARTYPE) - END IF - END DO - - ! ... OTYPE = 4 - ELSE IF ( OTYPE .EQ. 4 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Partitioning of spectra' - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! Create the netCDF file - DIMLN(1)=NF90_UNLIMITED !time - DIMLN(2)=NBSTATION ! station - DIMLN(3)=40 ! string station name length - DIMLN(4)=DIMXP ! npart - CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) - END IF - END DO - ELSE - WRITE (NDSE,1011) OTYPE - CALL EXTCDE ( 10 ) - END IF + ! 5.6.4 Creates netcdf file + ! ... ITYPE = 1 + IF (ITYPE .EQ. 1) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) ITYPE, '1-D and/or 2-D spectra, pass #',IFL + ! ... OTYPE = 1 + IF (OTYPE .EQ. 1) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'print plots' + IF ( SCALE1 .LT. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '1-D' + ELSE IF ( SCALE1 .EQ. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '1-D' + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '1-D', SCALE1 + END IF + IF ( SCALE2 .LT. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '2-D' + ELSE IF ( SCALE2 .EQ. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '2-D' + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '2-D', SCALE2 + END IF - ! ... ITYPE = 2 - ELSE IF (ITYPE .EQ. 2) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) ITYPE, 'Table of mean wave parameters' - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! Create the netCDF file - DIMLN(1)=NF90_UNLIMITED !time - DIMLN(2)=NBSTATION ! station - DIMLN(3)=40 ! string station name length - CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) - END IF - END DO + ! ... OTYPE = 2 + ELSE IF ( OTYPE .EQ. 2 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Table of 1-D spectral data' + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! Create the netCDF file + DIMLN(1)=NF90_UNLIMITED ! time + DIMLN(2)=NBSTATION ! station + DIMLN(3)=40 ! string station name length + DIMLN(4)=NK ! FREQ + CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) + END IF + END DO - ! ... OTYPE = 1 - IF ( OTYPE .EQ. 1 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'depth, current and wind', NCNAME + ! ... OTYPE = 3 + ELSE IF ( OTYPE .EQ. 3 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Transfer file' + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! Create the netCDF file + DIMLN(1)=NF90_UNLIMITED !time + DIMLN(2)=NBSTATION ! station + DIMLN(3)=40 ! string station name length + DIMLN(4)=NK ! FREQ + DIMLN(5)=NTH ! DIR + CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO,NCVARTYPE=NCVARTYPE) + END IF + END DO - ! ... OTYPE = 2 - ELSE IF ( OTYPE .EQ. 2 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Mean wave parameters', NCNAME + ! ... OTYPE = 4 + ELSE IF ( OTYPE .EQ. 4 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Partitioning of spectra' + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! Create the netCDF file + DIMLN(1)=NF90_UNLIMITED !time + DIMLN(2)=NBSTATION ! station + DIMLN(3)=40 ! string station name length + DIMLN(4)=DIMXP ! npart + CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) + END IF + END DO + ELSE + WRITE (NDSE,1011) OTYPE + CALL EXTCDE ( 10 ) + END IF - ! ... OTYPE = 3 - ELSE IF ( OTYPE .EQ. 3 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Nondimensional parameters (U*)', NCNAME - ! ... OTYPE = 4 - ELSE IF ( OTYPE .EQ. 4 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Nondimensional parameters (U10)', NCNAME - ! ... OTYPE = 5 - ELSE IF ( OTYPE .EQ. 5 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Validation parameters', NCNAME + ! ... ITYPE = 2 + ELSE IF (ITYPE .EQ. 2) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) ITYPE, 'Table of mean wave parameters' + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! Create the netCDF file + DIMLN(1)=NF90_UNLIMITED !time + DIMLN(2)=NBSTATION ! station + DIMLN(3)=40 ! string station name length + CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) + END IF + END DO - ! ... OTYPE = 6 - ELSE IF ( OTYPE .EQ. 6 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'WMO standard mean parameters', NCNAME - ! ... OTYPE = ILLEGAL - ELSE - WRITE (NDSE,1011) OTYPE - CALL EXTCDE ( 30 ) - END IF - ! - DO I=1,6 - IF ( FLSRCE(I) .AND. IAPROC .EQ. NAPOUT ) WRITE (NDSO,3940) IDSRCE(I) - END DO - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' + ! ... OTYPE = 1 + IF ( OTYPE .EQ. 1 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'depth, current and wind', NCNAME + ! ... OTYPE = 2 + ELSE IF ( OTYPE .EQ. 2 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Mean wave parameters', NCNAME - ! ... ITYPE = 3 - ELSE IF (ITYPE .EQ. 3) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) ITYPE, 'Source terms' -#ifdef W3_NCO - NDSTAB = 51 -#endif - ISCALE = MAX ( 0 , MIN ( 5 , ISCALE ) ) + ! ... OTYPE = 3 + ELSE IF ( OTYPE .EQ. 3 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Nondimensional parameters (U*)', NCNAME - ! ... OTYPE = 1 - IF ( OTYPE .EQ. 1 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Print plots' - IF ( SCALE1 .LT. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '1-D' - ELSE IF ( SCALE1 .EQ. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '1-D' - ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '1-D', SCALE1 - END IF - IF ( SCALE2 .LT. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '2-D' - ELSE IF ( SCALE2 .EQ. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '2-D' - ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '2-D', SCALE2 - END IF + ! ... OTYPE = 4 + ELSE IF ( OTYPE .EQ. 4 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Nondimensional parameters (U10)', NCNAME - ! ... OTYPE = 2 - ! or OTYPE = 3 - ELSE IF (( OTYPE .EQ. 2 ) .OR. ( OTYPE .EQ. 3 )) THEN - IF ( ISCALE .LE. 2) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Tables as a function of freq.' - ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Tables as a function of f/fp.' - END IF - IF ( MOD(ISCALE,3) .EQ. 1 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,944) '(nondimensional based on U10)' - ELSE IF ( MOD(ISCALE,3) .EQ. 2) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,944) '(nondimensional based on U*)' - END IF + ! ... OTYPE = 5 + ELSE IF ( OTYPE .EQ. 5 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'Validation parameters', NCNAME - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! Create the netCDF file - DIMLN(1)=NF90_UNLIMITED !time - DIMLN(2)=NBSTATION ! station - DIMLN(3)=40 ! string station name length - DIMLN(4)=NK ! freq - CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) + ! ... OTYPE = 6 + ELSE IF ( OTYPE .EQ. 6 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2940) 'WMO standard mean parameters', NCNAME + ! ... OTYPE = ILLEGAL + ELSE + WRITE (NDSE,1011) OTYPE + CALL EXTCDE ( 30 ) END IF - END DO + ! + DO I=1,6 + IF ( FLSRCE(I) .AND. IAPROC .EQ. NAPOUT ) WRITE (NDSO,3940) IDSRCE(I) + END DO + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' - ! ... OTYPE = 4 - ELSE IF ( OTYPE .EQ. 4 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Transfer file' - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! Create the netCDF file - DIMLN(1)=NF90_UNLIMITED !time - DIMLN(2)=NBSTATION ! station - DIMLN(3)=40 ! string station name length - DIMLN(4)=NK ! freq - DIMLN(5)=NTH ! dir - CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO,FLSRCE=FLSRCE) - END IF - END DO - ! ... OTYPE = ILLEGAL - ELSE - WRITE (NDSE,1011) OTYPE - CALL EXTCDE ( 20 ) - END IF + ! ... ITYPE = 3 + ELSE IF (ITYPE .EQ. 3) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,942) ITYPE, 'Source terms' +#ifdef W3_NCO + NDSTAB = 51 +#endif + ISCALE = MAX ( 0 , MIN ( 5 , ISCALE ) ) + ! ... OTYPE = 1 + IF ( OTYPE .EQ. 1 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Print plots' + IF ( SCALE1 .LT. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '1-D' + ELSE IF ( SCALE1 .EQ. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '1-D' + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '1-D', SCALE1 + END IF + IF ( SCALE2 .LT. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1940) '2-D' + ELSE IF ( SCALE2 .EQ. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1941) '2-D' + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1942) '2-D', SCALE2 + END IF - ! ... ITYPE = ILLEGAL - ELSE - WRITE (NDSE,1010) ITYPE - CALL EXTCDE ( 1 ) - END IF + ! ... OTYPE = 2 + ! or OTYPE = 3 + ELSE IF (( OTYPE .EQ. 2 ) .OR. ( OTYPE .EQ. 3 )) THEN + IF ( ISCALE .LE. 2) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Tables as a function of freq.' + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Tables as a function of f/fp.' + END IF + IF ( MOD(ISCALE,3) .EQ. 1 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,944) '(nondimensional based on U10)' + ELSE IF ( MOD(ISCALE,3) .EQ. 2) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,944) '(nondimensional based on U*)' + END IF + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! Create the netCDF file + DIMLN(1)=NF90_UNLIMITED !time + DIMLN(2)=NBSTATION ! station + DIMLN(3)=40 ! string station name length + DIMLN(4)=NK ! freq + CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO) + END IF + END DO - ! 5.6.5 Output of output points - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,950) NREQ - ! together - IF (TOGETHER) THEN - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBSTATION - IF (FLREQ(I)) THEN - IF ( FLAGLL ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) PTNME(I), M2KM*PTLOC(1,I), & - M2KM*PTLOC(2,I) + ! ... OTYPE = 4 + ELSE IF ( OTYPE .EQ. 4 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,943) 'Transfer file' + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! Create the netCDF file + DIMLN(1)=NF90_UNLIMITED !time + DIMLN(2)=NBSTATION ! station + DIMLN(3)=40 ! string station name length + DIMLN(4)=NK ! freq + DIMLN(5)=NTH ! dir + CALL W3CRNC(ITYPE,OTYPE,NCTYPE,NCFILE(I),NCID(I),DIMID,DIMLN,VARID,ONE,TWO,FLSRCE=FLSRCE) + END IF + END DO + + ! ... OTYPE = ILLEGAL ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,953) PTNME(I), M2KM*PTLOC(1,I), & - M2KM*PTLOC(2,I) + WRITE (NDSE,1011) OTYPE + CALL EXTCDE ( 20 ) END IF + + + ! ... ITYPE = ILLEGAL + ELSE + WRITE (NDSE,1010) ITYPE + CALL EXTCDE ( 1 ) END IF - END DO - ! not together - ELSE - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I)) THEN - IF ( FLAGLL ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) PTNME(I), M2KM*PTLOC(1,I), & - M2KM*PTLOC(2,I) - ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,953) PTNME(I), M2KM*PTLOC(1,I), & - M2KM*PTLOC(2,I) - END IF + + + ! 5.6.5 Output of output points + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,950) NREQ + ! together + IF (TOGETHER) THEN + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBSTATION + IF (FLREQ(I)) THEN + IF ( FLAGLL ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) PTNME(I), M2KM*PTLOC(1,I), & + M2KM*PTLOC(2,I) + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,953) PTNME(I), M2KM*PTLOC(1,I), & + M2KM*PTLOC(2,I) + END IF + END IF + END DO + ! not together + ELSE + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I)) THEN + IF ( FLAGLL ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) PTNME(I), M2KM*PTLOC(1,I), & + M2KM*PTLOC(2,I) + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,953) PTNME(I), M2KM*PTLOC(1,I), & + M2KM*PTLOC(2,I) + END IF + END IF + END DO END IF - END DO - END IF - ! - !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 6. Time management. - ! + ! + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! 6. Time management. + ! #ifdef W3_IC1 - WRITE(NDSO,3960) + WRITE(NDSO,3960) #endif #ifdef W3_IC2 - WRITE(NDSO,3960) + WRITE(NDSO,3960) #endif #ifdef W3_IC3 - WRITE(NDSO,3960) + WRITE(NDSO,3960) #endif #ifdef W3_IC5 - WRITE(NDSO,3960) + WRITE(NDSO,3960) #endif #ifdef W3_NL5 - WRITE(NDSO,3961) + WRITE(NDSO,3961) #endif - ! - CALL T2D(TIME,STARTDATE,IERR) - WRITE(STRSTARTDATE,'(I4.4,A,4(I2.2,A),I2.2)') STARTDATE(1),'-',STARTDATE(2), & - '-',STARTDATE(3),' ',STARTDATE(5),':',STARTDATE(6),':',STARTDATE(7) - - ! loops on TIME from out_pnt.ww3 till not reach TOUT from inp file - DO - DTEST = DSEC21 ( TIME , TOUT ) - IF ( DTEST .GT. 0. ) THEN - ! reads TIME from out_pnt.ww3 + ! + CALL T2D(TIME,STARTDATE,IERR) + WRITE(STRSTARTDATE,'(I4.4,A,4(I2.2,A),I2.2)') STARTDATE(1),'-',STARTDATE(2), & + '-',STARTDATE(3),' ',STARTDATE(5),':',STARTDATE(6),':',STARTDATE(7) + + ! loops on TIME from out_pnt.ww3 till not reach TOUT from inp file + DO + DTEST = DSEC21 ( TIME , TOUT ) + IF ( DTEST .GT. 0. ) THEN + ! reads TIME from out_pnt.ww3 #ifdef W3_BIN2NC - CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) #else - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPO ( 'READ', NDSOP, IOTEST ) #endif - IF ( IOTEST .EQ. -1 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) - GOTO 700 - END IF - CYCLE - END IF - IF ( DTEST .LT. 0. ) THEN - CALL TICK21 ( TOUT , DTREQ ) - CYCLE - END IF - ! increment the time counter IOUT - IOUT = IOUT + 1 - CALL STME21 ( TOUT , IDTIME ) - WRITE(DATE,'(I8.8,I6.6)') TOUT(1), TOUT(2) - - - ! 6.1 Creates a new file if it is a new date defined by the date division S3 - IF ( (IOUT.GT.1) .AND. (INDEX(PASTDATE(1:S3),DATE(1:S3)).EQ.0) ) THEN - WRITE(NDSO,954) TRIM(DATE(1:S3)) - ! decrements timesteps already processed - NOUT=NOUT-(IOUT-1) - GOTO 700 - END IF + IF ( IOTEST .EQ. -1 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) + EXIT + END IF + CYCLE + END IF + IF ( DTEST .LT. 0. ) THEN + CALL TICK21 ( TOUT , DTREQ ) + CYCLE + END IF + ! increment the time counter IOUT + IOUT = IOUT + 1 + CALL STME21 ( TOUT , IDTIME ) + WRITE(DATE,'(I8.8,I6.6)') TOUT(1), TOUT(2) + + + ! 6.1 Creates a new file if it is a new date defined by the date division S3 + IF ( (IOUT.GT.1) .AND. (INDEX(PASTDATE(1:S3),DATE(1:S3)).EQ.0) ) THEN + WRITE(NDSO,954) TRIM(DATE(1:S3)) + ! decrements timesteps already processed + NOUT=NOUT-(IOUT-1) + EXIT + END IF - ! 6.2 Writes out a progress message - IF (NREQ.GT.10.OR.NBFILEOUT.GT.10) WRITE(NDSO,955) TIME, & - NBFILEOUT, IOUT, NOUT, IFL - J=0 + ! 6.2 Writes out a progress message + IF (NREQ.GT.10.OR.NBFILEOUT.GT.10) WRITE(NDSO,955) TIME, & + NBFILEOUT, IOUT, NOUT, IFL + J=0 - ! 6.3 Calls subroutine w3exnc for each file - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF (FLREQ(I) .OR. TOGETHER) THEN - ! together - IF ( TOGETHER ) THEN - CALL W3EXNC(I,NCID(I),NREQ,INDREQ,ORDER) - ! not together - ELSE - J=J+1 - CALL W3EXNC(I,NCID(I),1,(/ I /),ORDER) - ! flush buffer (only available in netcdf3) - IF (MOD(IOUT,NCFLUSH).EQ.0) THEN - IRET=NF90_SYNC(NCID(I)) - END IF - END IF ! TOGETHER - END IF ! (FLREQ(I) .OR. TOGETHER) - END DO ! I=1+ ... - ! - WRITE(PASTDATE,'(I8.8,I6.6)') TOUT(1), TOUT(2) - CALL TICK21 ( TOUT , DTREQ ) - IF ( IOUT .GE. NOUT ) GOTO 700 - ! - END DO - ! - GOTO 888 + ! 6.3 Calls subroutine w3exnc for each file + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF (FLREQ(I) .OR. TOGETHER) THEN + ! together + IF ( TOGETHER ) THEN + CALL W3EXNC(I,NCID(I),NREQ,INDREQ,ORDER) + ! not together + ELSE + J=J+1 + CALL W3EXNC(I,NCID(I),1,(/ I /),ORDER) + ! flush buffer (only available in netcdf3) + IF (MOD(IOUT,NCFLUSH).EQ.0) THEN + IRET=NF90_SYNC(NCID(I)) + END IF + END IF ! TOGETHER + END IF ! (FLREQ(I) .OR. TOGETHER) + END DO ! I=1+ ... + ! + WRITE(PASTDATE,'(I8.8,I6.6)') TOUT(1), TOUT(2) + CALL TICK21 ( TOUT , DTREQ ) + IF ( IOUT .GE. NOUT ) EXIT + ! + END DO + ! - ! - !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 7. Finalize file - ! -700 CONTINUE - ! - CALL T2D(TIME,STOPDATE,IERR) - WRITE(STRSTOPDATE,'(I4.4,A,4(I2.2,A),I2.2)') STOPDATE(1),'-',STOPDATE(2), & - '-',STOPDATE(3),' ',STOPDATE(5),':',STOPDATE(6),':',STOPDATE(7) - - - ! 7.1 Writes the global attributes to netCDF file - DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - IF ( FLREQ(I) .OR. TOGETHER ) THEN - IRET=NF90_REDEF(NCID(I)) - CALL CHECK_ERR(IRET,0) - IF (FLWW3.EQ.0) & - OPEN(unit=994,file='NC_globatt.inp',status='old',iostat=ICODE) - REWIND(994) - IF (ICODE.EQ.0) THEN - DO WHILE (ICODE.EQ.0) - READ(994,'(a)',iostat=ICODE) ATTNAME - READ(994,'(a)',iostat=ICODE) ATTVAL - IF (ICODE.EQ.0) THEN - STRL=LEN_TRIM(ATTNAME) - STRL2=LEN_TRIM(ATTVAL) - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,ATTNAME(1:STRL),ATTVAL(1:STRL2)) - CALL CHECK_ERR(IRET,1) - END IF - END DO - END IF - CLOSE(994) - ! - WRITE(GLOBALATT,'(A)') TRIM(NCFILE(I)) - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'product_name' ,GLOBALATT(3:)) - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'area',TRIM(GNAME)) - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'data_type','OCO spectra 2D') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'format_version','1.1') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'southernmost_latitude','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'northernmost_latitude','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'latitude_resolution','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'westernmost_longitude','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'easternmost_longitude','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'longitude_resolution','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'minimum_altitude','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'maximum_altitude','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'altitude_resolution','n/a') - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'start_date',STRSTARTDATE) - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'stop_date',STRSTOPDATE) - IF (DTREQ.EQ.3600) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','hourly') - ELSE IF (DTREQ.EQ.7200) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','2-hourly') - ELSE IF (DTREQ.EQ.10800) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','3-hourly') - ELSE IF (DTREQ.EQ.21600) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','6-hourly') - ELSE IF (DTREQ.EQ.32400) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','9-hourly') - ELSE IF (DTREQ.EQ.43200) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','12-hourly') - ELSE IF (DTREQ.EQ.86400) THEN - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','daily') - ELSE - IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','n/a') - END IF ! - ! Close netCDF file - IRET=NF90_ENDDEF(NCID(I)) - CALL CHECK_ERR(IRET,2) - IRET=NF90_CLOSE(NCID(I)) - CALL CHECK_ERR(IRET,3) + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! 7. Finalize file ! - END IF ! FLREQ(I) .OR. TOGETHER - END DO ! I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + DO + ! + CALL T2D(TIME,STOPDATE,IERR) + WRITE(STRSTOPDATE,'(I4.4,A,4(I2.2,A),I2.2)') STOPDATE(1),'-',STOPDATE(2), & + '-',STOPDATE(3),' ',STOPDATE(5),':',STOPDATE(6),':',STOPDATE(7) + + + ! 7.1 Writes the global attributes to netCDF file + DO I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT + IF ( FLREQ(I) .OR. TOGETHER ) THEN + IRET=NF90_REDEF(NCID(I)) + CALL CHECK_ERR(IRET,0) + IF (FLWW3.EQ.0) & + OPEN(unit=994,file='NC_globatt.inp',status='old',iostat=ICODE) + REWIND(994) + IF (ICODE.EQ.0) THEN + DO WHILE (ICODE.EQ.0) + READ(994,'(a)',iostat=ICODE) ATTNAME + READ(994,'(a)',iostat=ICODE) ATTVAL + IF (ICODE.EQ.0) THEN + STRL=LEN_TRIM(ATTNAME) + STRL2=LEN_TRIM(ATTVAL) + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,ATTNAME(1:STRL),ATTVAL(1:STRL2)) + CALL CHECK_ERR(IRET,1) + END IF + END DO + END IF + CLOSE(994) + ! + WRITE(GLOBALATT,'(A)') TRIM(NCFILE(I)) + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'product_name' ,GLOBALATT(3:)) + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'area',TRIM(GNAME)) + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'data_type','OCO spectra 2D') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'format_version','1.1') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'southernmost_latitude','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'northernmost_latitude','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'latitude_resolution','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'westernmost_longitude','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'easternmost_longitude','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'longitude_resolution','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'minimum_altitude','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'maximum_altitude','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'altitude_resolution','n/a') + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'start_date',STRSTARTDATE) + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'stop_date',STRSTOPDATE) + IF (DTREQ.EQ.3600) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','hourly') + ELSE IF (DTREQ.EQ.7200) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','2-hourly') + ELSE IF (DTREQ.EQ.10800) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','3-hourly') + ELSE IF (DTREQ.EQ.21600) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','6-hourly') + ELSE IF (DTREQ.EQ.32400) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','9-hourly') + ELSE IF (DTREQ.EQ.43200) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','12-hourly') + ELSE IF (DTREQ.EQ.86400) THEN + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','daily') + ELSE + IRET=NF90_PUT_ATT(NCID(I),NF90_GLOBAL,'field_type','n/a') + END IF + ! + ! Close netCDF file + IRET=NF90_ENDDEF(NCID(I)) + CALL CHECK_ERR(IRET,2) + IRET=NF90_CLOSE(NCID(I)) + CALL CHECK_ERR(IRET,3) + ! + END IF ! FLREQ(I) .OR. TOGETHER + END DO ! I=1+(IFL-1)*MFL,(IFL-1)*MFL+NBFILEOUT - ! 7.2 Goes back to the start of the loop with the same points - ! but with a new date defined by the date division S3 - IF ( (IOUT.GT.1) .AND. (INDEX(PASTDATE(1:S3),DATE(1:S3)).EQ.0) ) THEN - GOTO 560 - END IF + ! 7.2 Goes back to the start of the loop with the same points + ! but with a new date defined by the date division S3 + IF ( (IOUT.GT.1) .AND. (INDEX(PASTDATE(1:S3),DATE(1:S3)).EQ.0) ) THEN + EXIT + END IF - ! 7.3 Reinitiazes TIME (close open out_pnt.ww3) and TOUT to process a new bunch of stations - CLOSE(NDSOP) ! closes binary file out_pnt* - IPASS = 0 ! resets time counter for binary file out_pnt* + ! 7.3 Reinitiazes TIME (close open out_pnt.ww3) and TOUT to process a new bunch of stations + CLOSE(NDSOP) ! closes binary file out_pnt* + IPASS = 0 ! resets time counter for binary file out_pnt* #ifdef W3_BIN2NC - CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) #else - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPO ( 'READ', NDSOP, IOTEST ) #endif #ifdef W3_T - WRITE(NDSE,*) 'out_pnt* closed and reopened' + WRITE(NDSE,*) 'out_pnt* closed and reopened' #endif - TOUT=TOUTL - NOUT=NOUTL + TOUT=TOUTL + NOUT=NOUTL - ! 7.4 Loops on TIME till it is equal to TOUT - DTEST = DSEC21 ( TIME , TOUT ) - DO WHILE (DTEST.NE.0) - DTEST = DSEC21 ( TIME , TOUT ) - IF ( DTEST .GT. 0. ) THEN + ! 7.4 Loops on TIME till it is equal to TOUT + IOTEST = 0 + DTEST = DSEC21 ( TIME , TOUT ) + DO WHILE (DTEST.NE.0) + DTEST = DSEC21 ( TIME , TOUT ) + IF ( DTEST .GT. 0. ) THEN #ifdef W3_BIN2NC - CALL W3IOPON ( 'READ', NDSOP, IOTEST ) + CALL W3IOPON ( 'READ', NDSOP, IOTEST ) #else - CALL W3IOPO ( 'READ', NDSOP, IOTEST ) + CALL W3IOPO ( 'READ', NDSOP, IOTEST ) #endif - IF ( IOTEST .EQ. -1 ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) - GOTO 700 - END IF - CYCLE - END IF - IF ( DTEST .LT. 0. ) THEN - CALL TICK21 ( TOUT , DTREQ ) - CYCLE - END IF - END DO + IF ( IOTEST .EQ. -1 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) + EXIT + END IF + CYCLE + END IF + IF ( DTEST .LT. 0. ) THEN + CALL TICK21 ( TOUT , DTREQ ) + CYCLE + END IF + END DO + ! + IF (IOTEST .NE. -1) EXIT + END DO + IF ( (IOUT.LE.1) .OR. (INDEX(PASTDATE(1:S3),DATE(1:S3)).NE.0) ) EXIT + END DO ! new file + END DO ! IFL=1,NFL ! - END DO ! IFL=1,NFL - ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 41 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 42 ) - ! -803 CONTINUE - WRITE (NDSE,1003) - CALL EXTCDE ( 43 ) - ! -804 CONTINUE - WRITE (NDSE,1004) NF90_INQ_LIBVERS() - CALL EXTCDE ( 44 ) - ! -#ifdef W3_O14 -805 CONTINUE - WRITE (NDSE,1005) IERR - CALL EXTCDE ( 45 ) -#endif - ! - ! -888 CONTINUE + END IF ! IF(ALLOCATED(THD)) DEALLOCATE(THD) IF(ALLOCATED(NCID)) DEALLOCATE(NCID) @@ -1362,17 +1359,6 @@ PROGRAM W3OUNP ' ========================================='/ & ' WAVEWATCH III Point output '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNP : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNP : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNP : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNP : '/ & ' NCTYPE=3 IS INCOMPATIBLE WITH'/ & ' THE OPTIMIZED DIMENSION ORDER'/) @@ -1381,12 +1367,6 @@ PROGRAM W3OUNP ' NCTYPE=4 IS INCOMPATIBLE WITH'/ & ' NETCDF LIBRARY USED :',A/) ! -#ifdef W3_O14 -1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNP : '/ & - ' ERROR IN OPENING BUOY LOG FILE'/ & - ' IOSTAT =',I5/) -#endif - ! 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNP : '/ & ' ITYPE AND OTYPE COMBINATION NOT RECOGNIZED'/) ! diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index 02f5efa85c..0adc8d3ffe 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -68,6 +68,7 @@ PROGRAM W3OUTF !/ 12-Sep-2018 : Added new partitioned output fields ( version 6.06 ) !/ 26-Jan-2021 : Added TP field (derived from FP0) ( version 7.12 ) !/ 22-Mar-2021 : New coupling fields output ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -106,6 +107,8 @@ PROGRAM W3OUTF ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input file. + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -143,7 +146,7 @@ PROGRAM W3OUTF USE W3WDATMD, ONLY: W3NDAT, W3SETW USE W3ADATMD, ONLY: W3NAUX, W3SETA USE W3ODATMD, ONLY: W3NOUT, W3SETO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -221,8 +224,10 @@ PROGRAM W3OUTF ! J = LEN_TRIM(FNMPRE) OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_outf.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTF','INPUT',10) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -249,7 +254,8 @@ PROGRAM W3OUTF ! Output times ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) TOUT, DTREQ, NOUT + READ (NDSI,*,IOSTAT=IERR) TOUT, DTREQ, NOUT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) DTREQ = MAX ( 0. , DTREQ ) IF ( DTREQ.EQ.0. ) NOUT = 1 NOUT = MAX ( 1 , NOUT ) @@ -273,13 +279,13 @@ PROGRAM W3OUTF ! CALL W3READFLGRD ( NDSI, NDSO, 9, NDSE, COMSTR, FLOG, & FLREQ, 1, 1, IERR ) - IF (IERR.NE.0) GOTO 800 - + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTF','INPUT',10) ! ! ... Output type ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) ITYPE, IPART + READ (NDSI,*,IOSTAT=IERR) ITYPE, IPART + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) !Li IF ( ITYPE.LT.0 .OR. ITYPE.GT.3 ) THEN IF ( ITYPE.LT.0 .OR. ITYPE.GT.4 ) THEN !Li Type 4 for text output at sea points. JGLi12Dec2012 @@ -298,7 +304,8 @@ PROGRAM W3OUTF CALL W3IOGO ( 'READ', NDSOG, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,944) - GOTO 888 + WRITE (NDSO,999) + STOP END IF END DO ! @@ -307,8 +314,9 @@ PROGRAM W3OUTF ELSE IF (ITYPE .EQ. 1) THEN WRITE (NDSO,942) ITYPE, 'Print plots' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) & + READ (NDSI,*,IOSTAT=IERR) & IX1, IXN, IXS, IY1, IYN, IYS, SCALE, VECTOR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) IX1 = MAX ( IX1 , 1 ) IXN = MIN ( IXN , NX ) IXS = MAX ( IXS , 1 ) @@ -324,7 +332,8 @@ PROGRAM W3OUTF WRITE (NDSO,942) ITYPE, 'Field statistics' NDSDT = NDSDAT - 1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IX1, IXN, IY1, IYN + READ (NDSI,*,IOSTAT=IERR) IX1, IXN, IY1, IYN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) IX1 = MAX ( IX1 , 1 ) IXN = MIN ( IXN , NX ) IY1 = MAX ( IY1 , 1 ) @@ -336,8 +345,9 @@ PROGRAM W3OUTF ELSE IF (ITYPE .EQ. 3) THEN WRITE (NDSO,942) ITYPE, 'Transfer files' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) & + READ (NDSI,*,IOSTAT=IERR) & IX1, IXN, IY1, IYN, IDLA, IDFM + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) IX1 = MAX ( IX1 , 1 ) IXN = MIN ( IXN , NX ) IY1 = MAX ( IY1 , 1 ) @@ -354,8 +364,9 @@ PROGRAM W3OUTF ELSE IF (ITYPE .EQ. 4) THEN WRITE (NDSO,942) ITYPE, 'Full sea-point output.' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) & + READ (NDSI,*,IOSTAT=IERR) & IX1, IXN, IY1, IYN, IDLA, IDFM + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTF','INPUT',11) !Li ! END IF @@ -410,7 +421,8 @@ PROGRAM W3OUTF CALL W3IOGO ( 'READ', NDSOG, IOTEST ) IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,944) - GOTO 888 + WRITE (NDSO,999) + STOP END IF CYCLE END IF @@ -435,23 +447,6 @@ PROGRAM W3OUTF ! IF (ITYPE.EQ.3) WRITE (NDSO,972) ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 10 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 11 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 12 ) - ! -888 CONTINUE WRITE (NDSO,999) ! ! Formats @@ -512,17 +507,6 @@ PROGRAM W3OUTF ' ========================================='/ & ' WAVEWATCH III Field output '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTF : '/ & ' ILLEGAL TYPE, ITYPE =',I4/) !/ @@ -573,6 +557,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) !/ 25-Jun-2013 : Add type 4 sea point text output. ( version 4.11 ) !/ 26-Jan-2021 : Added TP field (derived from FP0) ( version 7.12 ) !/ 22-Mar-2021 : New coupling fields output ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -2446,7 +2431,8 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) IF(GTYPE .NE. UNGTYPE) THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME, & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3EXGO','OUTPUT',2) WRITE (NDSDAT) FILEID, TIME, & MINVAL(XGRD(IY1:IYN,IX1:IXN)), & MAXVAL(XGRD(IY1:IYN,IX1:IXN)), IXN-IX1+1, & @@ -2455,7 +2441,8 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ENAME, FSC, UNITS, IDLA, IDFM, FORMF, MFILL ELSE OPEN (NDSDAT,FILE=FNAME, & - form='UNFORMATTED', convert=file_endian,ERR=800,IOSTAT=IERR) + form='UNFORMATTED', convert=file_endian,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3EXGO','OUTPUT',2) WRITE (NDSDAT) FILEID, TIME, & X0,MAXX,NX, & Y0,MAXY,NY, & @@ -2464,8 +2451,8 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ELSE IF(GTYPE .NE. UNGTYPE) THEN JJ = LEN_TRIM(FNMPRE) - OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & - IOSTAT=IERR) + OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3EXGO','OUTPUT',2) IF (FSC.LT.1E-4) THEN WRITE(FSCS,'(G8.1)') FSC ELSE @@ -2487,8 +2474,8 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ENAME, FSCS, UNITS, IDLA, IDFM, FORMF, MFILL END IF ELSE - OPEN (NDSDAT,FILE=FNAME, & - ERR=800,IOSTAT=IERR) + OPEN (NDSDAT,FILE=FNAME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3EXGO','OUTPUT',2) WRITE (NDSDAT, 949) FILEID, TIME, & X0,MAXX,NX, & Y0,MAXY,NY, & @@ -2618,8 +2605,8 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ! FNAME(13:) = ENAME JJ = LEN_TRIM(FNMPRE) - OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,ERR=800, & - IOSTAT=IERR) + OPEN (NDSDAT,FILE=FNMPRE(:JJ)//FNAME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3EXGO','OUTPUT',2) WRITE (6,*) FNAME(1:16) ! IF ( FLTRI ) THEN @@ -2653,12 +2640,6 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ! RETURN ! - ! Error escape locations - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE (2) - ! ! Formats ! 113 FORMAT ((10ES11.3)) @@ -2679,10 +2660,6 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) 999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO :'/ & ' PLEASE UPDATE FIELDS !!! '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO : '/ & - ' ERROR IN OPENING OUTPUT FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_T 9000 FORMAT (' TEST W3EXGO : FLAGS :',I3,2X,20L2) 9001 FORMAT (' TEST W3EXGO : ITPYE :',I4/ & diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index 167fdceea0..db51ed48bc 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -95,6 +95,7 @@ PROGRAM W3OUTP !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) !/ 21-Jul-2022 : Correct FP0 calc for peak energy in ( version 7.14 ) !/ min/max freq band (B. Pouliot, CMC) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -154,6 +155,8 @@ PROGRAM W3OUTP ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! TICK21 Subr. Id. Advance time. @@ -213,7 +216,7 @@ PROGRAM W3OUTP #else USE W3IOPOMD, ONLY: W3IOPO #endif - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -348,8 +351,10 @@ PROGRAM W3OUTP ! J = LEN_TRIM(FNMPRE) OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_outp.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','INPUT',40) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -375,7 +380,8 @@ PROGRAM W3OUTP ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) WORDS = '' - READ (NDSI, '(A)', IOSTAT=IERR, END=801, ERR=802) LINEIN + READ (NDSI, '(A)', IOSTAT=IERR) LINEIN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) READ(LINEIN,*,IOSTAT=IERR) WORDS READ(WORDS(1), *, IOSTAT=IERR) TOUT(1) ! Date (yyyymmdd) READ(WORDS(2), *, IOSTAT=IERR) TOUT(2) ! Time (hhmmss) @@ -456,7 +462,8 @@ PROGRAM W3OUTP DO I=1, NOPTS ! reads point index CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IPOINT + READ (NDSI,*,IOSTAT=IERR) IPOINT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) ! last index IF (IPOINT .LT. 0) THEN IF (I.EQ.1) THEN @@ -475,7 +482,8 @@ PROGRAM W3OUTP ! read the 'end of list' if nopts reached before it IF ( (IPOINT .GT. 0) .AND. (NREQ .EQ. NOPTS) ) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) IPOINT + READ (NDSI,*,IOSTAT=IERR) IPOINT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) END IF END DO ! check if last point index is -1 @@ -488,7 +496,8 @@ PROGRAM W3OUTP ! ... Output type ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) ITYPE + READ (NDSI,*,IOSTAT=IERR) ITYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) ! ! ... ITYPE = 0 ! @@ -497,7 +506,8 @@ PROGRAM W3OUTP #ifdef W3_O14 WRITE (NDSO,942) ITYPE, 'Generating buoy log file' OPEN (NDBO,FILE=FNMPRE(:J)//'buoy_log.ww3', & - STATUS='NEW',ERR=805,IOSTAT=IERR) + STATUS='NEW',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','BUOY LOG',45) DO I = 1,NOPTS WRITE(NDBO,945) I, PTNME(I), PTLOC(1,I), & PTLOC(2,I), GRDID(I) @@ -517,7 +527,8 @@ PROGRAM W3OUTP #endif IF ( IOTEST .EQ. -1 ) THEN WRITE (NDSO,949) - GOTO 888 + WRITE (NDSO,999) + STOP END IF END DO END IF @@ -528,8 +539,9 @@ PROGRAM W3OUTP ELSE IF (ITYPE .EQ. 1) THEN WRITE (NDSO,942) ITYPE, '1-D and/or 2-D spectra' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) OTYPE, SCALE1, SCALE2, & + READ (NDSI,*,IOSTAT=IERR) OTYPE, SCALE1, SCALE2, & NDSTAB, FLFORM + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) #ifdef W3_NCO NDSTAB = 51 #endif @@ -555,7 +567,8 @@ PROGRAM W3OUTP IF ( NDSTAB.LE.0 .OR. NDSTAB.GT.99 ) NDSTAB = 51 WRITE ( TABNME(4:5) , '(I2.2)' ) NDSTAB J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,ERR=803,IOSTAT=IERR) + OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TABNME ELSE IF ( OTYPE .EQ. 3 ) THEN IF (dynpnt .EQ. 1) THEN @@ -566,15 +579,17 @@ PROGRAM W3OUTP WRITE (NDSO,1943) TRIM(TFNAME), 'Transfer File' J = LEN_TRIM(FNMPRE) IF (FLFORM) THEN - OPEN (NDSTAB, FILE=TRIM(TFNAME), ERR=804, & + OPEN (NDSTAB, FILE=TRIM(TFNAME), & IOSTAT=IERR, FORM='UNFORMATTED') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','IDL',44) WRITE (NDSTAB) 'WAVEWATCH III SPECTRA', & NK, NTH, 1, GNAME WRITE (NDSTAB) (SIG(IK)*TPIINV, IK = 1, NK) WRITE (NDSTAB) (MOD(2.5*PI-TH(ITH), TPI), ITH = 1, NTH) ELSE - OPEN (NDSTAB, FILE=TRIM(TFNAME), ERR=804, & + OPEN (NDSTAB, FILE=TRIM(TFNAME), & IOSTAT=IERR, FORM='FORMATTED') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','IDL',44) WRITE (NDSTAB,1944) 'WAVEWATCH III SPECTRA', & NK, NTH, 1, GNAME WRITE (NDSTAB,1945) (SIG(IK)*TPIINV, IK = 1, NK) @@ -592,8 +607,9 @@ PROGRAM W3OUTP IF ( FLFORM ) THEN WRITE (NDSO,1943) TRIM(TFNAME), 'UNFORMATTED' J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & + OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME, & IOSTAT=IERR,form='UNFORMATTED', convert=file_endian) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','IDL',44) WRITE (NDSTAB) 'WAVEWATCH III SPECTRA', & NK, NTH, NREQ, GNAME WRITE (NDSTAB) (SIG(IK)*TPIINV,IK=1,NK) @@ -604,8 +620,9 @@ PROGRAM W3OUTP ELSE WRITE (NDSO,1943) TRIM(TFNAME), 'FORMATTED' J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & + OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME, & IOSTAT=IERR,FORM='FORMATTED') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','IDL',44) WRITE (NDSTAB,1944) 'WAVEWATCH III SPECTRA', & NK, NTH, NREQ, GNAME WRITE (NDSTAB,1945) (SIG(IK)*TPIINV,IK=1,NK) @@ -623,7 +640,8 @@ PROGRAM W3OUTP ELSE IF (ITYPE .EQ. 2) THEN WRITE (NDSO,942) ITYPE, 'Table of mean wave parameters' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) OTYPE, NDSTAB + READ (NDSI,*,IOSTAT=IERR) OTYPE, NDSTAB + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) #ifdef W3_NCO NDSTAB = 51 #endif @@ -631,7 +649,8 @@ PROGRAM W3OUTP IF ( NDSTAB.LE.0 .OR. NDSTAB.GT.99 ) NDSTAB = 51 WRITE ( TABNME(4:5) , '(I2.2)' ) NDSTAB J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,ERR=803,IOSTAT=IERR) + OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) IF ( OTYPE .EQ. 1 ) THEN WRITE (NDSO,2940) 'Depth, current and wind', TABNME ELSE IF ( OTYPE .EQ. 2 ) THEN @@ -656,8 +675,9 @@ PROGRAM W3OUTP ELSE IF (ITYPE .EQ. 3) THEN WRITE (NDSO,942) ITYPE, 'Source terms' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) OTYPE, SCALE1, SCALE2, & + READ (NDSI,*,IOSTAT=IERR) OTYPE, SCALE1, SCALE2, & NDSTAB, FLSRCE, ISCALE, FLFORM + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) #ifdef W3_NCO NDSTAB = 51 #endif @@ -694,8 +714,9 @@ PROGRAM W3OUTP IF ( FLFORM ) THEN WRITE (NDSO,3943) TFNAME, 'UNFORMATTED' J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & + OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME, & IOSTAT=IERR,form='UNFORMATTED', convert=file_endian) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','IDL',44) WRITE (NDSTAB) 'WAVEWATCH III SOURCES', & NK, NTH, NREQ, FLSRCE WRITE (NDSTAB) (SIG(IK)*TPIINV,IK=1,NK) @@ -704,8 +725,9 @@ PROGRAM W3OUTP ELSE WRITE (NDSO,3943) TFNAME, 'FORMATTED' J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME,ERR=804, & + OPEN (NDSTAB,FILE=FNMPRE(:J)//TFNAME, & IOSTAT=IERR,FORM='FORMATTED') + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','IDL',44) WRITE (NDSTAB,3944) 'WAVEWATCH III SOURCES', & NK, NTH, NREQ, FLSRCE WRITE (NDSTAB,3945) (SIG(IK)*TPIINV,IK=1,NK) @@ -744,7 +766,8 @@ PROGRAM W3OUTP IF ( NDSTAB.LE.0 .OR. NDSTAB.GT.99 ) NDSTAB = 51 WRITE ( TABNME(4:5) , '(I2.2)' ) NDSTAB J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,ERR=803,IOSTAT=IERR) + OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,3941) TABNME END IF ! @@ -753,7 +776,8 @@ PROGRAM W3OUTP ELSE IF (ITYPE .EQ. 4) THEN WRITE (NDSO,942) ITYPE, 'Spectral partitions or bulletins' CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802) OTYPE, NDSTAB, TIMEV, HTYPE + READ (NDSI,*,IOSTAT=IERR) OTYPE, NDSTAB, TIMEV, HTYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3OUTP','INPUT',41) #ifdef W3_NCO NDSTAB = 51 #endif @@ -763,7 +787,8 @@ PROGRAM W3OUTP IF ( NDSTAB.LE.0 .OR. NDSTAB.GT.99 ) NDSTAB = 51 WRITE ( TABNME(4:5) , '(I2.2)' ) NDSTAB J = LEN_TRIM(FNMPRE) - OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,ERR=803,IOSTAT=IERR) + OPEN (NDSTAB,FILE=FNMPRE(:J)//TABNME,IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TABNME ELSE IF ( OTYPE .GE. 2 ) THEN @@ -774,11 +799,13 @@ PROGRAM W3OUTP DO IJ = 1,NOPTS IF (FLREQ(IJ)) THEN NDSBUL = NDSTAB + (IJ - 1) - OPEN(NDSBUL,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//'.bull',ERR=803,IOSTAT=IERR) + OPEN(NDSBUL,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//'.bull',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.bull' #ifdef W3_NCO NDSCBUL = NDSTAB + (IJ - 1) + NOPTS - OPEN(NDSCBUL,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//'.cbull',ERR=803,IOSTAT=IERR) + OPEN(NDSCBUL,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//'.cbull',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.cbull' #endif ENDIF @@ -794,11 +821,13 @@ PROGRAM W3OUTP END IF IF (FLREQ(IJ)) THEN NDSBUL = NDSTAB + (IJ - 1) - OPEN(NDSBUL,FILE=TRIM(PTNME(IJ))//'.bull',ERR=803,IOSTAT=IERR) + OPEN(NDSBUL,FILE=TRIM(PTNME(IJ))//'.bull',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.bull' #ifdef W3_NCO NDSCBUL = NDSTAB + (IJ - 1) + NOPTS - OPEN(NDSCBUL,FILE=TRIM(PTNME(IJ))//'.cbull',ERR=803,IOSTAT=IERR) + OPEN(NDSCBUL,FILE=TRIM(PTNME(IJ))//'.cbull',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.cbull' #endif END IF @@ -818,7 +847,8 @@ PROGRAM W3OUTP #endif NDSCSV = NDSTAB + (IJ - 1) + 2*NOPTS OPEN(NDSCSV,FILE=TRIM(prefix)//TRIM(PTNME(IJ))//& - '.csv',ERR=803,IOSTAT=IERR) + '.csv',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.csv' ENDIF ENDDO @@ -833,7 +863,8 @@ PROGRAM W3OUTP IF ( NDSCBUL .GT. 0 ) ICSV = NDSCBUL #endif NDSCSV = NDSTAB + (IJ - 1) + ICSV - OPEN(NDSCSV,FILE=TRIM(PTNME(IJ))//'.csv',ERR=803,IOSTAT=IERR) + OPEN(NDSCSV,FILE=TRIM(PTNME(IJ))//'.csv',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3OUTP','TABLE',43) WRITE (NDSO,1947) TRIM(PTNME(IJ))//'.csv' END IF END DO @@ -981,45 +1012,9 @@ PROGRAM W3OUTP ENDIF ENDDO ENDIF - ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 41 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 42 ) - ! -803 CONTINUE - WRITE (NDSE,1003) IERR - CALL EXTCDE ( 43 ) - ! -804 CONTINUE - WRITE (NDSE,1004) IERR - CALL EXTCDE ( 44 ) - ! -#ifdef W3_O14 -805 CONTINUE - WRITE (NDSE,1005) IERR - CALL EXTCDE ( 45 ) -#endif - ! -888 CONTINUE ! WRITE (NDSO,999) ! -#ifdef W3_NCO - ! CALL W3TAGE('WAVESPEC') -#endif - ! ! Formats ! 900 FORMAT (/15X,' *** WAVEWATCH III Point output post.*** '/ & @@ -1106,10 +1101,6 @@ PROGRAM W3OUTP ' ========================================='/ & ' WAVEWATCH III Point output '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & ' PREMATURE END OF INPUT FILE'/) ! @@ -1117,20 +1108,6 @@ PROGRAM W3OUTP ' ERROR IN READING FROM INPUT FILE'/ & ' IOSTAT =',I5/) ! -1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & - ' ERROR IN OPENING TABLE FILE'/ & - ' IOSTAT =',I5/) - ! -1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & - ' ERROR IN OPENING IDL FILE'/ & - ' IOSTAT =',I5/) - ! -#ifdef W3_O14 -1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & - ' ERROR IN OPENING BUOY LOG FILE'/ & - ' IOSTAT =',I5/) -#endif - ! 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ & ' ERROR IN READING FROM INPUT FILE'/ & ' LAST POINT INDEX IS NOT -1'/ & diff --git a/model/src/ww3_prep.F90 b/model/src/ww3_prep.F90 index 7d41df3cf7..ae0711445d 100644 --- a/model/src/ww3_prep.F90 +++ b/model/src/ww3_prep.F90 @@ -54,6 +54,7 @@ PROGRAM W3PREP !/ type (i.e. accounts for the header) ( version 4.13 ) !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 ) !/ 22-Mar-2021 : Add momentum and air density ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -115,6 +116,8 @@ PROGRAM W3PREP ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! INAR2R Subr. W3ARRYMD Read in an REAL array. @@ -208,7 +211,7 @@ PROGRAM W3PREP USE W3ADATMD,ONLY: W3NAUX, W3SETA #endif USE W3ODATMD, ONLY: W3NOUT, W3SETO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -362,10 +365,11 @@ PROGRAM W3PREP #endif ! J = LEN_TRIM(FNMPRE) - OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_prep.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) + OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_prep.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PREP','INPUT',40) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! @@ -386,8 +390,9 @@ PROGRAM W3PREP ! 3.a Read types from input file. ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) IDFLD, IDTYPE, FLTIME, & + READ (NDSI,*,IOSTAT=IERR) IDFLD, IDTYPE, FLTIME, & FLHDR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) ! ! 3.b Check types. ! @@ -488,7 +493,8 @@ PROGRAM W3PREP ! IF (.NOT. FLTIME) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) TIME + READ (NDSI,*,IOSTAT=IERR) TIME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (TIME(1).LT.10000000) THEN WRITE (NDSE,1035) TIME CALL EXTCDE ( 4 ) @@ -534,8 +540,9 @@ PROGRAM W3PREP ELSE IF (ITYPE.EQ.2) THEN ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & X0I, XNI, NXI, Y0I, YNI, NYI + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (NXI.LT.2 .OR. NYI.LT.2) THEN WRITE (NDSE,1036) NXI, NYI CALL EXTCDE ( 5 ) @@ -556,8 +563,9 @@ PROGRAM W3PREP ! ELSE IF (ITYPE.EQ.5) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & DATTYP, RECLDT, NODATA + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (DATTYP.LT.0 .OR. DATTYP.GT.2) THEN WRITE (NDSE,1033) DATTYP CALL EXTCDE ( 6 ) @@ -751,8 +759,9 @@ PROGRAM W3PREP ! ... file info lat-long file ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & NXJ(J), NYJ(J), CLO(J) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (NXJ(J).LT.2 .OR. NYJ(J).LT.2) THEN WRITE (NDSE,1036) NXJ(J), NYJ(J) CALL EXTCDE ( 10 ) @@ -763,15 +772,17 @@ PROGRAM W3PREP WRITE (NDSO,944) NXJ(J), NYJ(J), CLO(J) ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & FROMLL, IDLALL, IDFMLL, FORMLL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (IDLALL.LT.1 .OR. IDLALL.GT.4) IDLALL = 1 IF (IDFMLL.LT.1 .OR. IDFMLL.GT.3) IDFMLL = 1 WRITE (NDSO,945) IDLALL, IDFMLL IF (IDFMLL.EQ.2) WRITE (NDSO,946) FORMLL ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, NAMELL + READ (NDSI,*,IOSTAT=IERR) NDSLL, NAMELL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) #ifdef W3_NCO NDSLL = 20 + NFCOMP #endif @@ -789,21 +800,21 @@ PROGRAM W3PREP JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & form='UNFORMATTED', convert=file_endian,STATUS='OLD', & - ERR=845,IOSTAT=IERR) + IOSTAT=IERR) ELSE OPEN (NDSLL, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=845,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROMLL.EQ.'NAME') THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & - STATUS='OLD',ERR=845,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE - OPEN (NDSLL, & - STATUS='OLD',ERR=845,IOSTAT=IERR) + OPEN (NDSLL,STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PREP','LAT-LONG DATA',47) ! END IF ! @@ -825,15 +836,17 @@ PROGRAM W3PREP WRITE (NDSO,949) ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & FROMLL, IDLALL, IDFMLL, FORMLL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (IDLALL.LT.1 .OR. IDLALL.GT.4) IDLALL = 1 IF (IDFMLL.LT.1 .OR. IDFMLL.GT.3) IDFMLL = 1 WRITE (NDSO,945) IDLALL, IDFMLL IF (IDFMLL.EQ.2) WRITE (NDSO,946) FORMLL ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, NAMELL + READ (NDSI,*,IOSTAT=IERR) NDSLL, NAMELL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) #ifdef W3_NCO NDSLL = 22 + NFCOMP #endif @@ -852,21 +865,21 @@ PROGRAM W3PREP JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & form='UNFORMATTED', convert=file_endian,STATUS='OLD', & - ERR=846,IOSTAT=IERR) + IOSTAT=IERR) ELSE OPEN (NDSLL,form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=846,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROMLL.EQ.'NAME') THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & - STATUS='OLD',ERR=846,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE - OPEN (NDSLL, & - STATUS='OLD',ERR=846,IOSTAT=IERR) + OPEN (NDSLL,STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PREP','MASK',48) ! END IF ! @@ -942,8 +955,9 @@ PROGRAM W3PREP END IF ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & FROMF, IDLAF(J), IDFMF(J), FORMT(J), FORMF(J) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) IF (IDLAF(J).LT.1 .OR. IDLAF(J).GT.4) IDLAF(J) = 1 IF (IDFMF(J).LT.1 .OR. IDFMF(J).GT.3) IDFMF(J) = 1 IF ( ITYPE .NE. 5 ) WRITE (NDSO,963) IDLAF(J) @@ -951,7 +965,8 @@ PROGRAM W3PREP IF (IDFMF(J).EQ.2) WRITE (NDSO,965) FORMT(J), FORMF(J) ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NDSF(J), NAMEF + READ (NDSI,*,IOSTAT=IERR) NDSF(J), NAMEF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PREP','INPUT',41) #ifdef W3_NCO NDSF(J) = 24 + NFCOMP #endif @@ -972,18 +987,19 @@ PROGRAM W3PREP IF (FROMF.EQ.'NAME') THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSF(J),FILE=FNMPRE(:JJ)//NAMEF, & - form='UNFORMATTED', convert=file_endian,STATUS='OLD',ERR=850, & + form='UNFORMATTED', convert=file_endian,STATUS='OLD', & IOSTAT=IERR) ELSE - OPEN (NDSF(J),form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=850,IOSTAT=IERR) + OPEN (NDSF(J),form='UNFORMATTED', convert=file_endian, & + STATUS='OLD',IOSTAT=IERR) END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PREP','INPUT DATA',49, & + NDSF(J),NAMEF) ! ! Adding a check to see if input file is a WAVEWATCH III file ! (This check has only been added for binary wind files) ! - READ (NDSF(J),END=888,IOSTAT=IERR) TSTR, & - TSFLD, NXT, NYT + READ (NDSF(J),IOSTAT=IERR) TSTR, TSFLD, NXT, NYT IF (IERR .EQ. 0 .AND. TSTR .EQ. IDSTR) THEN IF (TSFLD .NE. IDFLD .OR. NXT .NE. NXI & .OR. NYT .NE. NYI ) THEN @@ -991,6 +1007,8 @@ PROGRAM W3PREP NXI, NYI CALL EXTCDE ( 21 ) END IF + ELSE IF (IERR.LT.0) THEN + EXIT ELSE REWIND(NDSF(J)) END IF @@ -1002,10 +1020,12 @@ PROGRAM W3PREP IF (FROMF.EQ.'NAME') THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSF(J),FILE=FNMPRE(:JJ)//NAMEF, & - STATUS='OLD',ERR=850,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE - OPEN (NDSF(J),STATUS='OLD',ERR=850,IOSTAT=IERR) + OPEN (NDSF(J),STATUS='OLD',IOSTAT=IERR) END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PREP','INPUT DATA',49, & + NDSF(J),NAMEF) END IF END IF ! @@ -1053,8 +1073,11 @@ PROGRAM W3PREP ! #ifdef W3_O15 J = LEN_TRIM(FNMPRE) - OPEN (NDSTIME,FILE=FNMPRE(:J)//'times.'//IDFLD, & - ERR=870,IOSTAT=IERR ) + OPEN (NDSTIME,FILE=FNMPRE(:J)//'times.'//IDFLD,IOSTAT=IERR ) + IF (IERR.NE.0) THEN + WRITE (NDSE,1070) IDFLD, IERR + CALL EXTCDE ( 54 ) + END IF #endif ! WRITE (NDSO,972) @@ -1066,23 +1089,38 @@ PROGRAM W3PREP ! J = 1 IF (IDFMF(J).EQ.1) THEN - READ (NDSF(J), * ,END=888,ERR=860,IOSTAT=IERR) TIME + READ (NDSF(J), * ,IOSTAT=IERR) TIME ELSE IF (IDFMF(J).EQ.2) THEN - READ (NDSF(J),FORMT(J),END=888,ERR=860,IOSTAT=IERR) TIME + READ (NDSF(J),FORMT(J),IOSTAT=IERR) TIME ELSE - READ (NDSF(J), END=888,ERR=860,IOSTAT=IERR) TIME + READ (NDSF(J), IOSTAT=IERR) TIME + END IF + IF (IERR.LT.0) THEN + EXIT + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1060) J, IERR + CALL EXTCDE ( 50 ) END IF ! <--- IF (NFCOMP.EQ.2) THEN J = 2 IF (IDFMF(J).EQ.1) THEN - READ (NDSF(J), * ,END=888,ERR=860,IOSTAT=IERR) TIME2 + READ (NDSF(J), * ,IOSTAT=IERR) TIME2 ELSE IF (IDFMF(J).EQ.2) THEN - READ (NDSF(J),FORMT(J),END=888,ERR=860,IOSTAT=IERR) TIME2 + READ (NDSF(J),FORMT(J),IOSTAT=IERR) TIME2 ELSE - READ (NDSF(J), END=888,ERR=860,IOSTAT=IERR) TIME2 + READ (NDSF(J), IOSTAT=IERR) TIME2 + END IF + IF (IERR.LT.0) THEN + EXIT + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1060) J, IERR + CALL EXTCDE ( 50 ) + END IF + IF (TIME2(1).NE.TIME(1) .OR. TIME2(2).NE.TIME(2)) THEN + WRITE (NDSE,1061) TIME, TIME2 + CALL EXTCDE ( 51 ) END IF - IF (TIME2(1).NE.TIME(1) .OR. TIME2(2).NE.TIME(2)) GOTO 861 END IF ! <--- END IF @@ -1090,7 +1128,11 @@ PROGRAM W3PREP CALL STME21 ( TIME , IDTIME ) WRITE (NDSO,973) IDTIME #ifdef W3_O15 - WRITE (NDSTIME, 979, ERR=871,IOSTAT=IERR) TIME + WRITE (NDSTIME, 979,IOSTAT=IERR) TIME + IF (IERR.GT.0) THEN + WRITE (NDSE,1071) IDTIME, IERR + CALL EXTCDE ( 54 ) + END IF #endif #ifdef W3_O3 WRITE (NDSO,974) @@ -1168,9 +1210,13 @@ PROGRAM W3PREP ELSE ! IF (IDFMF(1).EQ.3) THEN - READ (NDSF(1), END=862,ERR=862,IOSTAT=IERR) NDAT + READ (NDSF(1), IOSTAT=IERR) NDAT ELSE - READ (NDSF(1),*,END=862,ERR=862,IOSTAT=IERR) NDAT + READ (NDSF(1),*,IOSTAT=IERR) NDAT + END IF + IF (IERR.NE.0) THEN + WRITE (NDSE,1062) IERR + CALL EXTCDE ( 52 ) END IF #ifdef W3_O3 WRITE (NDSO,975) NDAT @@ -1179,14 +1225,15 @@ PROGRAM W3PREP ALLOCATE ( DATA(RECLDT,NDAT) ) DO IDAT=1, NDAT IF (IDFMF(1).EQ.1) THEN - READ (NDSF(1), * ,END=863,ERR=863, & - IOSTAT=IERR) DATA(:,IDAT) + READ (NDSF(1), * ,IOSTAT=IERR) DATA(:,IDAT) ELSE IF (IDFMF(1).EQ.2) THEN - READ (NDSF(1),FORMT(1),END=863,ERR=863, & - IOSTAT=IERR) DATA(:,IDAT) + READ (NDSF(1),FORMT(1),IOSTAT=IERR) DATA(:,IDAT) ELSE - READ (NDSF(1), END=863,ERR=863, & - IOSTAT=IERR) DATA(:,IDAT) + READ (NDSF(1), IOSTAT=IERR) DATA(:,IDAT) + END IF + IF (IERR.NE.0) THEN + WRITE (NDSE,1063) IDAT, IERR + CALL EXTCDE ( 53 ) END IF END DO END IF @@ -1489,69 +1536,8 @@ PROGRAM W3PREP ! End loop over input fields !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! - GOTO 888 - ! - ! Error escape locations - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 41 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 42 ) - ! -845 CONTINUE - WRITE (NDSE,1045) IERR - CALL EXTCDE ( 47 ) - ! -846 CONTINUE - WRITE (NDSE,1046) IERR - CALL EXTCDE ( 48 ) - ! -850 CONTINUE - WRITE (NDSE,1050) IERR, NDSF(J), NAMEF - CALL EXTCDE ( 49 ) - ! -860 CONTINUE - WRITE (NDSE,1060) J, IERR - CALL EXTCDE ( 50 ) - ! -861 CONTINUE - WRITE (NDSE,1061) TIME, TIME2 - CALL EXTCDE ( 51 ) - ! -862 CONTINUE - WRITE (NDSE,1062) IERR - CALL EXTCDE ( 52 ) - ! -863 CONTINUE - WRITE (NDSE,1063) IDAT, IERR - CALL EXTCDE ( 53 ) - ! -#ifdef W3_O15 -870 CONTINUE - WRITE (NDSE,1070) IDFLD, IERR - CALL EXTCDE ( 54 ) -#endif - ! -#ifdef W3_O15 -871 CONTINUE - WRITE (NDSE,1071) IDTIME, IERR - CALL EXTCDE ( 54 ) -#endif - ! -888 CONTINUE WRITE (NDSO,999) ! -#ifdef W3_NCO - ! CALL W3TAGE('WAVEPREP') -#endif - ! ! Formats ! 900 FORMAT (/15X,' *** WAVEWATCH III Input pre-processing *** '/ & @@ -1632,17 +1618,6 @@ PROGRAM W3PREP ' ========================================='/ & ' WAVEWATCH III Input preprocessing '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & ' ILLEGAL FIELD ID -->',A,'<--'/) 1031 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & @@ -1670,21 +1645,6 @@ PROGRAM W3PREP 1044 FORMAT (/' *** WAVEWATCH III WARNING W3PREP : '/ & ' Y = ',F10.1,' NOT COVERED BY INPUT GRID.'/) ! - - ! -1045 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & - ' ERROR IN OPENING LAT-LONG DATA FILE'/ & - ' IOSTAT =',I5/) - ! -1046 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & - ' ERROR IN OPENING MASK FILE'/ & - ' IOSTAT =',I5/) - ! -1050 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & - ' ERROR IN OPENING INPUT DATA FILE'/ & - ' IOSTAT =',I5/ & - ' NDSF =',I5/ & - ' NAMEF = ',A/) 1051 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ & ' CANNOT READ UNFORMATTED FROM UNIT',I3/) ! diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index e107a1f431..922e6a1e54 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -46,6 +46,7 @@ PROGRAM W3PRNC !/ 21-Apr-2020 : Correction in MPI for tide ( version 7.13 ) !/ 21-Apr-2020 : Correction in scale factor ( version 7.13 ) !/ 22-Mar-2021 : Add momentum and air density ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -111,6 +112,8 @@ PROGRAM W3PRNC ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! INAR2R Subr. W3ARRYMD Read in an REAL array. @@ -201,7 +204,7 @@ PROGRAM W3PRNC #endif USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, STRSPLIT + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF, STRSPLIT #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -554,7 +557,8 @@ PROGRAM W3PRNC IFLD = 7 NFIELDS = 1 ELSE - GOTO 810 + WRITE (NDSE,1010) + CALL EXTCDE ( 1010 ) END IF ! NML_FORCING ! Check grid asis/latlon @@ -563,7 +567,8 @@ PROGRAM W3PRNC ELSE IF (NML_FORCING%GRID%LATLON) THEN ITYPE = 2 ELSE - GOTO 811 + WRITE (NDSE,1011) + CALL EXTCDE ( 1011 ) END IF ! Check tidal component @@ -611,14 +616,17 @@ PROGRAM W3PRNC ! process old ww3_prnc.inp format ! IF (.NOT. FLGNML) THEN - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_prnc.inp',STATUS='OLD',ERR=800,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_prnc.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PRNC','INPUT',40) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) IF (COMSTR.EQ.' ') COMSTR = '$' IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,901) COMSTR CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) IDFLD, IDTYPE, FLTIME, FLHDR + READ (NDSI,*,IOSTAT=IERR) IDFLD, IDTYPE, FLTIME, FLHDR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) ! Check field FLSTAB = IDFLD .EQ. 'WNS' @@ -669,7 +677,14 @@ PROGRAM W3PRNC ITYPE = 6 TIDEFLAG= 1 CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,'(A)',END=801,ERR=803,IOSTAT=IERR) TIDECONSTNAMES + READ (NDSI,'(A)',IOSTAT=IERR) TIDECONSTNAMES + IF (IERR.LT.0) THEN + WRITE (NDSE,1001) + CALL EXTCDE ( 41 ) + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1003) IERR + CALL EXTCDE ( 43 ) + END IF LIST(:)='' CALL STRSPLIT(TIDECONSTNAMES,LIST) ELSE IF (IDTYPE.EQ.'LL') THEN @@ -685,7 +700,8 @@ PROGRAM W3PRNC END IF ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) STRDIMSNAME + READ (NDSI,'(A)',IOSTAT=IERR) STRDIMSNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) ! FIELDSNAME(:)='' DIMSNAME(:)='' @@ -697,7 +713,8 @@ PROGRAM W3PRNC END DO ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) STRFIELDSNAME + READ (NDSI,'(A)',IOSTAT=IERR) STRFIELDSNAME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) ! FIELDSNAME(:)='' CALL STRSPLIT(STRFIELDSNAME,FIELDSNAME) @@ -709,7 +726,8 @@ PROGRAM W3PRNC ! time flag and start date IF (.NOT. FLTIME) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) TIMESHIFT + READ (NDSI,*,IOSTAT=IERR) TIMESHIFT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) IF (TIMESHIFT(1).LT.10000000) THEN WRITE (NDSE,1035) TIME CALL EXTCDE ( 35 ) @@ -717,7 +735,8 @@ PROGRAM W3PRNC END IF ! Read netcdf filename CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NAMEF + READ (NDSI,*,IOSTAT=IERR) NAMEF + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) ! initialize timestart and timestop STARTJULDAY=0 @@ -859,7 +878,10 @@ PROGRAM W3PRNC IF (DIMNAME(i) .EQ. DIMSNAME(2)) NYI = DIMLN(i) END IF END DO - IF (NXI*NYI.EQ.0) GOTO 864 + IF (NXI*NYI.EQ.0) THEN + WRITE (NDSE,1064) TRIM(STRDIMSNAME) + CALL EXTCDE ( 56 ) + END IF ! Set factor for deg/km IF ( FLAGLL ) THEN @@ -980,8 +1002,9 @@ PROGRAM W3PRNC ! ELSE IF (ITYPE.EQ.5) THEN CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & DATTYP, RECLDT, NODATA + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) IF (DATTYP.LT.0 .OR. DATTYP.GT.2) THEN WRITE (NDSE,1033) DATTYP CALL EXTCDE ( 33 ) @@ -1173,8 +1196,9 @@ PROGRAM W3PRNC ! ... file info lat-long file ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & NXJ(J), NYJ(J), CLO(J) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) IF (NXJ(J).LT.2 .OR. NYJ(J).LT.2) THEN WRITE (NDSE,1036) NXJ(J), NYJ(J) CALL EXTCDE ( 36 ) @@ -1185,15 +1209,17 @@ PROGRAM W3PRNC IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,944) NXJ(J), NYJ(J), CLO(J) ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & FROMLL, IDLALL, IDFMLL, FORMLL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) IF (IDLALL.LT.1 .OR. IDLALL.GT.4) IDLALL = 1 IF (IDFMLL.LT.1 .OR. IDFMLL.GT.3) IDFMLL = 1 IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,945) IDLALL, IDFMLL IF (IDFMLL.EQ.2) WRITE (NDSO,946) FORMLL ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, NAMELL + READ (NDSI,*,IOSTAT=IERR) NDSLL, NAMELL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) #ifdef W3_NCO NDSLL = 20 + NFCOMP #endif @@ -1211,21 +1237,22 @@ PROGRAM W3PRNC JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & form='UNFORMATTED', convert=file_endian,STATUS='OLD', & - ERR=845,IOSTAT=IERR) + IOSTAT=IERR) ELSE OPEN (NDSLL, form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=845,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROMLL.EQ.'NAME') THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & - STATUS='OLD',ERR=845,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSLL, & - STATUS='OLD',ERR=845,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PRNC','LAT-LONG DATA', 49) ! END IF ! @@ -1248,15 +1275,17 @@ PROGRAM W3PRNC IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,949) ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) & + READ (NDSI,*,IOSTAT=IERR) & FROMLL, IDLALL, IDFMLL, FORMLL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) IF (IDLALL.LT.1 .OR. IDLALL.GT.4) IDLALL = 1 IF (IDFMLL.LT.1 .OR. IDFMLL.GT.3) IDFMLL = 1 IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,945) IDLALL, IDFMLL IF (IDFMLL.EQ.2) WRITE (NDSO,946) FORMLL ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, NAMELL + READ (NDSI,*,IOSTAT=IERR) NDSLL, NAMELL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRNC','INPUT',41) #ifdef W3_NCO NDSLL = 22 + NFCOMP #endif @@ -1275,21 +1304,22 @@ PROGRAM W3PRNC JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & form='UNFORMATTED', convert=file_endian,STATUS='OLD', & - ERR=846,IOSTAT=IERR) + IOSTAT=IERR) ELSE OPEN (NDSLL,form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=846,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF ELSE IF (FROMLL.EQ.'NAME') THEN JJ = LEN_TRIM(FNMPRE) OPEN (NDSLL,FILE=FNMPRE(:JJ)//NAMELL, & - STATUS='OLD',ERR=846,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) ELSE OPEN (NDSLL, & - STATUS='OLD',ERR=846,IOSTAT=IERR) + STATUS='OLD',IOSTAT=IERR) END IF END IF + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PRNC','MASK',50) ! END IF ! @@ -1748,7 +1778,8 @@ PROGRAM W3PRNC #ifdef W3_MPI IF (IAPROC .NE. NAPOUT ) THEN - GOTO 888 + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,999) + CALL MPI_FINALIZE ( IERR_MPI ) #endif #ifdef W3_MPIT ELSE @@ -1779,176 +1810,148 @@ PROGRAM W3PRNC CALL W3FLDTIDE1 ( 'WRITE', NDSDAT, NDST, NDSE, NX, NY, IDFLD, IERR ) CALL W3FLDTIDE2 ( 'WRITE', NDSDAT, NDST, NDSE, NX, NY, IDFLD, 0, IERR ) ! - GOTO 880 - - END IF ! end of test IF (ITYPE.GE.6.AND.TIDEFLAG.GT.0) - - ! - !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 8 Begin loop over input fields - ! - ! Read scale factor and offset for input fields - XCFAC = 1.0 - YCFAC = 1.0 - XCOFF = 0.0 - YCOFF = 0.0 - ! - IF ( ITYPE .LE. 4 .OR. ITYPE.EQ.6 ) THEN - IRET = NF90_GET_ATT(NCID,VARIDF(1),'scale_factor',XCFAC) - IF (IRET.NE.0 ) XCFAC = 1.0 - IRET = NF90_GET_ATT(NCID,VARIDF(1),'add_offset',XCOFF) - IF (IRET.NE.0 ) XCOFF = 0.0 - IF ( NFCOMP.EQ.2 .OR. (IFLD.GE.3 .AND. IFLD.NE.7) .OR. FLBERG ) THEN - IRET = NF90_GET_ATT(NCID,VARIDF(2),'scale_factor',YCFAC) - IF (IRET.NE.0 ) YCFAC = 1.0 - IRET = NF90_GET_ATT(NCID,VARIDF(2),'add_offset',YCOFF) - IF (IRET.NE.0 ) YCOFF = 0.0 + ELSE + ! + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! 8 Begin loop over input fields + ! + ! Read scale factor and offset for input fields + XCFAC = 1.0 + YCFAC = 1.0 + XCOFF = 0.0 + YCOFF = 0.0 + ! + IF ( ITYPE .LE. 4 .OR. ITYPE.EQ.6 ) THEN + IRET = NF90_GET_ATT(NCID,VARIDF(1),'scale_factor',XCFAC) + IF (IRET.NE.0 ) XCFAC = 1.0 + IRET = NF90_GET_ATT(NCID,VARIDF(1),'add_offset',XCOFF) + IF (IRET.NE.0 ) XCOFF = 0.0 + IF ( NFCOMP.EQ.2 .OR. (IFLD.GE.3 .AND. IFLD.NE.7) .OR. FLBERG ) THEN + IRET = NF90_GET_ATT(NCID,VARIDF(2),'scale_factor',YCFAC) + IF (IRET.NE.0 ) YCFAC = 1.0 + IRET = NF90_GET_ATT(NCID,VARIDF(2),'add_offset',YCOFF) + IF (IRET.NE.0 ) YCOFF = 0.0 + END IF END IF - END IF - ! + ! #ifdef W3_O15 - J = LEN_TRIM(FNMPRE) - OPEN (NDSTIME,FILE=FNMPRE(:J)//'times.'//IDFLD, & - ERR=870,IOSTAT=IERR ) + J = LEN_TRIM(FNMPRE) + OPEN (NDSTIME,FILE=FNMPRE(:J)//'times.'//IDFLD,IOSTAT=IERR ) + IF (IERR.NE.0) THEN + WRITE (NDSE,1070) IDFLD, IERR + CALL EXTCDE ( 57 ) + END IF #endif - ! - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,972) - TIMEDELAY = 0 - DO ITIME=1,NTI - ! - ! 8.a Read new time and fields ! - IRET=NF90_INQ_VARID(NCID,"time",VARIDTMP) - IF ( IRET/=NF90_NOERR ) IRET=NF90_INQ_VARID(NCID,"MT",VARIDTMP) - CALL CHECK_ERR(IRET) - IRET=NF90_GET_VAR(NCID,VARIDTMP,CURJULDAY,start=(/ITIME/)) - call CHECK_ERR(IRET) - IF (INDEX(TIMEUNITS, "seconds").NE.0) CURJULDAY=CURJULDAY/86400. - IF (INDEX(TIMEUNITS, "minutes").NE.0) CURJULDAY=CURJULDAY/1440. - IF (INDEX(TIMEUNITS, "hours").NE.0) CURJULDAY=CURJULDAY/24. - CURJULDAY=REFJULDAY+CURJULDAY + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,972) + TIMEDELAY = 0 + DO ITIME=1,NTI + ! + ! 8.a Read new time and fields + ! + IRET=NF90_INQ_VARID(NCID,"time",VARIDTMP) + IF ( IRET/=NF90_NOERR ) IRET=NF90_INQ_VARID(NCID,"MT",VARIDTMP) + CALL CHECK_ERR(IRET) + IRET=NF90_GET_VAR(NCID,VARIDTMP,CURJULDAY,start=(/ITIME/)) + call CHECK_ERR(IRET) + IF (INDEX(TIMEUNITS, "seconds").NE.0) CURJULDAY=CURJULDAY/86400. + IF (INDEX(TIMEUNITS, "minutes").NE.0) CURJULDAY=CURJULDAY/1440. + IF (INDEX(TIMEUNITS, "hours").NE.0) CURJULDAY=CURJULDAY/24. + CURJULDAY=REFJULDAY+CURJULDAY - ! cycle until reaching the start time - IF (STARTJULDAY.GT.CURJULDAY) CYCLE + ! cycle until reaching the start time + IF (STARTJULDAY.GT.CURJULDAY) CYCLE - ! exit when reaching the stop time - IF (STPJULDAY.LT.CURJULDAY) EXIT + ! exit when reaching the stop time + IF (STPJULDAY.LT.CURJULDAY) EXIT - ! convert julday to date and time - CALL J2D(CURJULDAY,CURDATE,IERR) - CALL D2T(CURDATE,TIME,IERR) - CALL STME21 (TIME,IDTIME) + ! convert julday to date and time + CALL J2D(CURJULDAY,CURDATE,IERR) + CALL D2T(CURDATE,TIME,IERR) + CALL STME21 (TIME,IDTIME) - ! define time delay - IF (.NOT.FLTIME.AND.TIMEDELAY.EQ.0) THEN - TIMEDELAY = DSEC21 (TIME,TIMESHIFT) - END IF + ! define time delay + IF (.NOT.FLTIME.AND.TIMEDELAY.EQ.0) THEN + TIMEDELAY = DSEC21 (TIME,TIMESHIFT) + END IF - ! shift time - IF (TIMEDELAY.NE.0) THEN - CALL TICK21 (TIME,TIMEDELAY) - CALL STME21 (TIME,IDTIME2) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1973) IDTIME2, IDTIME - ELSE - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2973) IDTIME - END IF + ! shift time + IF (TIMEDELAY.NE.0) THEN + CALL TICK21 (TIME,TIMEDELAY) + CALL STME21 (TIME,IDTIME2) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,1973) IDTIME2, IDTIME + ELSE + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,2973) IDTIME + END IF #ifdef W3_O15 - WRITE (NDSTIME, 979, ERR=871,IOSTAT=IERR) TIME + WRITE (NDSTIME, 979, IOSTAT=IERR) TIME + IF (IERR.NE.0) THEN + WRITE (NDSE,1071) IDTIME, IERR + CALL EXTCDE ( 58 ) + END IF #endif #ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,974) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,974) #endif - ! - ! ... Input - ! - IF ( ITYPE .LE. 4 .OR. ITYPE.EQ.6 ) THEN - IF (NDIMSGRID.EQ.1) THEN - IRET=NF90_GET_VAR(NCID,VARIDF(1),XC(:,1),start=(/1,ITIME/),count=(/MXM,1/)) - ELSE - IF (NDIMSVAR.EQ.3) THEN - IRET=NF90_GET_VAR(NCID,VARIDF(1),XC,start=(/1,1,ITIME/),count=(/MXM,MYM,1/)) - ELSE - IRET=NF90_GET_VAR(NCID,VARIDF(1),XC,start=(/1,1,1,ITIME/),count=(/MXM,MYM,1,1/)) - END IF - END IF - CALL CHECK_ERR(IRET) - ! forces undefined values to FILLVALUE - WHERE(XC.NE.XC) XC = FILLVALUE - WHERE (XC.NE.FILLVALUE) XC=XC*XCFAC+XCOFF - ! -#ifdef W3_T2 - WRITE (NDST,9060) 1 - IXP0 = 1 - IXPN = MIN ( IXP0+IXPWDT-1 , NXJ(1) ) - DO - CALL PRTBLK ( NDST, NXJ(1), NYJ(1), MXM, XC, MASK, 0, 0.,& - IXP0, IXPN, 1, 1, NYJ(1), 1, 'Field 1', ' ') - IF (IXPN.NE.NXJ(1)) THEN - IXP0 = IXP0 + IXPWDT - IXPN = MIN ( IXPN+IXPWDT , NXJ(1) ) - ELSE - EXIT - END IF - END DO -#endif + ! ... Input ! - IF (NFCOMP.EQ.2 .OR. (IFLD.GE.3 .AND. IFLD.NE.7) .OR. FLBERG) THEN - - ! This is a quick fix that works if the lon,lat,level,time dimensions are in that order - ! otherwise, one should check the length of each dimension ... + IF ( ITYPE .LE. 4 .OR. ITYPE.EQ.6 ) THEN IF (NDIMSGRID.EQ.1) THEN - IRET=NF90_GET_VAR(NCID,VARIDF(2),YC(:,1),start=(/1,ITIME/),count=(/MXM,1/)) + IRET=NF90_GET_VAR(NCID,VARIDF(1),XC(:,1),start=(/1,ITIME/),count=(/MXM,1/)) ELSE IF (NDIMSVAR.EQ.3) THEN - IRET=NF90_GET_VAR(NCID,VARIDF(2),YC,start=(/1,1,ITIME/),count=(/MXM,MYM,1/)) + IRET=NF90_GET_VAR(NCID,VARIDF(1),XC,start=(/1,1,ITIME/),count=(/MXM,MYM,1/)) ELSE - IRET=NF90_GET_VAR(NCID,VARIDF(2),YC,start=(/1,1,1,ITIME/),count=(/MXM,MYM,1,1/)) + IRET=NF90_GET_VAR(NCID,VARIDF(1),XC,start=(/1,1,1,ITIME/),count=(/MXM,MYM,1,1/)) END IF END IF - ! The following line forces to 0 values that are undefine CALL CHECK_ERR(IRET) - WHERE(YC.NE.YC) YC = FILLVALUE - WHERE (YC.NE.FILLVALUE) YC=YC*YCFAC+YCOFF + ! forces undefined values to FILLVALUE + WHERE(XC.NE.XC) XC = FILLVALUE + WHERE (XC.NE.FILLVALUE) XC=XC*XCFAC+XCOFF ! #ifdef W3_T2 - WRITE (NDST,9060) 2 + WRITE (NDST,9060) 1 IXP0 = 1 - IXPN = MIN ( IXP0+IXPWDT-1 , NXJ(2) ) + IXPN = MIN ( IXP0+IXPWDT-1 , NXJ(1) ) DO - CALL PRTBLK ( NDST, NXJ(2), NYJ(2), MXM, YC, MASK, 0, 0., & - IXP0, IXPN, 1, 1, NYJ(2), 1, 'Field 2', ' ') - IF (IXPN.NE.NXJ(2)) THEN + CALL PRTBLK ( NDST, NXJ(1), NYJ(1), MXM, XC, MASK, 0, 0.,& + IXP0, IXPN, 1, 1, NYJ(1), 1, 'Field 1', ' ') + IF (IXPN.NE.NXJ(1)) THEN IXP0 = IXP0 + IXPWDT - IXPN = MIN ( IXPN+IXPWDT , NXJ(2) ) + IXPN = MIN ( IXPN+IXPWDT , NXJ(1) ) ELSE EXIT END IF END DO #endif ! - IF (FLSTAB) THEN + IF (NFCOMP.EQ.2 .OR. (IFLD.GE.3 .AND. IFLD.NE.7) .OR. FLBERG) THEN + ! This is a quick fix that works if the lon,lat,level,time dimensions are in that order ! otherwise, one should check the length of each dimension ... IF (NDIMSGRID.EQ.1) THEN - IRET=NF90_GET_VAR(NCID,VARIDF(3),AC(:,1),start=(/1,ITIME/),count=(/MXM,1/)) + IRET=NF90_GET_VAR(NCID,VARIDF(2),YC(:,1),start=(/1,ITIME/),count=(/MXM,1/)) ELSE IF (NDIMSVAR.EQ.3) THEN - IRET=NF90_GET_VAR(NCID,VARIDF(3),AC,start=(/1,1,ITIME/),count=(/MXM,MYM,1/)) + IRET=NF90_GET_VAR(NCID,VARIDF(2),YC,start=(/1,1,ITIME/),count=(/MXM,MYM,1/)) ELSE - IRET=NF90_GET_VAR(NCID,VARIDF(3),AC,start=(/1,1,1,ITIME/),count=(/MXM,MYM,1,1/)) + IRET=NF90_GET_VAR(NCID,VARIDF(2),YC,start=(/1,1,1,ITIME/),count=(/MXM,MYM,1,1/)) END IF END IF + ! The following line forces to 0 values that are undefine CALL CHECK_ERR(IRET) - !AC(:,:)=AC(:,MYM:1:-1) + WHERE(YC.NE.YC) YC = FILLVALUE + WHERE (YC.NE.FILLVALUE) YC=YC*YCFAC+YCOFF ! #ifdef W3_T2 - WRITE (NDST,9060) 3 + WRITE (NDST,9060) 2 IXP0 = 1 IXPN = MIN ( IXP0+IXPWDT-1 , NXJ(2) ) DO - CALL PRTBLK ( NDST, NXJ(2), NYJ(2), MXM, AC, MASK, 0,& - 0., IXP0, IXPN, 1,1, NYJ(2), 1, 'Field 3', ' ') + CALL PRTBLK ( NDST, NXJ(2), NYJ(2), MXM, YC, MASK, 0, 0., & + IXP0, IXPN, 1, 1, NYJ(2), 1, 'Field 2', ' ') IF (IXPN.NE.NXJ(2)) THEN IXP0 = IXP0 + IXPWDT IXPN = MIN ( IXPN+IXPWDT , NXJ(2) ) @@ -1958,367 +1961,337 @@ PROGRAM W3PRNC END DO #endif ! + IF (FLSTAB) THEN + ! This is a quick fix that works if the lon,lat,level,time dimensions are in that order + ! otherwise, one should check the length of each dimension ... + IF (NDIMSGRID.EQ.1) THEN + IRET=NF90_GET_VAR(NCID,VARIDF(3),AC(:,1),start=(/1,ITIME/),count=(/MXM,1/)) + ELSE + IF (NDIMSVAR.EQ.3) THEN + IRET=NF90_GET_VAR(NCID,VARIDF(3),AC,start=(/1,1,ITIME/),count=(/MXM,MYM,1/)) + ELSE + IRET=NF90_GET_VAR(NCID,VARIDF(3),AC,start=(/1,1,1,ITIME/),count=(/MXM,MYM,1,1/)) + END IF + END IF + CALL CHECK_ERR(IRET) + !AC(:,:)=AC(:,MYM:1:-1) + ! +#ifdef W3_T2 + WRITE (NDST,9060) 3 + IXP0 = 1 + IXPN = MIN ( IXP0+IXPWDT-1 , NXJ(2) ) + DO + CALL PRTBLK ( NDST, NXJ(2), NYJ(2), MXM, AC, MASK, 0,& + 0., IXP0, IXPN, 1,1, NYJ(2), 1, 'Field 3', ' ') + IF (IXPN.NE.NXJ(2)) THEN + IXP0 = IXP0 + IXPWDT + IXPN = MIN ( IXPN+IXPWDT , NXJ(2) ) + ELSE + EXIT + END IF + END DO +#endif + ! + END IF + ! END IF - ! - END IF - ELSE ! ITYPE .NE. 5 - ! - IF ( IAPROC .EQ. NAPOUT ) WRITE(NDSO,*) "ITYPE5 TO DO" - IF (IDFMF(1).EQ.3) THEN - READ (NDSF(1), END=862,ERR=862,IOSTAT=IERR) NDAT - ELSE - READ (NDSF(1),*,END=862,ERR=862,IOSTAT=IERR) NDAT - END IF + ELSE ! ITYPE .NE. 5 + ! + IF ( IAPROC .EQ. NAPOUT ) WRITE(NDSO,*) "ITYPE5 TO DO" + IF (IDFMF(1).EQ.3) THEN + READ (NDSF(1), IOSTAT=IERR) NDAT + ELSE + READ (NDSF(1),*,IOSTAT=IERR) NDAT + END IF + IF (IERR.NE.0) THEN + WRITE (NDSE,1062) IERR + CALL EXTCDE ( 54 ) + END IF #ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,975) NDAT -#endif - IF ( NDAT.GT.0 ) THEN - ALLOCATE ( DATA(RECLDT,NDAT) ) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,975) NDAT +#endif + IF ( NDAT.GT.0 ) THEN + ALLOCATE ( DATA(RECLDT,NDAT) ) + DO IDAT=1, NDAT + IF (IDFMF(1).EQ.1) THEN + READ (NDSF(1), *, IOSTAT=IERR) DATA(:,IDAT) + ELSE IF (IDFMF(1).EQ.2) THEN + READ (NDSF(1),FORMT(1), IOSTAT=IERR) DATA(:,IDAT) + ELSE + READ (NDSF(1), IOSTAT=IERR) DATA(:,IDAT) + END IF + IF (IERR.NE.0) THEN + WRITE (NDSE,1063) IDAT, IERR + CALL EXTCDE ( 55 ) + END IF + END DO + END IF + ! +#ifdef W3_T2 + WRITE (NDST,9061) DO IDAT=1, NDAT - IF (IDFMF(1).EQ.1) THEN - READ (NDSF(1), * ,END=863,ERR=863, & - IOSTAT=IERR) DATA(:,IDAT) - ELSE IF (IDFMF(1).EQ.2) THEN - READ (NDSF(1),FORMT(1),END=863,ERR=863, & - IOSTAT=IERR) DATA(:,IDAT) - ELSE - READ (NDSF(1), END=863,ERR=863, & - IOSTAT=IERR) DATA(:,IDAT) - END IF + IX = MIN(6,RECLDT) + WRITE (NDST,9062) IDAT, DATA(1:IX,IDAT) + IF ( IX.LT.RECLDT ) WRITE (NDST,9063) DATA(IX+1:,:) END DO +#endif + ! END IF ! -#ifdef W3_T2 - WRITE (NDST,9061) - DO IDAT=1, NDAT - IX = MIN(6,RECLDT) - WRITE (NDST,9062) IDAT, DATA(1:IX,IDAT) - IF ( IX.LT.RECLDT ) WRITE (NDST,9063) DATA(IX+1:,:) - END DO -#endif + ! 8.b Interpolate fields + ! ... No Interpolation, type AI (should not use array syntax !!!) ! - END IF - ! - ! 8.b Interpolate fields - ! ... No Interpolation, type AI (should not use array syntax !!!) - ! - IF (ITYPE.EQ.1.OR.ITYPE.EQ.6) THEN - ! - ! change fillvalue - DO IY=1,NY - DO IX=1,NX - IF (XC(IX,IY) .EQ. FILLVALUE) XC(IX,IY)=0 - IF (YC(IX,IY) .EQ. FILLVALUE) YC(IX,IY)=0 + IF (ITYPE.EQ.1.OR.ITYPE.EQ.6) THEN + ! + ! change fillvalue + DO IY=1,NY + DO IX=1,NX + IF (XC(IX,IY) .EQ. FILLVALUE) XC(IX,IY)=0 + IF (YC(IX,IY) .EQ. FILLVALUE) YC(IX,IY)=0 + END DO END DO - END DO - IF (( IFLD.LE.2 .OR. IFLD.EQ.7 ).AND.( .NOT. FLBERG )) THEN - DO IY=1, NY - DO IX=1, NX - FA(IX,IY) = XC(IX,IY) + IF (( IFLD.LE.2 .OR. IFLD.EQ.7 ).AND.( .NOT. FLBERG )) THEN + DO IY=1, NY + DO IX=1, NX + FA(IX,IY) = XC(IX,IY) + END DO END DO - END DO - ELSE - DO IY=1, NY - DO IX=1, NX - FX(IX,IY) = XC(IX,IY) - FY(IX,IY) = YC(IX,IY) - FA(IX,IY) = AC(IX,IY) + ELSE + DO IY=1, NY + DO IX=1, NX + FX(IX,IY) = XC(IX,IY) + FY(IX,IY) = YC(IX,IY) + FA(IX,IY) = AC(IX,IY) + END DO END DO - END DO - END IF - ! - ELSE IF (ITYPE.NE.5) THEN - ! - ! ... One-component fields - ! -#ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,976) ' ' -#endif - IF (( IFLD.LE.2 .OR. IFLD.EQ.7 ).AND.( .NOT. FLBERG )) THEN - ! - CALL INTERP(MXM, MYM, XC, IX21, IX22, IY21, IY22, & - RD11, RD12, RD21, RD22, FILLVALUE, FA) - ! - IF (NFCOMP.EQ.2) THEN -#ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,976) ' (2) ' -#endif - CALL INTERP(MXM, MYM, YC, JX21, JX22, JY21, JY22, & - XD11, XD12, XD21, XD22, FILLVALUE, FA) END IF ! - ! ... Two-component fields + ELSE IF (ITYPE.NE.5) THEN ! - ELSE !so if IFLD.GT.2 + ! ... One-component fields ! - CALL INTERP(MXM, MYM, XC, IX21, IX22, IY21, IY22, & - RD11, RD12, RD21, RD22, FILLVALUE, FX) - - CALL INTERP(MXM, MYM, YC, IX21, IX22, IY21, IY22, & - RD11, RD12, RD21, RD22, FILLVALUE, FY) - - IF(FLSTAB) THEN - ! AC only populated if FLSTAB is true - CALL INTERP(MXM, MYM, AC, IX21, IX22, IY21, IY22, & +#ifdef W3_O3 + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,976) ' ' +#endif + IF (( IFLD.LE.2 .OR. IFLD.EQ.7 ).AND.( .NOT. FLBERG )) THEN + ! + CALL INTERP(MXM, MYM, XC, IX21, IX22, IY21, IY22, & RD11, RD12, RD21, RD22, FILLVALUE, FA) - ENDIF - - WHERE ( XC.NE.FILLVALUE .AND. YC.NE.FILLVALUE) - XTEMP = XC*XC + YC*YC - ELSEWHERE - XTEMP = FILLVALUE - ENDWHERE - CALL INTERP(MXM, MYM, XTEMP, IX21, IX22, IY21, IY22, & - RD11, RD12, RD21, RD22, FILLVALUE, A3) - - WHERE ( XTEMP.NE.FILLVALUE ) - XTEMP = SQRT(XTEMP) - ENDWHERE - CALL INTERP(MXM, MYM, XTEMP, IX21, IX22, IY21, IY22, & - RD11, RD12, RD21, RD22, FILLVALUE, A2) - - DO IY=1,NY - DO IX=1,NX - A1(IX,IY) = MAX ( 1.E-10 , & - SQRT( FX(IX,IY)**2 + FY(IX,IY)**2 ) ) + ! + IF (NFCOMP.EQ.2) THEN +#ifdef W3_O3 + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,976) ' (2) ' +#endif + CALL INTERP(MXM, MYM, YC, JX21, JX22, JY21, JY22, & + XD11, XD12, XD21, XD22, FILLVALUE, FA) + END IF + ! + ! ... Two-component fields + ! + ELSE !so if IFLD.GT.2 + ! + CALL INTERP(MXM, MYM, XC, IX21, IX22, IY21, IY22, & + RD11, RD12, RD21, RD22, FILLVALUE, FX) + + CALL INTERP(MXM, MYM, YC, IX21, IX22, IY21, IY22, & + RD11, RD12, RD21, RD22, FILLVALUE, FY) + + IF(FLSTAB) THEN + ! AC only populated if FLSTAB is true + CALL INTERP(MXM, MYM, AC, IX21, IX22, IY21, IY22, & + RD11, RD12, RD21, RD22, FILLVALUE, FA) + ENDIF + + WHERE ( XC.NE.FILLVALUE .AND. YC.NE.FILLVALUE) + XTEMP = XC*XC + YC*YC + ELSEWHERE + XTEMP = FILLVALUE + ENDWHERE + CALL INTERP(MXM, MYM, XTEMP, IX21, IX22, IY21, IY22, & + RD11, RD12, RD21, RD22, FILLVALUE, A3) + + WHERE ( XTEMP.NE.FILLVALUE ) + XTEMP = SQRT(XTEMP) + ENDWHERE + CALL INTERP(MXM, MYM, XTEMP, IX21, IX22, IY21, IY22, & + RD11, RD12, RD21, RD22, FILLVALUE, A2) - A3(IX,IY) = SQRT( A3(IX,IY) ) - END DO - END DO - ! - ! ... Winds, correct for velocity or energy conservation - ! -#ifdef W3_WNT1 - IF (IFLD.EQ.3) THEN DO IY=1,NY DO IX=1,NX - FACTOR = MIN ( 1.5 , A2(IX,IY)/A1(IX,IY) ) - FX(IX,IY) = FACTOR * FX(IX,IY) - FY(IX,IY) = FACTOR * FY(IX,IY) + A1(IX,IY) = MAX ( 1.E-10 , & + SQRT( FX(IX,IY)**2 + FY(IX,IY)**2 ) ) + + A3(IX,IY) = SQRT( A3(IX,IY) ) END DO END DO - END IF + ! + ! ... Winds, correct for velocity or energy conservation + ! +#ifdef W3_WNT1 + IF (IFLD.EQ.3) THEN + DO IY=1,NY + DO IX=1,NX + FACTOR = MIN ( 1.5 , A2(IX,IY)/A1(IX,IY) ) + FX(IX,IY) = FACTOR * FX(IX,IY) + FY(IX,IY) = FACTOR * FY(IX,IY) + END DO + END DO + END IF #endif - ! + ! #ifdef W3_WNT2 - IF (IFLD.EQ.3) THEN - DO IY=1,NY - DO IX=1,NX - FACTOR = MIN ( 1.5 , A3(IX,IY)/A1(IX,IY) ) - FX(IX,IY) = FACTOR * FX(IX,IY) - FY(IX,IY) = FACTOR * FY(IX,IY) + IF (IFLD.EQ.3) THEN + DO IY=1,NY + DO IX=1,NX + FACTOR = MIN ( 1.5 , A3(IX,IY)/A1(IX,IY) ) + FX(IX,IY) = FACTOR * FX(IX,IY) + FY(IX,IY) = FACTOR * FY(IX,IY) + END DO END DO - END DO - END IF + END IF #endif - ! - ! ... Currents, correct for velocity or energy conservation - ! + ! + ! ... Currents, correct for velocity or energy conservation + ! #ifdef W3_CRT1 - IF (IFLD.EQ.4) THEN - DO IY=1,NY - DO IX=1,NX - FACTOR = MIN ( 1.5 , A2(IX,IY)/A1(IX,IY) ) - FX(IX,IY) = FACTOR * FX(IX,IY) - FY(IX,IY) = FACTOR * FY(IX,IY) + IF (IFLD.EQ.4) THEN + DO IY=1,NY + DO IX=1,NX + FACTOR = MIN ( 1.5 , A2(IX,IY)/A1(IX,IY) ) + FX(IX,IY) = FACTOR * FX(IX,IY) + FY(IX,IY) = FACTOR * FY(IX,IY) + END DO END DO - END DO - END IF + END IF #endif - ! + ! #ifdef W3_CRT2 - IF (IFLD.EQ.4) THEN - DO IY=1,NY - DO IX=1,NX - FACTOR = MIN ( 1.5 , A3(IX,IY)/A1(IX,IY) ) - FX(IX,IY) = FACTOR * FX(IX,IY) - FY(IX,IY) = FACTOR * FY(IX,IY) + IF (IFLD.EQ.4) THEN + DO IY=1,NY + DO IX=1,NX + FACTOR = MIN ( 1.5 , A3(IX,IY)/A1(IX,IY) ) + FX(IX,IY) = FACTOR * FX(IX,IY) + FY(IX,IY) = FACTOR * FY(IX,IY) + END DO END DO - END DO - END IF + END IF #endif - ! - ! ... Momentum, correct for velocity or energy conservation - ! + ! + ! ... Momentum, correct for velocity or energy conservation + ! #ifdef W3_WNT1 - IF (IFLD.EQ.6) THEN - DO IY=1,NY - DO IX=1,NX - FACTOR = MIN ( 1.5 , A2(IX,IY)/A1(IX,IY) ) - FX(IX,IY) = FACTOR * FX(IX,IY) - FY(IX,IY) = FACTOR * FY(IX,IY) + IF (IFLD.EQ.6) THEN + DO IY=1,NY + DO IX=1,NX + FACTOR = MIN ( 1.5 , A2(IX,IY)/A1(IX,IY) ) + FX(IX,IY) = FACTOR * FX(IX,IY) + FY(IX,IY) = FACTOR * FY(IX,IY) + END DO END DO - END DO - END IF + END IF #endif - ! + ! #ifdef W3_WNT2 - IF (IFLD.EQ.6) THEN - DO IY=1,NY - DO IX=1,NX - FACTOR = MIN ( 1.5 , A3(IX,IY)/A1(IX,IY) ) - FX(IX,IY) = FACTOR * FX(IX,IY) - FY(IX,IY) = FACTOR * FY(IX,IY) + IF (IFLD.EQ.6) THEN + DO IY=1,NY + DO IX=1,NX + FACTOR = MIN ( 1.5 , A3(IX,IY)/A1(IX,IY) ) + FX(IX,IY) = FACTOR * FX(IX,IY) + FY(IX,IY) = FACTOR * FY(IX,IY) + END DO END DO - END DO - END IF + END IF #endif + ! + END IF ! END IF ! - END IF - ! - ! ... Test output - ! + ! ... Test output + ! #ifdef W3_T3 - IF ( .NOT. ALLOCATED(MAPOUT) ) ALLOCATE ( MAPOUT(NX,NY) ) - WRITE (NDST,9065) - DO IX=1, NX - DO IY=1, NY - MAPOUT(IX,IY) = MAPSTA(IY,IX) + IF ( .NOT. ALLOCATED(MAPOUT) ) ALLOCATE ( MAPOUT(NX,NY) ) + WRITE (NDST,9065) + DO IX=1, NX + DO IY=1, NY + MAPOUT(IX,IY) = MAPSTA(IY,IX) + END DO + END DO + IX0 = 1 + IXN = MIN ( IX0+IXWDT-1 , NX ) + DO + IF (IFLD.EQ.1) THEN + CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Fraction ice', '(-)') + IF ( FLBERG ) & + CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Iceberg a', '0.1/km') + ELSE IF (IFLD.EQ.2) THEN + CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Water level', 'm') + ELSE IF (IFLD.EQ.7) THEN + CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Air density', 'kg/m3') + ELSE + CALL PRTBLK (NDSO, NX, NY, NX, FX, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Cart. X-comp', 'm/s') + CALL PRTBLK (NDSO, NX, NY, NX, FY, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Cart. Y-comp', 'm/s') + IF ( FLSTAB ) & + CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & + IX0, IXN, 1, 1, NY, 1, 'Tair-Tsea', 'degr') + END IF + IF (IXN.NE.NX) THEN + IX0 = IX0 + IXWDT + IXN = MIN ( IXN+IXWDT , NX ) + ELSE + EXIT + END IF END DO - END DO - IX0 = 1 - IXN = MIN ( IX0+IXWDT-1 , NX ) - DO - IF (IFLD.EQ.1) THEN - CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Fraction ice', '(-)') - IF ( FLBERG ) & - CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Iceberg a', '0.1/km') - ELSE IF (IFLD.EQ.2) THEN - CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Water level', 'm') - ELSE IF (IFLD.EQ.7) THEN - CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Air density', 'kg/m3') - ELSE - CALL PRTBLK (NDSO, NX, NY, NX, FX, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Cart. X-comp', 'm/s') - CALL PRTBLK (NDSO, NX, NY, NX, FY, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Cart. Y-comp', 'm/s') - IF ( FLSTAB ) & - CALL PRTBLK (NDSO, NX, NY, NX, FA, MAPOUT, 0, 0., & - IX0, IXN, 1, 1, NY, 1, 'Tair-Tsea', 'degr') - END IF - IF (IXN.NE.NX) THEN - IX0 = IX0 + IXWDT - IXN = MIN ( IXN+IXWDT , NX ) - ELSE - EXIT - END IF - END DO #endif - ! - ! 8.c Write fields - ! - IF ( ITYPE .LE. 4 .OR. ITYPE.EQ.6 ) THEN + ! + ! 8.c Write fields + ! + IF ( ITYPE .LE. 4 .OR. ITYPE.EQ.6 ) THEN #ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,977) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,977) #endif - IF ( IAPROC .EQ. NAPOUT ) CALL W3FLDG ('WRITE', IDFLD, NDSDAT, NDST, NDSE, NX, NY, & - NX, NY, TIME, TIME, TIME, FX, FY, FA, TIME, & - FX, FY, FA, IERR) + IF ( IAPROC .EQ. NAPOUT ) CALL W3FLDG ('WRITE', IDFLD, NDSDAT, NDST, NDSE, NX, NY, & + NX, NY, TIME, TIME, TIME, FX, FY, FA, TIME, & + FX, FY, FA, IERR) - ELSE IF ( ITYPE .EQ. 5 ) THEN - IF ( NDAT .EQ. 0 ) THEN + ELSE IF ( ITYPE .EQ. 5 ) THEN + IF ( NDAT .EQ. 0 ) THEN #ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,978) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,978) #endif - ELSE + ELSE #ifdef W3_O3 - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,977) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,977) #endif - IF ( IAPROC .EQ. NAPOUT ) CALL W3FLDD ('WRITE', IDFLD, NDSDAT, NDST, NDSE, TIME,& - TIME, RECLDT, NDAT, IDAT, DATA, IERR ) - DEALLOCATE ( DATA ) + IF ( IAPROC .EQ. NAPOUT ) CALL W3FLDD ('WRITE', IDFLD, NDSDAT, NDST, NDSE, TIME,& + TIME, RECLDT, NDAT, IDAT, DATA, IERR ) + DEALLOCATE ( DATA ) + END IF END IF - END IF - IF (IERR.NE.0) CALL EXTCDE ( 30 ) + IF (IERR.NE.0) CALL EXTCDE ( 30 ) + ! + END DO ! NTI ! - END DO ! NTI - ! - DEALLOCATE(XC,YC,AC,XTEMP) - IF (ALLOCATED(ALA)) DEALLOCATE(ALA,ALO) - ! - ! End loop over input fields - !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! -880 CONTINUE - GOTO 888 - ! - ! Error escape locations - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 41 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 42 ) - ! -803 CONTINUE - WRITE (NDSE,1003) IERR - CALL EXTCDE ( 43 ) - ! -810 CONTINUE - WRITE (NDSE,1010) - CALL EXTCDE ( 1010 ) - ! -811 CONTINUE - WRITE (NDSE,1011) - CALL EXTCDE ( 1011 ) - ! -845 CONTINUE - WRITE (NDSE,1045) IERR - CALL EXTCDE ( 49 ) - ! -846 CONTINUE - WRITE (NDSE,1046) IERR - CALL EXTCDE ( 50 ) - ! -862 CONTINUE - WRITE (NDSE,1062) IERR - CALL EXTCDE ( 54 ) - ! -863 CONTINUE - WRITE (NDSE,1063) IDAT, IERR - CALL EXTCDE ( 55 ) -864 CONTINUE - WRITE (NDSE,1064) TRIM(STRDIMSNAME) - CALL EXTCDE ( 56 ) - ! -#ifdef W3_O15 -870 CONTINUE - WRITE (NDSE,1070) IDFLD, IERR - CALL EXTCDE ( 57 ) -#endif - ! -#ifdef W3_O15 -871 CONTINUE - WRITE (NDSE,1071) IDTIME, IERR - CALL EXTCDE ( 58 ) -#endif + DEALLOCATE(XC,YC,AC,XTEMP) + IF (ALLOCATED(ALA)) DEALLOCATE(ALA,ALO) + ! + ! End loop over input fields + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + ! + END IF ! end of test IF (ITYPE.GE.6.AND.TIDEFLAG.GT.0) ! -888 CONTINUE IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,999) #ifdef W3_MPI CALL MPI_FINALIZE ( IERR_MPI ) #endif - - ! -#ifdef W3_NCO - ! CALL W3TAGE('WAVEPREP') -#endif - - ! ! Formats ! @@ -2402,17 +2375,9 @@ PROGRAM W3PRNC ' ========================================='/ & ' WAVEWATCH III Input preprocessing '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & ' PREMATURE END OF INPUT FILE'/) ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & ' ERROR IN READING FROM INPUT FILE'/ & ' EXPECTING LIST OF TIDAL CONST. OR FAST OR VFAST'/& @@ -2476,16 +2441,6 @@ PROGRAM W3PRNC 1044 FORMAT (/' *** WAVEWATCH III WARNING W3PRNC : '/ & ' Y = ',F10.1,' NOT COVERED BY INPUT GRID.'/) ! - - ! -1045 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & - ' ERROR IN OPENING LAT-LONG DATA FILE'/ & - ' IOSTAT =',I5/) - ! -1046 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ & - ' ERROR IN OPENING MASK FILE'/ & - ' IOSTAT =',I5/) - ! 1047 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ & ' NO TIDAL COMPUTATION AT NODE [',I8,',',I8,']'/) ! diff --git a/model/src/ww3_prtide.F90 b/model/src/ww3_prtide.F90 index 1168cd1abf..230a30b764 100644 --- a/model/src/ww3_prtide.F90 +++ b/model/src/ww3_prtide.F90 @@ -25,7 +25,7 @@ PROGRAM W3PRTIDE !/ 21-Apr-2020 : MPI implementation ( version 7.13 ) !/ 21-Apr-2020 : bug fix for rectilinear grid ( version 7.13 ) !/ 1-Feb-2020 : Improve indexing, A.Roland ( version 7.14 ) - + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -79,6 +79,8 @@ PROGRAM W3PRTIDE ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort when I/O file if error. + ! EXTOPN Subr. Id. Abort when opening file if error. ! EXTCDE Subr. Id. Abort program as graceful as possible. ! STME21 Subr. W3TIMEMD Convert time to string. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. @@ -124,7 +126,7 @@ PROGRAM W3PRTIDE #endif USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT USE W3ODATMD, ONLY: W3NOUT, W3SETO - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, STRSPLIT + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF, STRSPLIT #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -267,10 +269,11 @@ PROGRAM W3PRTIDE ! IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,900) ! - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_prtide.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_prtide.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3PRTIDE','INPUT',40) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) IF (COMSTR.EQ.' ') COMSTR = '$' IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,901) COMSTR @@ -291,7 +294,8 @@ PROGRAM W3PRTIDE !========================================================== CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) IDFLD + READ (NDSI,*,IOSTAT=IERR) IDFLD + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) ! IF ( IDFLD.EQ.'LEV' ) THEN IFLD = 2 @@ -303,31 +307,39 @@ PROGRAM W3PRTIDE END IF ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) TIDECONSTNAMES + READ (NDSI,'(A)',IOSTAT=IERR) TIDECONSTNAMES + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSE ) TIDECON_PRNAMES(:)='' CALL STRSPLIT(TIDECONSTNAMES,TIDECON_PRNAMES) ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) TIDECONSTNAMES + READ (NDSI,'(A)',IOSTAT=IERR) TIDECONSTNAMES + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) TIDECON_MAXNAMES(:)='' CALL STRSPLIT(TIDECONSTNAMES,TIDECON_MAXNAMES) ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) TIDECON_MAXVALS(:)='' - READ (NDSI,'(A)',END=801,ERR=802,IOSTAT=IERR) TIDECONSTNAMES + READ (NDSI,'(A)',IOSTAT=IERR) TIDECONSTNAMES + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) CALL STRSPLIT(TIDECONSTNAMES,TIDECON_MAXVALS) ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) TIDE_START,PRTIDE_DT,TIDE_END + READ (NDSI,*,IOSTAT=IERR) TIDE_START,PRTIDE_DT,TIDE_END + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802,IOSTAT=IERR) FILENAMEXT + READ (NDSI,*,IOSTAT=IERR) FILENAMEXT + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3PRTIDE','INPUT',41) ! CALL W3FLDO ('READ', IDFLD, NDSF, NDST, & NDSE, NX, NY, GTYPE, & IERR, FILENAMEXT, '', TIDEFLAGIN=FLAGTIDE ) ! - IF (FLAGTIDE.NE.1) GOTO 803 + IF (FLAGTIDE.NE.1) THEN + WRITE (NDSE,1003) + CALL EXTCDE ( 43 ) + END IF ! CALL VUF_SET_PARAMETERS @@ -506,7 +518,13 @@ PROGRAM W3PRTIDE !========================================================== DTTST = DSEC21 ( TIDE_START , TIDE_END ) - IF ( DTTST .LE. 0. .OR. PRTIDE_DT .LT. 1 ) GOTO 888 + IF ( DTTST .LE. 0. .OR. PRTIDE_DT .LT. 1 ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,999) +#ifdef W3_MPI + CALL MPI_FINALIZE ( IERR_MPI ) +#endif + STOP + END IF TIME = TIDE_START TIDE_KD0= 2415020 ! @@ -514,7 +532,13 @@ PROGRAM W3PRTIDE ! DO DTTST = DSEC21 ( TIME, TIDE_END ) - IF ( DTTST .LT. 0. ) GOTO 888 + IF ( DTTST .LT. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,999) +#ifdef W3_MPI + CALL MPI_FINALIZE ( IERR_MPI ) +#endif + STOP + END IF ! CALL STME21 ( TIME , IDTIME ) IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,973) IDTIME @@ -827,32 +851,10 @@ PROGRAM W3PRTIDE END DO ! - GOTO 888 - ! - ! Error escape locations - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 40 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 41 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 42 ) - ! -803 CONTINUE - WRITE (NDSE,1003) - CALL EXTCDE ( 43 ) - ! -888 CONTINUE IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,999) #ifdef W3_MPI CALL MPI_FINALIZE ( IERR_MPI ) #endif - ! ! Formats ! @@ -866,17 +868,6 @@ PROGRAM W3PRTIDE ' ========================================='/ & ' WAVEWATCH III Input preprocessing '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRTIDE : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRTIDE : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRTIDE : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRTIDE : '/ & ' THE INPUT FILE DOES NOT CONTAIN TIDAL DATA'/) ! diff --git a/model/src/ww3_sbs1.F90 b/model/src/ww3_sbs1.F90 index 94778b10db..23ae621e3f 100644 --- a/model/src/ww3_sbs1.F90 +++ b/model/src/ww3_sbs1.F90 @@ -47,6 +47,7 @@ PROGRAM W3SBS1 !/ 11-Aug-2010 : Upgrade for operations and inclusion in svn. !/ ( version 3.14.4 ) !/ 05-Dec-2012 : Making sleep a system call. ( version 4.11 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2010 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -106,6 +107,7 @@ PROGRAM W3SBS1 ! WMINIT Subr. WMINITMD Multi-grid model initialization. ! WMWAVE Subr. WMWAVEMD Multi-grid model subroutine. ! WMFINL Subr. WMFINLMD Multi-grid model finalization. + ! EXTOPN Subr. W3SERVMD Abort when opening a file if errors. ! EXTCDE Subr. W3SERVMD Abort program as graceful as possible. ! W3SETG Subr. W3GDATMD Point to Grid data data structure. ! W3SETI Subr. W3IDATMD Point to input fields data structure. @@ -165,7 +167,7 @@ PROGRAM W3SBS1 USE WMINITMD, ONLY: WMINIT USE WMWAVEMD, ONLY: WMWAVE USE WMFINLMD, ONLY: WMFINL - USE W3SERVMD, ONLY: EXTCDE + USE W3SERVMD, ONLY: EXTCDE, EXTOPN USE W3GDATMD, ONLY: W3SETG USE W3GDATMD, ONLY: NGRIDS, NAUXGR, NX, NY, GNAME, FILEXT USE W3IDATMD, ONLY: W3SETI @@ -245,7 +247,8 @@ PROGRAM W3SBS1 CALL WMUSET ( MDSE, MDST, NDST1, .TRUE., 'I/O', & NAME='times.inp', & DESC='times file for sbs driver' ) - OPEN (NDST1,FILE='times.inp',STATUS='OLD',ERR=820,IOSTAT=IERR) + OPEN (NDST1,FILE='times.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3SBS1','TIMES',20) #ifdef W3_T WRITE (MDST,9020) #endif @@ -262,8 +265,10 @@ PROGRAM W3SBS1 END IF END DO ! - IF ( NXW .EQ. -1 ) GOTO 825 - IF ( NDST2 .EQ. -1 ) GOTO 825 + IF ( (NXW .EQ. -1) .OR. (NDST2 .EQ. -1) ) THEN + WRITE (MDSS,1025) NDST2 + CALL EXTCDE ( 25 ) + END IF ! #ifdef W3_T WRITE (MDST,9021) @@ -346,18 +351,6 @@ PROGRAM W3SBS1 CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) CALL MPI_FINALIZE ( IERR_MPI ) #endif - ! - GO TO 888 - ! -820 CONTINUE - WRITE (MDSS,1020) IERR - CALL EXTCDE ( 20 ) - ! -825 CONTINUE - WRITE (MDSS,1025) NDST2 - CALL EXTCDE ( 25 ) - ! -888 CONTINUE ! ! Formats ! @@ -373,10 +366,6 @@ PROGRAM W3SBS1 ' ========================================'/ & ' WAVEWATCH III Multi-grid shell '/) ! -1020 FORMAT (/' *** WAVEWATCH-III ERROR IN W3SBS1 : '/ & - ' ERROR IN OPENING TIMES FILE'/ & - ' IOSTAT =',I5/) - ! 1025 FORMAT (/' *** WAVEWATCH-III ERROR IN W3SBS1 : '/ & ' WIND FILE NOT FOUND, NDST2 = ',I8/) ! @@ -411,6 +400,7 @@ SUBROUTINE RDTIME ( NDS, TIME ) !/ !/ 10-Aug-2010 : Origination. ( version 3.14.4 ) !/ 05-Dec-2012 : Making sleep a system call. ( version 4.11 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -445,28 +435,25 @@ SUBROUTINE RDTIME ( NDS, TIME ) ! DO ! - READ (NDS,910,END=110,ERR=810,IOSTAT=IERR) TIME - EXIT - ! -110 CONTINUE - IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS, 911 ) - BACKSPACE NDS - ! + READ (NDS,910,IOSTAT=IERR) TIME + IF (IERR.LT.0) THEN ! End of file reached + IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS, 911 ) + BACKSPACE NDS + ! #ifdef W3_SBS - WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP1 - CALL SYSTEM ( COMMAND ) + WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP1 + CALL SYSTEM ( COMMAND ) #endif + ELSE IF (IERR.GT.0) THEN ! Error reading file + WRITE (MDSS,1010) IERR + CALL EXTCDE ( 10 ) + END IF ! + EXIT END DO ! RETURN ! - ! Escape locations read errors --------------------------------------- * - ! -810 CONTINUE - WRITE (MDSS,1010) IERR - CALL EXTCDE ( 10 ) - ! ! Formats ! 910 FORMAT (1X,I8,1X,I6) @@ -507,6 +494,7 @@ SUBROUTINE RDWIND ( NDS, TIME, NX, NY, REWIND ) !/ !/ 10-Aug-2010 : Origination. ( version 3.14.4 ) !/ 05-Dec-2012 : Making sleep a system call. ( version 4.11 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -534,7 +522,7 @@ SUBROUTINE RDWIND ( NDS, TIME, NX, NY, REWIND ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: TTIME(2), IX, IY + INTEGER :: TTIME(2), IX, IY, IERR INTEGER, SAVE :: NREW = 0 REAL :: DTTST, XXX(NX,NY) #ifdef W3_SBS @@ -550,27 +538,69 @@ SUBROUTINE RDWIND ( NDS, TIME, NX, NY, REWIND ) ! DO ! + READ (NDS,END=140,ERR=140,IOSTAT=IERR) TTIME + IF (IERR.NE.0) THEN + BACKSPACE NDS + IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS,900) +#ifdef W3_SBS + WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP2 + CALL SYSTEM ( COMMAND ) +#endif + CYCLE + END IF NREW = NREW + 1 - READ (NDS,END=140,ERR=140) TTIME #ifdef W3_T WRITE (MDST,9000) TTIME #endif ! + READ (NDS,IOSTAT=IERR) ((XXX(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + BACKSPACE NDS + BACKSPACE NDS + IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS,900) +#ifdef W3_SBS + WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP2 + CALL SYSTEM ( COMMAND ) +#endif + CYCLE + END IF NREW = NREW + 1 - READ (NDS,END=130,ERR=130) ((XXX(IX,IY),IX=1,NX),IY=1,NY) #ifdef W3_T WRITE (MDST,9001) 'U' #endif ! + READ (NDS,IOSTAT=IERR) ((XXX(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + BACKSPACE NDS + BACKSPACE NDS + BACKSPACE NDS + IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS,900) +#ifdef W3_SBS + WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP2 + CALL SYSTEM ( COMMAND ) +#endif + CYCLE + END IF NREW = NREW + 1 - READ (NDS,END=120,ERR=120) ((XXX(IX,IY),IX=1,NX),IY=1,NY) #ifdef W3_T WRITE (MDST,9001) 'V' #endif ! IF ( TYPE .EQ. 'WNS' ) THEN + READ (NDS,IOSTAT=IERR) ((XXX(IX,IY),IX=1,NX),IY=1,NY) + IF (IERR.NE.0) THEN + BACKSPACE NDS + BACKSPACE NDS + BACKSPACE NDS + BACKSPACE NDS + IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS,900) +#ifdef W3_SBS + WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP2 + CALL SYSTEM ( COMMAND ) +#endif + CYCLE + END IF NREW = NREW + 1 - READ (NDS,END=110,ERR=110) ((XXX(IX,IY),IX=1,NX),IY=1,NY) #ifdef W3_T WRITE (MDST,9001) 'DT' #endif @@ -578,26 +608,6 @@ SUBROUTINE RDWIND ( NDS, TIME, NX, NY, REWIND ) ! EXIT ! -110 CONTINUE - BACKSPACE NDS - NREW = NREW - 1 -120 CONTINUE - BACKSPACE NDS - NREW = NREW - 1 -130 CONTINUE - BACKSPACE NDS - NREW = NREW - 1 -140 CONTINUE - BACKSPACE NDS - NREW = NREW - 1 - ! - IF ( IMPROC .EQ. NMPSCR ) WRITE (MDSS,900) - ! -#ifdef W3_SBS - WRITE (COMMAND,'(A5,1X,I4)') 'sleep ', SLEEP2 - CALL SYSTEM ( COMMAND ) -#endif - ! END DO ! ! ... Outer loop catching up @@ -609,7 +619,8 @@ SUBROUTINE RDWIND ( NDS, TIME, NX, NY, REWIND ) ELSE IF ( DTTST .EQ. 0. ) THEN EXIT ELSE - GOTO 800 + WRITE (MDSS,1010) + CALL EXTCDE ( 10 ) END IF ! END DO @@ -630,12 +641,6 @@ SUBROUTINE RDWIND ( NDS, TIME, NX, NY, REWIND ) ! RETURN ! - ! Escape locations read errors --------------------------------------- * - ! -800 CONTINUE - WRITE (MDSS,1010) - CALL EXTCDE ( 10 ) - ! ! Formats ! 900 FORMAT (' FILE NOT YET COMPLETE ... ') diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index 995e6363ab..2065913752 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -71,6 +71,7 @@ PROGRAM W3SHEL !/ 22-Mar-2021 : Add new coupling fields ( version 7.13 ) !/ 07-Jun-2021 : S_{nl} GKE NL5 (Q. Liu) ( version 7.13 ) !/ 02-Feb-2022 : Scalability local ( version 7.14 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009-2012 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -255,21 +256,21 @@ PROGRAM W3SHEL USE CONSTANTS, ONLY: LPDLIB #endif USE W3GDATMD - USE W3WDATMD, ONLY: TIME, VA, W3NDAT, W3DIMW, W3SETW + USE W3WDATMD, ONLY: TIME, VA, W3NDAT, W3SETW #ifdef W3_OASIS USE W3WDATMD, ONLY: TIME00, TIMEEND #endif #ifdef W3_NL5 USE W3WDATMD, ONLY: QI5TBEG #endif - USE W3ADATMD, ONLY: W3NAUX, W3DIMA, W3SETA + USE W3ADATMD, ONLY: W3NAUX, W3SETA USE W3IDATMD #ifdef W3_OASIS USE W3ODATMD, ONLY: DTOUT, FLOUT #endif USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3ODATMD, ONLY: NAPROC, IAPROC, NAPOUT, NAPERR, NOGRP, & - NGRPP, IDOUT, FNMPRE, FNMGRD, FNMPNT, FNMRST, IOSTYP, NOTYPE + NGRPP, FNMPRE, FNMGRD, FNMPNT, FNMRST, IOSTYP, NOTYPE USE W3ODATMD, ONLY: FLOGRR, FLOGR, OFILES !/ USE W3FLDSMD @@ -280,8 +281,7 @@ PROGRAM W3SHEL USE W3IOGRMD, ONLY: W3IOGR USE W3IOGOMD, ONLY: W3READFLGRD, FLDOUT, W3FLGRDFLAG USE W3IORSMD, ONLY: OARST - USE W3IOPOMD - USE W3SERVMD, ONLY : NEXTLN, EXTCDE + USE W3SERVMD, ONLY : NEXTLN, EXTCDE, EXTOPN, EXTIOF USE W3TIMEMD #ifdef W3_OASIS @@ -341,20 +341,17 @@ PROGRAM W3SHEL STARTDATE(8), STOPDATE(8), IHH(-7:10) ! #ifdef W3_OASIS - INTEGER :: OASISED + INTEGER :: OASISED = 1 #endif #ifdef W3_COU INTEGER :: OFL #endif - INTEGER :: CLKDT1(8), CLKDT2(8), CLKDT3(8) -#ifdef W3_MPI + INTEGER :: CLKDT1(8), CLKDT2(8) INTEGER :: IERR_MPI -#endif ! REAL :: FACTOR, DTTST, XX, YY, & HA(NHMAX,-7:10), HD(NHMAX,-7:10), & HS(NHMAX,-7:10) - REAL :: CLKFIN, CLKFEL REAL, ALLOCATABLE :: X(:), Y(:), XXX(:,:), DATA0(:,:), & DATA1(:,:), DATA2(:,:) ! @@ -395,13 +392,10 @@ PROGRAM W3SHEL #endif #ifdef W3_OASIS LOGICAL :: L_MASTER - LOGICAL :: FIRST_STEP = .TRUE. #endif character(len=10) :: jchar integer :: memunit - LOGICAL :: DIR_EXISTS - INTEGER :: DIR_STATUS ! !/ !/ ------------------------------------------------------------------- / @@ -441,9 +435,6 @@ PROGRAM W3SHEL !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 0. Set up data structures ! -#ifdef W3_OASIS - OASISED=1 -#endif #ifdef W3_PDLIB LPDLIB = .TRUE. #endif @@ -500,8 +491,6 @@ PROGRAM W3SHEL ! #ifdef W3_MPI CALL MPI_COMM_SIZE ( MPI_COMM, NAPROC, IERR_MPI ) -#endif -#ifdef W3_MPI CALL MPI_COMM_RANK ( MPI_COMM, IAPROC, IERR_MPI ) IAPROC = IAPROC + 1 #endif @@ -576,8 +565,10 @@ PROGRAM W3SHEL OFILE = 'output.ww3' OFL = LEN_TRIM(OFILE) J = LEN_TRIM(FNMPRE) + IERR = 0 IF ( IAPROC .EQ. NAPOUT ) & - OPEN (333,FILE=FNMPRE(:J)//OFILE(:OFL),ERR=2008,IOSTAT=IERR) + OPEN (333,FILE=FNMPRE(:J)//OFILE(:OFL),IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR, 'W3SHEL', 'OUTPUT', 1008) #endif IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,900) @@ -813,8 +804,11 @@ PROGRAM W3SHEL IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,921) IDFLDS(J), YESXNO, STRNG END DO #ifdef W3_COU - IF (FLAGSC(1) .AND. INFLAGS1(2) .AND. .NOT. FLAGSC(2)) GOTO 2102 - IF (FLAGSC(2) .AND. INFLAGS1(1) .AND. .NOT. FLAGSC(1)) GOTO 2102 + IF ( (FLAGSC(1) .AND. INFLAGS1(2) .AND. .NOT. FLAGSC(2)) .OR. & + (FLAGSC(2) .AND. INFLAGS1(1) .AND. .NOT. FLAGSC(1)) ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1102) + CALL EXTCDE ( 1102 ) + END IF #endif INFLAGS1(10) = .FALSE. @@ -854,8 +848,6 @@ PROGRAM W3SHEL WRITE (NDST,9020) FLFLG, INFLAGS1, FLHOM, FLH #endif - - ! 2.2 Time setup READ(NML_DOMAIN%START,*) TIME0 @@ -936,7 +928,8 @@ PROGRAM W3SHEL END IF ODAT(33) = INT(DTMAX) ELSE IF (MOD(ODAT(33),INT(DTMAX)) .NE. 0) THEN - GOTO 2009 + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1009) ODAT(33), NINT(DTMAX) + CALL EXTCDE ( 1009 ) END IF #endif ! @@ -956,13 +949,14 @@ PROGRAM W3SHEL FLDOUT = NML_OUTPUT_TYPE%FIELD%LIST CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDOUT, FLGD, & FLGRD, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 - + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! Type 2: point output ELSE IF ( J .EQ. 2 ) THEN OPEN (NDSL, FILE=TRIM(FNMPRE)//TRIM(NML_OUTPUT_TYPE%POINT%FILE), & - FORM='FORMATTED', STATUS='OLD', ERR=2104, IOSTAT=IERR) + FORM='FORMATTED', STATUS='OLD', IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR, 'W3SHEL', 'POINT', 1104) ! first loop to count the number of points ! second loop to allocate the array and store the points @@ -976,13 +970,14 @@ PROGRAM W3SHEL ALLOCATE ( X(NPTS), Y(NPTS), PNAMES(NPTS) ) IPTS = 0 ! reset counter to be reused for next do loop ELSE - ALLOCATE ( X(1), Y(1), PNAMES(1) ) - GOTO 2054 + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1054) + CALL EXTCDE ( 1054 ) END IF END IF ! DO - READ (NDSL,*,ERR=2004,IOSTAT=IERR) TMPLINE + READ (NDSL,*,IOSTAT=IERR) TMPLINE + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR, 'W3SHEL', 'POINT', 1104) ! if end of file or stopstring, then exit IF ( IERR.NE.0 .OR. INDEX(TMPLINE,"STOPSTRING").NE.0 ) EXIT ! leading blanks removed and placed on the right @@ -992,8 +987,10 @@ PROGRAM W3SHEL CYCLE ELSE ! otherwise, backup to beginning of line - BACKSPACE ( NDSL, ERR=2004, IOSTAT=IERR) - READ (NDSL,*,ERR=2004,IOSTAT=IERR) XX, YY, PN + BACKSPACE ( NDSL,IOSTAT=IERR) + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR, 'W3SHEL', 'POINT', 1104) + READ (NDSL,*,IOSTAT=IERR) XX, YY, PN + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR, 'W3SHEL', 'POINT', 1104) END IF IPTS = IPTS + 1 IF ( ILOOP .EQ. 1 ) CYCLE @@ -1062,7 +1059,8 @@ PROGRAM W3SHEL FLDOUT = NML_OUTPUT_TYPE%COUPLING%SENT CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDOUT, FLG2, & FLGR2, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) FLDIN = NML_OUTPUT_TYPE%COUPLING%RECEIVED CPLT0 = NML_OUTPUT_TYPE%COUPLING%COUPLET0 #endif @@ -1075,7 +1073,8 @@ PROGRAM W3SHEL FLDRST = NML_OUTPUT_TYPE%RESTART%EXTRA CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDRST, FLOGR, & FLOGRR, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! force minimal allocation to avoid memory seg fault IF ( .NOT.ALLOCATED(X) .AND. NPTS.EQ.0 ) ALLOCATE ( X(1), Y(1), PNAMES(1) ) @@ -1105,7 +1104,10 @@ PROGRAM W3SHEL N_TOT = NML_HOMOG_COUNT%N_TOT ! DO J=JFIRST,10 - IF ( NH(J) .GT. NHMAX ) GOTO 2006 + IF ( NH(J) .GT. NHMAX ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1006) IDTST, NH(J) + CALL EXTCDE ( 1006 ) + END IF END DO @@ -1146,7 +1148,8 @@ PROGRAM W3SHEL CASE ('MOV') J=10 CASE DEFAULT - GOTO 2062 + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1062) IDTST + CALL EXTCDE ( 1062 ) END SELECT IHH(J)=IHH(J)+1 READ(NML_HOMOG_INPUT(IH)%DATE,*) THO(:,J,IHH(J)) @@ -1192,7 +1195,10 @@ PROGRAM W3SHEL ( FLH(4) .AND. (NH(4).EQ.0) ) .OR. & ( FLH(5) .AND. (NH(5).EQ.0) ) .OR. & ( FLH(6) .AND. (NH(6).EQ.0) ) .OR. & - ( FLH(10) .AND. (NH(10).EQ.0) ) ) GOTO 2007 + ( FLH(10) .AND. (NH(10).EQ.0) ) ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1007) + CALL EXTCDE ( 1007 ) + END IF ! END IF ! FLHOM @@ -1273,8 +1279,11 @@ PROGRAM W3SHEL IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,921) IDFLDS(J), YESXNO, STRNG END DO #ifdef W3_COU - IF (FLAGSC(1) .AND. INFLAGS1(2) .AND. .NOT. FLAGSC(2)) GOTO 2102 - IF (FLAGSC(2) .AND. INFLAGS1(1) .AND. .NOT. FLAGSC(1)) GOTO 2102 + IF ( (FLAGSC(1) .AND. INFLAGS1(2) .AND. .NOT. FLAGSC(2)) .OR. & + (FLAGSC(2) .AND. INFLAGS1(1) .AND. .NOT. FLAGSC(1)) ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1102) + CALL EXTCDE ( 1102 ) + END IF #endif call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 2b') ! @@ -1315,7 +1324,6 @@ PROGRAM W3SHEL WRITE (NDST,9020) FLFLG, INFLAGS1, FLHOM, FLH #endif - ! 2.2 Time setup CALL NEXTLN ( COMSTR , NDSI , NDSEN ) @@ -1344,7 +1352,6 @@ PROGRAM W3SHEL FACTOR = 1.E-3 END IF - ! 2.4 Output dates NPTS = 0 @@ -1368,16 +1375,19 @@ PROGRAM W3SHEL READ(WORDS( 5 ), * ) ODAT(20) IF (WORDS(6) .EQ. 'T') THEN CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(8-1)+1,5*8) + READ (NDSI,*,IOSTAT=IERR)(ODAT(I),I=5*(8-1)+1,5*8) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SHEL','INPUT',1001) WRITE(*,*)(ODAT(I),I=5*(8-1)+1,5*8) END IF IF (WORDS(7) .EQ. 'T') THEN CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=2001,ERR=2002) FLDRST + READ (NDSI,'(A)',IOSTAT=IERR) FLDRST + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SHEL','INPUT',1001) END IF CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDRST, FLOGR, & FLOGRR, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ELSE ! !INLINE NEW VARIABLE TO READ IF PRESENT OFILES(J), IF NOT ==0 @@ -1385,7 +1395,8 @@ PROGRAM W3SHEL ! READ (NDSI,*,IOSTAT=IERR) (ODAT(I),I=5*(J-1)+1,5*J),OFILES(J) IF(J .LE. 2) THEN WORDS(1:6)='' - ! READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(J-1)+1,5*J),OFILES(J) + ! READ (NDSI,*,IOSTAT=IERR)(ODAT(I),I=5*(J-1)+1,5*J),OFILES(J) + ! IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SHEL','INPUT',1001) READ (NDSI,'(A)') LINEIN READ(LINEIN,*,iostat=ierr) WORDS ! @@ -1409,7 +1420,6 @@ PROGRAM W3SHEL READ(WORDS( 6 ), * ) OFILES(J) END IF - #ifdef W3_COU ELSE IF(J .EQ. 7) THEN WORDS(1:6)='' @@ -1430,7 +1440,8 @@ PROGRAM W3SHEL #endif ELSE OFILES(J)=0 - READ (NDSI,*,END=2001,ERR=2002)(ODAT(I),I=5*(J-1)+1,5*J) + READ (NDSI,*,IOSTAT=IERR)(ODAT(I),I=5*(J-1)+1,5*J) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SHEL','INPUT',1001) END IF ! WRITE(*,*) 'OFILES(J)= ', OFILES(J),J ! @@ -1447,9 +1458,8 @@ PROGRAM W3SHEL IF ( J .EQ. 1 ) THEN CALL W3READFLGRD ( NDSI, NDSO, 9, NDSEN, COMSTR, FLGD, & FLGRD, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 - - + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! Type 2: point output ELSE IF ( J .EQ. 2 ) THEN @@ -1470,8 +1480,8 @@ PROGRAM W3SHEL IF ( NPTS.GT.0 ) THEN ALLOCATE ( X(NPTS), Y(NPTS), PNAMES(NPTS) ) ELSE - ALLOCATE ( X(1), Y(1), PNAMES(1) ) - GOTO 2054 + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1054) + CALL EXTCDE ( 1054 ) END IF END IF END IF @@ -1529,8 +1539,6 @@ PROGRAM W3SHEL #endif END IF ! - - ! Type 3: track output ELSE IF ( J .EQ. 3 ) THEN CALL NEXTLN ( COMSTR , NDSI , NDSEN ) @@ -1545,7 +1553,6 @@ PROGRAM W3SHEL END IF END IF - ! Type 6: partitioning ELSE IF ( J .EQ. 6 ) THEN ! IPRT: IX0, IXN, IXS, IY0, IYN, IYS @@ -1561,15 +1568,16 @@ PROGRAM W3SHEL WRITE (NDSO,6945) IPRT, YESXNO END IF - #ifdef W3_COU ! Type 7: coupling ELSE IF ( J .EQ. 7 ) THEN CALL W3READFLGRD ( NDSI, NDSO, NDSS, NDSEN, COMSTR, FLG2, & FLGR2, IAPROC, NAPOUT, IERR ) - IF ( IERR .NE. 0 ) GOTO 2222 + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,'(A)',END=2001,ERR=2002,IOSTAT=IERR) FLDIN + READ (NDSI,'(A)',IOSTAT=IERR) FLDIN + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SHEL','INPUT',1001) #endif END IF ! J @@ -1592,7 +1600,6 @@ PROGRAM W3SHEL CALL NEXTLN ( COMSTR , NDSI , NDSEN ) READ (NDSI,*) IDTST - ! Exit if illegal id IF ( IDTST.NE.IDSTR(-7) .AND. IDTST.NE.IDSTR(-6) .AND. & IDTST.NE.IDSTR(-5) .AND. IDTST.NE.IDSTR(-4) .AND. & @@ -1601,7 +1608,10 @@ PROGRAM W3SHEL IDTST.NE.IDSTR(1) .AND. IDTST.NE.IDSTR(2) .AND. & IDTST.NE.IDSTR(3) .AND. IDTST.NE.IDSTR(4) .AND. & IDTST.NE.IDSTR(5) .AND. IDTST.NE.IDSTR(6) .AND. & - IDTST.NE.IDSTR(10) .AND. IDTST.NE.'STP' ) GOTO 2005 + IDTST.NE.IDSTR(10) .AND. IDTST.NE.'STP' ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1005) IDTST + CALL EXTCDE ( 1005 ) + END IF ! Stop conditions IF ( IDTST .EQ. 'STP' ) THEN @@ -1614,7 +1624,10 @@ PROGRAM W3SHEL DO J=LBOUND(IDSTR,1), 10 IF ( IDTST .EQ. IDSTR(J) ) THEN NH(J) = NH(J) + 1 - IF ( NH(J) .GT. NHMAX ) GOTO 2006 + IF ( NH(J) .GT. NHMAX ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1006) IDTST, NH(J) + CALL EXTCDE ( 1006 ) + END IF IF ( J .LE. 1 ) THEN ! water levels, etc. : get HA READ (NDSI,*) IDTST, & THO(1,J,NH(J)), THO(2,J,NH(J)), & @@ -1686,16 +1699,14 @@ PROGRAM W3SHEL ( FLH(4) .AND. (NH(4).EQ.0) ) .OR. & ( FLH(5) .AND. (NH(5).EQ.0) ) .OR. & ( FLH(6) .AND. (NH(6).EQ.0) ) .OR. & - ( FLH(10) .AND. (NH(10).EQ.0) ) ) GOTO 2007 + ( FLH(10) .AND. (NH(10).EQ.0) ) ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1007) + CALL EXTCDE ( 1007 ) + END IF ! END IF ! FLHOM END IF - - - - - ! ! ---------------- ! @@ -1709,7 +1720,6 @@ PROGRAM W3SHEL IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) & 'Preparing input files ...' ! - DO J=JFIRST, 6 IF ( INFLAGS1(J) .AND. .NOT. FLAGSC(J)) THEN IF ( FLH(J) ) THEN @@ -1719,7 +1729,8 @@ PROGRAM W3SHEL CALL W3FLDO ('READ', IDSTR(J), NDSF(J), NDST, & NDSEN, NX, NY, GTYPE, & IERR, FPRE=TRIM(FNMPRE), TIDEFLAGIN=FLAGTIDE ) - IF ( IERR .NE. 0 ) GOTO 2222 + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) #ifdef W3_TIDE IF (FLAGTIDE.GT.0.AND.J.EQ.1) FLAGSTIDE(1)=.TRUE. IF (FLAGTIDE.GT.0.AND.J.EQ.2) FLAGSTIDE(2)=.TRUE. @@ -1736,7 +1747,8 @@ PROGRAM W3SHEL CALL W3FLDO ('READ', IDSTR(J), NDSF(J), NDST, NDSEN, & RCLD(J), NY, NODATA(J), & IERR, FPRE=TRIM(FNMPRE) ) - IF ( IERR .NE. 0 ) GOTO 2222 + IF ( IERR .NE. 0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,956) IDFLDS(J),& RCLD(J), NODATA(J) ELSE @@ -1765,8 +1777,10 @@ PROGRAM W3SHEL #endif ! DTTST = DSEC21 ( TIME0 , TIMEN ) - IF ( DTTST .LE. 0. ) GOTO 2003 - + IF ( DTTST .LE. 0. ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) + CALL EXTCDE ( 1003 ) + END IF ! 2.3 Domain setup @@ -1794,7 +1808,6 @@ PROGRAM W3SHEL END IF END IF - ! 2.4 Output dates DO J = 1, NOTYPE @@ -1865,7 +1878,6 @@ PROGRAM W3SHEL WRITE (NDST,9041) FLGRD WRITE (NDST,9042) IPRT, PRTFRM #endif - ! ! For outputs with non-zero time step, check dates : ! If output ends before run start OR output starts after run end, @@ -1878,13 +1890,11 @@ PROGRAM W3SHEL IF ( DTTST .LT. 0 ) THEN ODAT(5*(J-1)+3) = 0 IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE END IF DTTST = DSEC21 ( ODAT(5*(J-1)+1:5*(J-1)+2), TIMEN ) IF ( DTTST .LT. 0 ) THEN ODAT(5*(J-1)+3) = 0 IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE END IF END DO ! @@ -1894,13 +1904,11 @@ PROGRAM W3SHEL IF ( DTTST .LT. 0 ) THEN ODAT(5*(J-1)+3) = 0 IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE END IF DTTST = DSEC21 ( ODAT(5*(J-1)+1:5*(J-1)+2), TIMEN ) IF ( DTTST .LT. 0 ) THEN ODAT(5*(J-1)+3) = 0 IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,8945) TRIM(IDOTYP(J)) - CONTINUE END IF ! call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 5') @@ -1908,7 +1916,6 @@ PROGRAM W3SHEL !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 5. Initializations ! - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,951) 'Wave model ...' ! #ifdef W3_TIDE @@ -1958,8 +1965,6 @@ PROGRAM W3SHEL ! ALLOCATE ( XXX(NX,NY) ) ! - - ! #ifdef W3_MPI CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) #endif @@ -1983,7 +1988,6 @@ PROGRAM W3SHEL END IF #endif - !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 6. Model without input ! @@ -2008,7 +2012,7 @@ PROGRAM W3SHEL #endif ) ! - GOTO 2222 + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! END IF !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2034,728 +2038,632 @@ PROGRAM W3SHEL END IF #endif -700 CONTINUE - ! - ! - ! 7.a Determine next time interval and input fields - ! 7.a.1 Preparation - ! - TTIME = TIMEN - ! - CALL STME21 ( TIME0 , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,971) DTME21 - ! + ! 700 timestepping + DO WHILE ( DTTST .GT. 0.) + ! + ! + ! 7.a Determine next time interval and input fields + ! 7.a.1 Preparation + ! + TTIME = TIMEN + ! + CALL STME21 ( TIME0 , DTME21 ) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,971) DTME21 + ! #ifdef W3_T - WRITE (NDST,9070) '0-N', TIME0, TTIME, & - IDSTR(-7), INFLAGS1(-7), TI1, & - IDSTR(-6), INFLAGS1(-6), TI2, & - IDSTR(-5), INFLAGS1(-5), TI3, & - IDSTR(-4), INFLAGS1(-4), TI4, & - IDSTR(-3), INFLAGS1(-3), TI5, & - IDSTR(-2), INFLAGS1(-2), TZN, & - IDSTR(-1), INFLAGS1(-1), TTN, & - IDSTR(0), INFLAGS1(0), TVN, & - IDSTR(1), INFLAGS1(1), TLN, & - IDSTR(2), INFLAGS1(2), TC0, TCN, & - IDSTR(3), INFLAGS1(3), TW0, TWN, & - IDSTR(4), INFLAGS1(4), TIN, & - IDSTR(5), INFLAGS1(5), TU0, TUN, & - IDSTR(6), INFLAGS1(6), TR0, TRN, & - IDSTR(7), INFLAGS1(7), T0N, & - IDSTR(8), INFLAGS1(8), T1N, & - IDSTR(9), INFLAGS1(9), T2N, & - IDSTR(10), INFLAGS1(10), TG0, TGN -#endif - ! - call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 7') - - DO J=JFIRST,10 + WRITE (NDST,9070) '0-N', TIME0, TTIME, & + IDSTR(-7), INFLAGS1(-7), TI1, & + IDSTR(-6), INFLAGS1(-6), TI2, & + IDSTR(-5), INFLAGS1(-5), TI3, & + IDSTR(-4), INFLAGS1(-4), TI4, & + IDSTR(-3), INFLAGS1(-3), TI5, & + IDSTR(-2), INFLAGS1(-2), TZN, & + IDSTR(-1), INFLAGS1(-1), TTN, & + IDSTR(0), INFLAGS1(0), TVN, & + IDSTR(1), INFLAGS1(1), TLN, & + IDSTR(2), INFLAGS1(2), TC0, TCN, & + IDSTR(3), INFLAGS1(3), TW0, TWN, & + IDSTR(4), INFLAGS1(4), TIN, & + IDSTR(5), INFLAGS1(5), TU0, TUN, & + IDSTR(6), INFLAGS1(6), TR0, TRN, & + IDSTR(7), INFLAGS1(7), T0N, & + IDSTR(8), INFLAGS1(8), T1N, & + IDSTR(9), INFLAGS1(9), T2N, & + IDSTR(10), INFLAGS1(10), TG0, TGN +#endif ! - write(jchar, '(i0)') j - call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL UPDATE '//trim(jchar)) + call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 7') - IF ( INFLAGS1(J) ) THEN - ! - ! 7.a.2 Check if update is needed + DO J=JFIRST,10 ! - IF (.NOT.FLAGSC(J)) THEN - TTT(1) = TFN(1,J) - TTT(2) = TFN(2,J) - IF ( TTT(1) .EQ. -1 ) THEN - DTTST = 0. - ELSE - DTTST = DSEC21 ( TIME0 , TTT ) - END IF -#ifdef W3_OASIS - ELSE - IF ( DTOUT(7).NE.0 ) THEN - ! TFN not initialized at TIME=TIME00, using TIME instead - IF(NINT(DSEC21(TIME00,TIME)) == 0) THEN - ID_OASIS_TIME = 0 - DTTST=0. + write(jchar, '(i0)') j + call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL UPDATE '//trim(jchar)) + + IF ( INFLAGS1(J) ) THEN + ! + ! 7.a.2 Check if update is needed + ! + IF (.NOT.FLAGSC(J)) THEN + TTT(1) = TFN(1,J) + TTT(2) = TFN(2,J) + IF ( TTT(1) .EQ. -1 ) THEN + DTTST = 0. ELSE - ID_OASIS_TIME = NINT(DSEC21 ( TIME00 , TFN(:,J) )) - IF ( MOD(NINT(DSEC21(TIME00,TIME)), NINT(DTOUT(7))) .EQ. 0 .AND. & - DSEC21 (TFN(:,J), TIMEEND) .GT. 0.0 ) DTTST=0. + DTTST = DSEC21 ( TIME0 , TTT ) + END IF +#ifdef W3_OASIS + ELSE + IF ( DTOUT(7).NE.0 ) THEN + ! TFN not initialized at TIME=TIME00, using TIME instead + IF(NINT(DSEC21(TIME00,TIME)) == 0) THEN + ID_OASIS_TIME = 0 + DTTST=0. + ELSE + ID_OASIS_TIME = NINT(DSEC21 ( TIME00 , TFN(:,J) )) + IF ( MOD(NINT(DSEC21(TIME00,TIME)), NINT(DTOUT(7))) .EQ. 0 .AND. & + DSEC21 (TFN(:,J), TIMEEND) .GT. 0.0 ) DTTST=0. + ENDIF ENDIF - ENDIF #endif - END IF - ! + END IF + ! #ifdef W3_T - WRITE (NDST,9071) IDSTR(J), DTTST + WRITE (NDST,9071) IDSTR(J), DTTST #endif - ! - ! 7.a.3 Update time and fields / data - ! - IF ( DTTST .LE. 0. ) THEN + ! + ! 7.a.3 Update time and fields / data + ! + IF ( DTTST .LE. 0. ) THEN #ifdef W3_TIDE - IF ((FLLEVTIDE .AND.(J.EQ.1)).OR.(FLCURTIDE.AND.(J.EQ.2))) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,974) IDFLDS(J) - ELSE + IF ((FLLEVTIDE .AND.(J.EQ.1)).OR.(FLCURTIDE.AND.(J.EQ.2))) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,974) IDFLDS(J) + ELSE #endif - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,972) IDFLDS(J) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,972) IDFLDS(J) #ifdef W3_TIDE - END IF + END IF #endif - ! - ! IC1 : (in context of IC3 & IC2, this is ice thickness) - IF ( J .EQ. -7 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, IERR) - ELSE + ! + ! IC1 : (in context of IC3 & IC2, this is ice thickness) + IF ( J .EQ. -7 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, IERR) + ELSE #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASICM - IF (FLAGSC(J)) FLAGSCI = .TRUE. - IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 + IF (FLAGSC(J)) FLAGSCI = .TRUE. + IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, & + IERR, FLAGSC(J) & #ifdef W3_OASICM - , COUPL_COMM & + , COUPL_COMM & #endif - ) - END IF - IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE. - - ! IC2 : (in context of IC3, this is ice viscosity) - ELSE IF ( J .EQ. -6 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TI2, XXX, XXX, ICEP2, IERR) - ELSE - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TI2, XXX, XXX, ICEP2, & - IERR, FLAGSC(J)) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! IC3 : (in context of IC3, this is ice density) - ELSE IF ( J .EQ. -5 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TI3, XXX, XXX, ICEP3, IERR) - ELSE - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TI3, XXX, XXX, ICEP3, & - IERR, FLAGSC(J)) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! IC4 : (in context of IC3, this is ice modulus) - ELSE IF ( J .EQ. -4 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TI4, XXX, XXX, ICEP4, IERR) - ELSE - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TI4, XXX, XXX, ICEP4, & - IERR, FLAGSC(J)) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! IC5 : ice flow diam. - ELSE IF ( J .EQ. -3 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, IERR) - ELSE + ) + END IF + IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE. + + ! IC2 : (in context of IC3, this is ice viscosity) + ELSE IF ( J .EQ. -6 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TI2, XXX, XXX, ICEP2, IERR) + ELSE + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TI2, XXX, XXX, ICEP2, & + IERR, FLAGSC(J)) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! IC3 : (in context of IC3, this is ice density) + ELSE IF ( J .EQ. -5 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TI3, XXX, XXX, ICEP3, IERR) + ELSE + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TI3, XXX, XXX, ICEP3, & + IERR, FLAGSC(J)) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! IC4 : (in context of IC3, this is ice modulus) + ELSE IF ( J .EQ. -4 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TI4, XXX, XXX, ICEP4, IERR) + ELSE + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TI4, XXX, XXX, ICEP4, & + IERR, FLAGSC(J)) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! IC5 : ice flow diam. + ELSE IF ( J .EQ. -3 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, IERR) + ELSE #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASICM - IF (FLAGSC(J)) FLAGSCI = .TRUE. - IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 + IF (FLAGSC(J)) FLAGSCI = .TRUE. + IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, & + IERR, FLAGSC(J) & #ifdef W3_OASICM - , COUPL_COMM & + , COUPL_COMM & #endif - ) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! MUD1 : mud density - ELSE IF ( J .EQ. -2 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TZN, XXX, XXX, MUDD, IERR) - ELSE - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TZN, XXX, XXX, MUDD, & - IERR, FLAGSC(J)) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! MUD2 : mud thickness - ELSE IF ( J .EQ. -1 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TTN, XXX, XXX, MUDT, IERR) - ELSE - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TTN, XXX, XXX, MUDT, & - IERR, FLAGSC(J)) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! MUD3 : mud viscosity - ELSE IF ( J .EQ. 0 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TVN, XXX, XXX, MUDV, IERR) - ELSE - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TVN, XXX, XXX, MUDV, & - IERR, FLAGSC(J)) - END IF - IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. - - ! LEV : water levels - ELSE IF ( J .EQ. 1 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TLN, XXX, XXX, WLEV, IERR) - ELSE + ) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! MUD1 : mud density + ELSE IF ( J .EQ. -2 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TZN, XXX, XXX, MUDD, IERR) + ELSE + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TZN, XXX, XXX, MUDD, & + IERR, FLAGSC(J)) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! MUD2 : mud thickness + ELSE IF ( J .EQ. -1 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TTN, XXX, XXX, MUDT, IERR) + ELSE + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TTN, XXX, XXX, MUDT, & + IERR, FLAGSC(J)) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! MUD3 : mud viscosity + ELSE IF ( J .EQ. 0 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TVN, XXX, XXX, MUDV, IERR) + ELSE + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TVN, XXX, XXX, MUDV, & + IERR, FLAGSC(J)) + END IF + IF ( IERR .LT. 0 )FLLST_ALL(J) = .TRUE. + + ! LEV : water levels + ELSE IF ( J .EQ. 1 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TLN, XXX, XXX, WLEV, IERR) + ELSE #ifdef W3_TIDE - IF ( FLLEVTIDE ) THEN - IERR=0 - IF ( TLN(1) .EQ. -1 ) THEN - TLN = TIME + IF ( FLLEVTIDE ) THEN + IERR=0 + IF ( TLN(1) .EQ. -1 ) THEN + TLN = TIME + ELSE + CALL TICK21 ( TLN, TIDE_DT ) + END IF ELSE - CALL TICK21 ( TLN, TIDE_DT ) - END IF - ELSE #endif #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASOCM - IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 + IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TLN, XXX, XXX, WLEV, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TLN, XXX, XXX, WLEV, & + IERR, FLAGSC(J) & #ifdef W3_OASOCM - , COUPL_COMM & + , COUPL_COMM & #endif - ) + ) #ifdef W3_TIDE - END IF + END IF #endif - END IF - IF ( IERR .LT. 0 ) FLLSTL = .TRUE. - !could be: IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE. + END IF + IF ( IERR .LT. 0 ) FLLSTL = .TRUE. + !could be: IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE. - ! CUR : currents - ELSE IF ( J .EQ. 2 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TC0, CX0, CY0, XXX, TCN, CXN, CYN, XXX, IERR) - ! + ! CUR : currents + ELSE IF ( J .EQ. 2 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TC0, CX0, CY0, XXX, TCN, CXN, CYN, XXX, IERR) + ! #ifdef W3_SMC - !!Li Reshape the CX0/N CY0/N space for sea-point only current. - !!Li JGLi26Jun2018. - ELSE IF( FSWND ) THEN - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TC0, & - CX0, CY0, XXX, TCN, CXN, CYN, XXX, IERR) - !!Li + !!Li Reshape the CX0/N CY0/N space for sea-point only current. + !!Li JGLi26Jun2018. + ELSE IF( FSWND ) THEN + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TC0, & + CX0, CY0, XXX, TCN, CXN, CYN, XXX, IERR) + !!Li #endif - ELSE -#ifdef W3_TIDE - IF ( FLCURTIDE ) THEN - IERR=0 - IF ( TCN(1) .EQ. -1 ) THEN - TCN = TIME - END IF - TC0(:) = TCN(:) - CALL TICK21 ( TCN, TIDE_DT ) ELSE +#ifdef W3_TIDE + IF ( FLCURTIDE ) THEN + IERR=0 + IF ( TCN(1) .EQ. -1 ) THEN + TCN = TIME + END IF + TC0(:) = TCN(:) + CALL TICK21 ( TCN, TIDE_DT ) + ELSE #endif #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASOCM - IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 + IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TC0, CX0, CY0, XXX, TCN, CXN, CYN, XXX, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TC0, CX0, CY0, XXX, TCN, CXN, CYN, XXX, & + IERR, FLAGSC(J) & #ifdef W3_OASOCM - , COUPL_COMM & + , COUPL_COMM & #endif - ) + ) #ifdef W3_TIDE - END IF + END IF #endif - END IF + END IF - ! WND : winds - ELSE IF ( J .EQ. 3 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TW0, WX0, WY0, DT0, TWN, WXN, WYN, DTN, IERR) - ! + ! WND : winds + ELSE IF ( J .EQ. 3 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TW0, WX0, WY0, DT0, TWN, WXN, WYN, DTN, IERR) + ! #ifdef W3_SMC - !!Li Reshape the WX0/N WY0/N space for sea-point only wind. - !!Li JGLi26Jun2018. - ELSE IF( FSWND ) THEN - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TW0, & - WX0, WY0, DT0, TWN, WXN, WYN, DTN, IERR) - !!Li + !!Li Reshape the WX0/N WY0/N space for sea-point only wind. + !!Li JGLi26Jun2018. + ELSE IF( FSWND ) THEN + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TW0, & + WX0, WY0, DT0, TWN, WXN, WYN, DTN, IERR) + !!Li #endif - ELSE + ELSE #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASACM - IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 + IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TW0, WX0, WY0, DT0, TWN, WXN, WYN, DTN, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TW0, WX0, WY0, DT0, TWN, WXN, WYN, DTN, & + IERR, FLAGSC(J) & #ifdef W3_OASACM - , COUPL_COMM & + , COUPL_COMM & #endif - ) - END IF + ) + END IF - ! ICE : ice conc. - ELSE IF ( J .EQ. 4 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TTT, XXX, XXX, XXX, TIN, XXX, BERGI, ICEI, IERR) - ELSE + ! ICE : ice conc. + ELSE IF ( J .EQ. 4 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TTT, XXX, XXX, XXX, TIN, XXX, BERGI, ICEI, IERR) + ELSE #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASICM - IF (FLAGSC(J)) FLAGSCI = .TRUE. - IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 + IF (FLAGSC(J)) FLAGSCI = .TRUE. + IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TTT, XXX, XXX, XXX, TIN, XXX, BERGI, ICEI, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TTT, XXX, XXX, XXX, TIN, XXX, BERGI, ICEI, & + IERR, FLAGSC(J) & #ifdef W3_OASICM - , COUPL_COMM & + , COUPL_COMM & #endif - ) - IF ( IERR .LT. 0 ) FLLSTI = .TRUE. - !could be: IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE. - END IF + ) + IF ( IERR .LT. 0 ) FLLSTI = .TRUE. + !could be: IF ( IERR .LT. 0 ) FLLST_ALL(J) = .TRUE. + END IF - ! TAU : atmospheric momentum - ELSE IF ( J .EQ. 5 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TU0, UX0, UY0, XXX, TUN, UXN, UYN, XXX, IERR) - ! + ! TAU : atmospheric momentum + ELSE IF ( J .EQ. 5 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TU0, UX0, UY0, XXX, TUN, UXN, UYN, XXX, IERR) + ! #ifdef W3_SMC - !!Li Reshape the UX0/N UY0/N space for sea-point only current. - !!Li JGLi26Jun2018. - ELSE IF( FSWND ) THEN - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TU0, & - UX0, UY0, XXX, TUN, UXN, UYN, XXX, IERR) - !!Li + !!Li Reshape the UX0/N UY0/N space for sea-point only current. + !!Li JGLi26Jun2018. + ELSE IF( FSWND ) THEN + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TU0, & + UX0, UY0, XXX, TUN, UXN, UYN, XXX, IERR) + !!Li #endif - ELSE + ELSE #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASACM - IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 + IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TU0, UX0, UY0, XXX, TUN, UXN, UYN, XXX, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TU0, UX0, UY0, XXX, TUN, UXN, UYN, XXX, & + IERR, FLAGSC(J) & #ifdef W3_OASACM - , COUPL_COMM & + , COUPL_COMM & #endif - ) - END IF + ) + END IF - ! RHO : air density - ELSE IF ( J .EQ. 6 ) THEN - IF ( FLH(J) ) THEN - CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & - TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& - TR0, XXX, XXX, RH0, TRN, XXX, XXX, RHN, IERR) + ! RHO : air density + ELSE IF ( J .EQ. 6 ) THEN + IF ( FLH(J) ) THEN + CALL W3FLDH (J, NDST, NDSEN, NX, NY, NX, NY, & + TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& + TR0, XXX, XXX, RH0, TRN, XXX, XXX, RHN, IERR) #ifdef W3_SMC - !!Li Reshape the RH0/N space for sea-point only current. - !!Li JGLi26Jun2018. - ELSE IF( FSWND ) THEN - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TR0, & - XXX, XXX, RH0, TRN, XXX, XXX, RHN, IERR) - !!Li + !!Li Reshape the RH0/N space for sea-point only current. + !!Li JGLi26Jun2018. + ELSE IF( FSWND ) THEN + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, NSEA, 1, NSEA, 1, TIME0, TIMEN, TR0, & + XXX, XXX, RH0, TRN, XXX, XXX, RHN, IERR) + !!Li #endif - ELSE + ELSE #ifdef W3_OASIS - COUPL_COMM = MPI_COMM + COUPL_COMM = MPI_COMM #endif #ifdef W3_OASACM - IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 + IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif - CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & - NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & - TR0, XXX, XXX, RH0, TRN, XXX, XXX, RHN, & - IERR, FLAGSC(J) & + CALL W3FLDG ('READ', IDSTR(J), NDSF(J), & + NDST, NDSEN, NX, NY, NX, NY, TIME0, TIMEN, & + TR0, XXX, XXX, RH0, TRN, XXX, XXX, RHN, & + IERR, FLAGSC(J) & #ifdef W3_OASACM - , COUPL_COMM & + , COUPL_COMM & #endif - ) - IF ( IERR .LT. 0 ) FLLSTR = .TRUE. - END IF + ) + IF ( IERR .LT. 0 ) FLLSTR = .TRUE. + END IF - ! Assim data - ELSE IF ( J .EQ. 7 ) THEN - CALL W3FLDD ('SIZE', IDSTR(J), NDSF(J), NDST, & - NDSEN, TIME0, T0N, RCLD(J), NDT(J), & - NDTNEW, DATA0, IERR ) - IF ( IERR .LT. 0 ) THEN - INFLAGS1(J) = .FALSE. - IF ( ALLOCATED(DATA0) ) DEALLOCATE(DATA0) - ELSE - NDT(J) = NDTNEW - IF ( ALLOCATED(DATA0) ) DEALLOCATE(DATA0) - ALLOCATE ( DATA0(RCLD(J),NDT(J)) ) - CALL W3FLDD ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, TIME0, T0N, RCLD(J), NDT(J), & + ! Assim data + ELSE IF ( J .EQ. 7 ) THEN + CALL W3FLDD ('SIZE', IDSTR(J), NDSF(J), NDST, & + NDSEN, TIME0, T0N, RCLD(J), NDT(J), & NDTNEW, DATA0, IERR ) - END IF + IF ( IERR .LT. 0 ) THEN + INFLAGS1(J) = .FALSE. + IF ( ALLOCATED(DATA0) ) DEALLOCATE(DATA0) + ELSE + NDT(J) = NDTNEW + IF ( ALLOCATED(DATA0) ) DEALLOCATE(DATA0) + ALLOCATE ( DATA0(RCLD(J),NDT(J)) ) + CALL W3FLDD ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, TIME0, T0N, RCLD(J), NDT(J), & + NDTNEW, DATA0, IERR ) + END IF - ! Assim data - ELSE IF ( J .EQ. 8 ) THEN - CALL W3FLDD ('SIZE', IDSTR(J), NDSF(J), NDST, & - NDSEN, TIME0, T1N, RCLD(J), NDT(J), & - NDTNEW, DATA1, IERR ) - IF ( IERR .LT. 0 ) THEN - INFLAGS1(J) = .FALSE. - IF ( ALLOCATED(DATA1) ) DEALLOCATE(DATA1) - ELSE - NDT(J) = NDTNEW - IF ( ALLOCATED(DATA1) ) DEALLOCATE(DATA1) - ALLOCATE ( DATA1(RCLD(J),NDT(J)) ) - CALL W3FLDD ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, TIME0, T1N, RCLD(J), NDT(J), & + ! Assim data + ELSE IF ( J .EQ. 8 ) THEN + CALL W3FLDD ('SIZE', IDSTR(J), NDSF(J), NDST, & + NDSEN, TIME0, T1N, RCLD(J), NDT(J), & NDTNEW, DATA1, IERR ) - END IF + IF ( IERR .LT. 0 ) THEN + INFLAGS1(J) = .FALSE. + IF ( ALLOCATED(DATA1) ) DEALLOCATE(DATA1) + ELSE + NDT(J) = NDTNEW + IF ( ALLOCATED(DATA1) ) DEALLOCATE(DATA1) + ALLOCATE ( DATA1(RCLD(J),NDT(J)) ) + CALL W3FLDD ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, TIME0, T1N, RCLD(J), NDT(J), & + NDTNEW, DATA1, IERR ) + END IF - ! Assim data - ELSE IF ( J .EQ. 9 ) THEN - CALL W3FLDD ('SIZE', IDSTR(J), NDSF(J), NDST, & - NDSEN, TIME0, T2N, RCLD(J), NDT(J), & - NDTNEW, DATA2, IERR ) - IF ( IERR .LT. 0 ) THEN - INFLAGS1(J) = .FALSE. - IF ( ALLOCATED(DATA2) ) DEALLOCATE(DATA2) - ELSE - NDT(J) = NDTNEW - IF ( ALLOCATED(DATA2) ) DEALLOCATE(DATA2) - ALLOCATE ( DATA2(RCLD(J),NDT(J)) ) - CALL W3FLDD ('READ', IDSTR(J), NDSF(J), NDST, & - NDSEN, TIME0, T2N, RCLD(J), NDT(J), & + ! Assim data + ELSE IF ( J .EQ. 9 ) THEN + CALL W3FLDD ('SIZE', IDSTR(J), NDSF(J), NDST, & + NDSEN, TIME0, T2N, RCLD(J), NDT(J), & NDTNEW, DATA2, IERR ) + IF ( IERR .LT. 0 ) THEN + INFLAGS1(J) = .FALSE. + IF ( ALLOCATED(DATA2) ) DEALLOCATE(DATA2) + ELSE + NDT(J) = NDTNEW + IF ( ALLOCATED(DATA2) ) DEALLOCATE(DATA2) + ALLOCATE ( DATA2(RCLD(J),NDT(J)) ) + CALL W3FLDD ('READ', IDSTR(J), NDSF(J), NDST, & + NDSEN, TIME0, T2N, RCLD(J), NDT(J), & + NDTNEW, DATA2, IERR ) + END IF + + ! Track + ELSE IF ( J .EQ. 10 ) THEN + CALL W3FLDM (4, NDST, NDSEN, TIME0, TIMEN, NH(4), & + NHMAX, THO, HA, HD, TG0, GA0, GD0, & + TGN, GAN, GDN, IERR) END IF + ! + IF ( IERR.GT.0 ) & + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + IF ( IERR.LT.0 .AND. IAPROC.EQ.NAPOUT ) WRITE (NDSO,973) IDFLDS(J) + - ! Track - ELSE IF ( J .EQ. 10 ) THEN - CALL W3FLDM (4, NDST, NDSEN, TIME0, TIMEN, NH(4), & - NHMAX, THO, HA, HD, TG0, GA0, GD0, & - TGN, GAN, GDN, IERR) + END IF ! DTTST .LE. 0. + ! + ! 7.a.4 Update next ending time + ! + IF ( INFLAGS1(J) ) THEN + TTT = TFN(:,J) + DTTST = DSEC21 ( TTT , TTIME ) + IF ( DTTST.GT.0. .AND. .NOT. & + ( (FLLSTL .AND. J.EQ.1) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-7) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-6) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-5) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-4) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-3) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-2) .OR. & + (FLLST_ALL(J) .AND. J.EQ.-1) .OR. & + (FLLST_ALL(J) .AND. J.EQ.0 ) .OR. & + (FLLSTI .AND. J.EQ.4) .OR. & + (FLLSTR .AND. J.EQ.6) ) ) THEN + TTIME = TTT + ! notes: if model has run out beyond field input, then this line should not + ! be reached. + END IF END IF ! - IF ( IERR.GT.0 ) GOTO 2222 - IF ( IERR.LT.0 .AND. IAPROC.EQ.NAPOUT ) WRITE (NDSO,973) IDFLDS(J) - - - END IF ! DTTST .LE. 0. - ! - ! 7.a.4 Update next ending time + END IF ! INFLAGSC1(J) ! + END DO ! J=JFIRST,10 + ! + ! update the next assimilation data time + ! + call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 8') + + TDN = TTIME + CALL TICK21 ( TDN, 1. ) + DO J=7, 9 IF ( INFLAGS1(J) ) THEN TTT = TFN(:,J) - DTTST = DSEC21 ( TTT , TTIME ) - IF ( DTTST.GT.0. .AND. .NOT. & - ( (FLLSTL .AND. J.EQ.1) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-7) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-6) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-5) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-4) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-3) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-2) .OR. & - (FLLST_ALL(J) .AND. J.EQ.-1) .OR. & - (FLLST_ALL(J) .AND. J.EQ.0 ) .OR. & - (FLLSTI .AND. J.EQ.4) .OR. & - (FLLSTR .AND. J.EQ.6) ) ) THEN - TTIME = TTT - ! notes: if model has run out beyond field input, then this line should not - ! be reached. - END IF + DTTST = DSEC21 ( TTT , TDN ) + IF ( DTTST.GT.0. ) TDN = TTT END IF - ! - END IF ! INFLAGSC1(J) - ! - END DO ! J=JFIRST,10 - ! - ! update the next assimilation data time - ! -#ifdef W3_OASIS - FIRST_STEP = .FALSE. -#endif - - call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 8') - - TDN = TTIME - CALL TICK21 ( TDN, 1. ) - DO J=7, 9 - IF ( INFLAGS1(J) ) THEN - TTT = TFN(:,J) - DTTST = DSEC21 ( TTT , TDN ) - IF ( DTTST.GT.0. ) TDN = TTT - END IF - END DO + END DO ! #ifdef W3_T - WRITE (NDST,9072) '0-N', TIME0, TTIME, & - IDSTR(-7), INFLAGS1(-7), TI1, & - IDSTR(-6), INFLAGS1(-6), TI2, & - IDSTR(-5), INFLAGS1(-5), TI3, & - IDSTR(-4), INFLAGS1(-4), TI4, & - IDSTR(-3), INFLAGS1(-3), TI5, & - IDSTR(-2), INFLAGS1(-2), TZN, & - IDSTR(-1), INFLAGS1(-1), TTN, & - IDSTR(0), INFLAGS1(0), TVN, & - IDSTR(1), INFLAGS1(1), TLN, & - IDSTR(2), INFLAGS1(2), TC0, TCN, & - IDSTR(3), INFLAGS1(3), TW0, TWN, & - IDSTR(4), INFLAGS1(4), TIN, & - IDSTR(5), INFLAGS1(5), TU0, TUN, & - IDSTR(6), INFLAGS1(6), TR0, TRN, & - IDSTR(7), INFLAGS1(7), T0N, & - IDSTR(8), INFLAGS1(8), T1N, & - IDSTR(9), INFLAGS1(9), T2N, TDN, & - IDSTR(10), INFLAGS1(10), TG0, TGN -#endif - ! - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' - ! - ! 7.b Run the wave model for the given interval - ! - TIME0 = TTIME - ! - CALL W3WAVE ( 1, ODAT, TIME0 & -#ifdef W3_OASIS - , .TRUE., .FALSE., MPI_COMM, TIMEN & -#endif - ) - call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 9') - ! - ! The following lines prevents us from trying to read past the end - ! of the files. This feature existed in v3.14. - ! "1" is for water levels - ! "4" is for ice concentration: - ! "6" is for air density: - IF ( FLLSTL ) INFLAGS1(1) = .FALSE. - IF ( FLLSTI ) INFLAGS1(4) = .FALSE. - IF ( FLLSTR ) INFLAGS1(6) = .FALSE. - - ! We include something like this for mud and ice parameters also: - DO J=-7,0 - IF (FLLST_ALL(J))THEN - INFLAGS1(J)=.FALSE. - END IF - END DO - - ! - ! 7.c Run data assimilation at ending time - ! - DTTST = DSEC21 ( TIME , TDN ) - IF ( DTTST .EQ. 0 ) THEN - CALL STME21 ( TIME0 , DTME21 ) - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,975) DTME21 + WRITE (NDST,9072) '0-N', TIME0, TTIME, & + IDSTR(-7), INFLAGS1(-7), TI1, & + IDSTR(-6), INFLAGS1(-6), TI2, & + IDSTR(-5), INFLAGS1(-5), TI3, & + IDSTR(-4), INFLAGS1(-4), TI4, & + IDSTR(-3), INFLAGS1(-3), TI5, & + IDSTR(-2), INFLAGS1(-2), TZN, & + IDSTR(-1), INFLAGS1(-1), TTN, & + IDSTR(0), INFLAGS1(0), TVN, & + IDSTR(1), INFLAGS1(1), TLN, & + IDSTR(2), INFLAGS1(2), TC0, TCN, & + IDSTR(3), INFLAGS1(3), TW0, TWN, & + IDSTR(4), INFLAGS1(4), TIN, & + IDSTR(5), INFLAGS1(5), TU0, TUN, & + IDSTR(6), INFLAGS1(6), TR0, TRN, & + IDSTR(7), INFLAGS1(7), T0N, & + IDSTR(8), INFLAGS1(8), T1N, & + IDSTR(9), INFLAGS1(9), T2N, TDN, & + IDSTR(10), INFLAGS1(10), TG0, TGN +#endif + ! + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' + ! + ! 7.b Run the wave model for the given interval + ! + TIME0 = TTIME ! - FLGDAS(1) = DSEC21(TIME,T0N) .EQ. 0. - FLGDAS(2) = DSEC21(TIME,T1N) .EQ. 0. - FLGDAS(3) = DSEC21(TIME,T2N) .EQ. 0. + CALL W3WAVE ( 1, ODAT, TIME0 & +#ifdef W3_OASIS + , .TRUE., .FALSE., MPI_COMM, TIMEN & +#endif + ) + call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 9') ! - CALL W3WDAS ( FLGDAS, RCLD, NDT, DATA0, DATA1, DATA2 ) + ! The following lines prevents us from trying to read past the end + ! of the files. This feature existed in v3.14. + ! "1" is for water levels + ! "4" is for ice concentration: + ! "6" is for air density: + IF ( FLLSTL ) INFLAGS1(1) = .FALSE. + IF ( FLLSTI ) INFLAGS1(4) = .FALSE. + IF ( FLLSTR ) INFLAGS1(6) = .FALSE. + + ! We include something like this for mud and ice parameters also: + DO J=-7,0 + IF (FLLST_ALL(J))THEN + INFLAGS1(J)=.FALSE. + END IF + END DO + ! - ! 7.d Call wave model again after data assimilation for output only + ! 7.c Run data assimilation at ending time ! - DTTST = DSEC21 ( TIME , TIMEN ) + DTTST = DSEC21 ( TIME , TDN ) + IF ( DTTST .EQ. 0 ) THEN + CALL STME21 ( TIME0 , DTME21 ) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,975) DTME21 + ! + FLGDAS(1) = DSEC21(TIME,T0N) .EQ. 0. + FLGDAS(2) = DSEC21(TIME,T1N) .EQ. 0. + FLGDAS(3) = DSEC21(TIME,T2N) .EQ. 0. + ! + CALL W3WDAS ( FLGDAS, RCLD, NDT, DATA0, DATA1, DATA2 ) + ! + ! 7.d Call wave model again after data assimilation for output only + ! + DTTST = DSEC21 ( TIME , TIMEN ) - IF ( DTTST .EQ. 0. ) THEN - IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' - CALL W3WAVE ( 1, ODAT, TIME0 & + IF ( DTTST .EQ. 0. ) THEN + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' + CALL W3WAVE ( 1, ODAT, TIME0 & #ifdef W3_OASIS - , .TRUE., .FALSE., MPI_COMM, TIMEN & + , .TRUE., .FALSE., MPI_COMM, TIMEN & #endif - ) + ) + END IF END IF - END IF - ! - ! 7.e Check times - ! - call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 10') + ! + ! 7.e Check times + ! + call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 10') - DTTST = DSEC21 ( TIME0 , TIMEN ) - IF ( DTTST .GT. 0. ) GOTO 700 + DTTST = DSEC21 ( TIME0 , TIMEN ) + END DO ! timestepping ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! End of shel ! - GOTO 2222 - ! - ! Error escape locations - ! -2000 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1000 ) - ! -2001 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) - CALL EXTCDE ( 1001 ) - ! -2002 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) IERR - CALL EXTCDE ( 1002 ) - ! -2102 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1102) - CALL EXTCDE ( 1102 ) - ! -2003 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) - CALL EXTCDE ( 1003 ) - ! -2104 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1104) IERR - CALL EXTCDE ( 1104 ) - ! -2004 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1004) IERR - CALL EXTCDE ( 1004 ) - ! -2005 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1005) IDTST - CALL EXTCDE ( 1005 ) - ! -2006 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1006) IDTST, NH(J) - CALL EXTCDE ( 1006 ) - ! -2062 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1062) IDTST - CALL EXTCDE ( 1062 ) - ! -2007 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1007) - CALL EXTCDE ( 1007 ) - ! -2008 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1008) IERR - CALL EXTCDE ( 1008 ) - ! -#ifdef W3_COU -2009 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1009) ODAT(33), NINT(DTMAX) - CALL EXTCDE ( 1009 ) -#endif - ! -2054 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1054) - CALL EXTCDE ( 1054 ) -2222 CONTINUE - ! -#ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) -#endif - ! - IF ( IAPROC .EQ. NAPOUT ) THEN - CALL DATE_AND_TIME ( VALUES=CLKDT3 ) - CLKFIN = MAX(TDIFF ( CLKDT1,CLKDT2 ), 0.) - CLKFEL = MAX(TDIFF ( CLKDT1,CLKDT3 ), 0.) - WRITE (NDSO,997) CLKFIN - WRITE (NDSO,998) CLKFEL - IF ( NDSO .NE. NDS(1) ) THEN - WRITE (NDS(1),997) CLKFIN - WRITE (NDS(1),998) CLKFEL - END IF - WRITE (NDSO,999) - END IF - ! -#ifdef W3_NCO - ! IF ( IAPROC .EQ. 1 ) CALL W3TAGE('WAVEFCST') -#endif -#ifdef W3_OASIS - IF (OASISED.EQ.1) THEN - CALL CPL_OASIS_FINALIZE - ELSE -#endif -#ifdef W3_MPI - CALL MPI_FINALIZE ( IERR_MPI ) -#endif -#ifdef W3_OASIS - END IF -#endif - ! + CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! ! Formats ! @@ -2829,17 +2737,6 @@ PROGRAM W3SHEL #endif 975 FORMAT (/' Data assimmilation at ',A) ! -997 FORMAT (/' Initialization time :',F10.2,' s') -998 FORMAT ( ' Elapsed time :',F10.2,' s') - ! -999 FORMAT(/' End of program '/ & - ' ===================================='/ & - ' WAVEWATCH III Program shell '/) - ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & ' PREMATURE END OF INPUT FILE'/) ! @@ -2854,14 +2751,6 @@ PROGRAM W3SHEL 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & ' ILLEGAL TIME INTERVAL'/) ! -1104 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ERROR IN OPENING POINT FILE'/ & - ' IOSTAT =',I5/) - ! -1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ERROR IN READING FROM POINT FILE'/ & - ' IOSTAT =',I5/) - ! 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & ' ILLEGAL ID STRING HOMOGENEOUS FIELD : ',A/) ! @@ -2874,10 +2763,6 @@ PROGRAM W3SHEL 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & ' INSUFFICIENT DATA FOR HOMOGENEOUS FIELDS'/) ! -1008 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & - ' ERROR IN OPENING OUTPUT FILE'/ & - ' IOSTAT =',I5/) - ! #ifdef W3_COU 1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3SHEL : *** '/ & ' COUPLING TIME STEP NOT MULTIPLE OF'/ & @@ -2955,4 +2840,121 @@ PROGRAM W3SHEL !/ !/ End of W3SHEL ----------------------------------------------------- / !/ + !/ + !/ Internal subroutine FINALISE--------------------------------------- / + !/ +CONTAINS + !/ ------------------------------------------------------------------- / + !> @brief Stops the execution of the program. + !> + !> @details Data is read from the grid output file out_pnt.ww3 (raw data) + !> and from the file ww3_ounp.nml or ww3_ounp.inp ( NDSI). + !> Model definition and raw data files are read using WAVEWATCH III + !> subroutines. + !> + !> @author J.M. Castillo + !> @date 04-Jun-2025 + SUBROUTINE FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS, CLKDT1, CLKDT2) + !/ + !/ +-----------------------------------+ + !/ | WAVEWATCH III NOAA/NCEP | + !/ | H. L. Tolman | + !/ | FORTRAN 90 | + !/ | Last update : 04-Jun-2025 | + !/ +-----------------------------------+ + !/ + !/ 04-Jun-2025 : First implementation ( version X.XX ) + !/ + ! 1. Purpose : + ! + ! Perform a ww3_shel stop with exit messages. + ! + ! 2. Method : + ! + ! Machine dependent. + ! + ! 3. Parameters : + ! + ! Parameter list + ! ---------------------------------------------------------------- + ! MPI_COMM Int. I MPI communicator + ! IERR_MPI Int. O MPI error code + ! NDSO Int. I Output unit number + ! NDS Int. I Dataset unit number + ! CLKDT1 Int. I Time and date at the start of the run + ! CLKDT2 Int. I Time and date before timestepping + ! ---------------------------------------------------------------- + ! + ! 4. Subroutines used : + ! + ! 5. Called by : + ! + ! Any. + ! + ! 9. Switches : + ! + ! !/MPI MPI finalise interface if active + ! + ! 10. Source code : + ! + !/ ------------------------------------------------------------------- / + + USE W3ODATMD, ONLY: IAPROC, NAPOUT + + IMPLICIT NONE + + ! Parameter list + INTEGER, INTENT(IN) :: MPI_COMM + INTEGER, INTENT(OUT) :: IERR_MPI + INTEGER, INTENT(IN) :: NDSO + INTEGER, INTENT(IN) :: NDS + INTEGER, INTENT(IN) :: CLKDT1(8), CLKDT2(8) + + ! Local parameters + REAL :: CLKFIN, CLKFEL + INTEGER :: CLKDT3(8) + +#ifdef W3_MPI + CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) +#endif + ! + IF ( IAPROC .EQ. NAPOUT ) THEN + CALL DATE_AND_TIME ( VALUES=CLKDT3 ) + CLKFIN = MAX(TDIFF ( CLKDT1,CLKDT2 ), 0.) + CLKFEL = MAX(TDIFF ( CLKDT1,CLKDT3 ), 0.) + WRITE (NDSO,997) CLKFIN + WRITE (NDSO,998) CLKFEL + IF ( NDSO .NE. NDS ) THEN + WRITE (NDS,997) CLKFIN + WRITE (NDS,998) CLKFEL + END IF + WRITE (NDSO,999) + END IF + ! +#ifdef W3_NCO +! IF ( IAPROC .EQ. 1 ) CALL W3TAGE('WAVEFCST') +#endif +#ifdef W3_OASIS + IF (OASISED.EQ.1) THEN + CALL CPL_OASIS_FINALIZE + ELSE +#endif +#ifdef W3_MPI + CALL MPI_FINALIZE ( IERR_MPI ) +#endif +#ifdef W3_OASIS + END IF +#endif + ! + STOP + ! +997 FORMAT (/' Initialization time :',F10.2,' s') +998 FORMAT ( ' Elapsed time :',F10.2,' s') + ! +999 FORMAT(/' End of program '/ & + ' ===================================='/ & + ' WAVEWATCH III Program shell '/) + + END SUBROUTINE FINALISE + END PROGRAM W3SHEL diff --git a/model/src/ww3_strt.F90 b/model/src/ww3_strt.F90 index b4bcad3cae..d098eb3967 100644 --- a/model/src/ww3_strt.F90 +++ b/model/src/ww3_strt.F90 @@ -62,6 +62,7 @@ PROGRAM W3STRT !/ 05-Jul-2011 : Revert to X-Y gaussian shape ( version 4.01 ) !/ 06-Mar-2012 : Hardening output. ( version 4.07 ) !/ 06-Jun-2018 : Add DEBUGINIT/EXPORTWWM ( version 6.04 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ !/ Copyright 2009-2012 National Weather Service (NWS), @@ -129,6 +130,8 @@ PROGRAM W3STRT ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! STRACE Subr. Id. Subroutine tracing. ! NEXTLN Subr. Id. Get next line from input filw + ! EXTIOF Subr. Id. Abort if error when I/O file + ! EXTOPN Subr. Id. Abort if error when opening file ! EXTCDE Subr. Id. Abort program as graceful as possible. ! EJ5P Func. Id. Five parameter JONSWAP spectrum. ! PRT1DS Subr. W3ARRYMD Print plot of 1-D spectrum. @@ -215,7 +218,7 @@ PROGRAM W3STRT USE W3ADATMD, ONLY: W3NAUX, W3SETA #endif USE W3ODATMD, ONLY: W3NOUT, W3SETO, FLOGRR - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EJ5P, EXTCDE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EJ5P, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -338,10 +341,11 @@ PROGRAM W3STRT IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,900) ! J = LEN_TRIM(FNMPRE) - OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_strt.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) + OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_strt.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR, 'W3STRT', 'INPUT', 10) REWIND (NDSI) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) IF (COMSTR.EQ.' ') COMSTR = '$' IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,901) COMSTR ! @@ -361,7 +365,10 @@ PROGRAM W3STRT ! #ifdef W3_DIST NSEAL = 1 + (NSEA-IAPROC)/NAPROC - IF ( NSEA .LT. NAPROC ) GOTO 803 + IF ( NSEA .LT. NAPROC ) THEN + IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) NSEA, NAPROC + CALL EXTCDE ( 13 ) + END IF #endif ! CALL W3DIMW ( 1, NDSE, NDST ) @@ -372,7 +379,8 @@ PROGRAM W3STRT ! 3. Read type from input file. ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802) ITYPE + READ (NDSI,*,IOSTAT=IERR) ITYPE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) IF ( ITYPE.LT.1 .OR. ITYPE.GT.5 ) THEN IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) ITYPE CALL EXTCDE ( 1 ) @@ -388,8 +396,9 @@ PROGRAM W3STRT ! 4.a Read parameters. ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802) & + READ (NDSI,*,IOSTAT=IERR) & FP, SIP, THM, NCOS, XM, SIX, YM, SIY, HMAX + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) FP = MAX ( 0.5 * TPIINV * SIG(1) , FP ) SIP = MAX ( 0. , SIP ) DO @@ -592,8 +601,9 @@ PROGRAM W3STRT ! 5.a Read parameters. ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802) & + READ (NDSI,*,IOSTAT=IERR) & ALFA, FP, THM, GAMMA, SIGA, SIGB, XM, SIX, YM, SIY + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) ! IF (ALFA.LE.0.) ALFA = 0.0081 IF (FP .LE.0.) FP = 0.10 @@ -778,15 +788,17 @@ PROGRAM W3STRT ! 7.a Read parameters. ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802) FACS + READ (NDSI,*,IOSTAT=IERR) FACS + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) IF ( FACS .LE. 0. ) FACS = 1. IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,970) FACS ! ! 7.b Read and rescale spectrum. ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=801,ERR=802) & + READ (NDSI,*,IOSTAT=IERR) & ((FINP(IK,ITH),IK=1,NK),ITH=1,NTH) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) ! FINP = FINP * FACS / TPI ! @@ -909,29 +921,6 @@ PROGRAM W3STRT IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,995) CALL W3IORS ( INXOUT, NDSR, SIG(NK) ) ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1000) IERR - CALL EXTCDE ( 10 ) - ! -801 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) - CALL EXTCDE ( 11 ) - ! -802 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) IERR - CALL EXTCDE ( 12 ) - ! -#ifdef W3_DIST -803 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1003) NSEA, NAPROC - CALL EXTCDE ( 13 ) -#endif - ! -888 CONTINUE IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,999) #ifdef W3_MPI CALL MPI_FINALIZE ( IERR_MPI ) @@ -1000,17 +989,6 @@ PROGRAM W3STRT ' ========================================='/ & ' WAVEWATCH III Initial conditions '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3STRT : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3STRT : '/ & - ' PREMATURE END OF INPUT FILE'/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3STRT : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3STRT : '/ & ' ILLEGAL TYPE, ITYPE =',I4/) ! diff --git a/model/src/ww3_trck.F90 b/model/src/ww3_trck.F90 index ab125f8401..069dec7876 100644 --- a/model/src/ww3_trck.F90 +++ b/model/src/ww3_trck.F90 @@ -30,6 +30,7 @@ PROGRAM W3TRCK !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) !/ (W. E. Rogers & T. J. Campbell, NRL) !/ 05-Mar-2014 : Now calls W3SETG for pointer def. ( version 4.18 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -76,7 +77,7 @@ PROGRAM W3TRCK !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR USE W3ODATMD, ONLY : W3NOUT, W3SETO, FNMPRE - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -142,14 +143,16 @@ PROGRAM W3TRCK WRITE (NDSO,900) ! J = LEN_TRIM(FNMPRE) - OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_trck.inp',STATUS='OLD', & - ERR=805,IOSTAT=IERR) - READ (NDSI,'(A)',END=806,ERR=807) COMSTR + OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_trck.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR, 'W3TRCK', 'INPUT', 5) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT',6) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=806,ERR=807) NK, NTH + READ (NDSI,*,IOSTAT=IERR) NK, NTH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT',6) NSPEC = NK * NTH WRITE (NDSO,902) NK, NTH ! @@ -159,8 +162,10 @@ PROGRAM W3TRCK WRITE (NDSO,920) ! OPEN (NDSINP,FILE=FNMPRE(:J)//'track_o.ww3',form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=800,IOSTAT=IERR) - READ (NDSINP,ERR=801,IOSTAT=IERR) IDSTR, FLAGLL, MK, MTH, XFR + STATUS='OLD',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3TRCK','INPUT DATA',1) + READ (NDSINP,IOSTAT=IERR) IDSTR, FLAGLL, MK, MTH, XFR + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT DATA',2) ! IF ( FLAGLL ) THEN FACTOR = 1. @@ -168,244 +173,225 @@ PROGRAM W3TRCK FACTOR = 1.E-3 END IF ! - IF ( IDSTR .NE. IDTST ) GOTO 810 - IF ( NK.NE.MK .OR. NTH.NE.MTH ) GOTO 811 + IF ( IDSTR .NE. IDTST ) THEN + WRITE (NDSE,1010) IDSTR, IDTST + CALL EXTCDE ( 5 ) + END IF + IF ( NK.NE.MK .OR. NTH.NE.MTH ) THEN + WRITE (NDSE,1011) MK, MTH, NK, NTH + CALL EXTCDE ( 6 ) + END IF ALLOCATE ( SIG(MK), DSIP(MK), SPEC(MK,MTH) ) ! - READ (NDSINP,ERR=801,IOSTAT=IERR) TH1, DTH, SIG, DSIP + READ (NDSINP,IOSTAT=IERR) TH1, DTH, SIG, DSIP + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT DATA',2) ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 3. Open output file and prepare ! WRITE (NDSO,930) ! - OPEN (NDSOUT,FILE=FNMPRE(:J)//'track.ww3', & - FORM='FORMATTED',ERR=802,IOSTAT=IERR) + OPEN (NDSOUT,FILE=FNMPRE(:J)//'track.ww3',FORM='FORMATTED',IOSTAT=IERR) + IF (IERR.NE.0) CALL EXTOPN(NDSE,IERR,'W3TRCK','OUTPUT',3) ! - WRITE (NDSOUT,980,ERR=803,IOSTAT=IERR) IDSTR - WRITE (NDSOUT,981,ERR=803,IOSTAT=IERR) MK, MTH, TH1, DTH - WRITE (NDSOUT,982,ERR=803,IOSTAT=IERR) SIG - WRITE (NDSOUT,983,ERR=803,IOSTAT=IERR) DSIP + WRITE (NDSOUT,980,IOSTAT=IERR) IDSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + WRITE (NDSOUT,981,IOSTAT=IERR) MK, MTH, TH1, DTH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + WRITE (NDSOUT,982,IOSTAT=IERR) SIG + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + WRITE (NDSOUT,983,IOSTAT=IERR) DSIP + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 4. Process data ! ILOC = 0 ISPEC = 0 - READ (NDSINP,END=444, ERR=801,IOSTAT=IERR) TTST - BACKSPACE (NDSINP) - WRITE (NDSO,940) - ! -400 CONTINUE - ! - ! 4.a Read/write basic data - ! - READ (NDSINP,END=444, ERR=801,IOSTAT=IERR) TIME, X, Y, TSTSTR, & - TRCKID - IF ( FLAGLL ) THEN - WRITE (NDSOUT,984,ERR=803,IOSTAT=IERR) & - TIME, FACTOR*X, FACTOR*Y, TSTSTR, TRCKID - ELSE - WRITE (NDSOUT,974,ERR=803,IOSTAT=IERR) & - TIME, FACTOR*X, FACTOR*Y, TSTSTR, TRCKID - END IF - ! - IF ( TIME(1).EQ.TTST(1) .AND. TIME(2).EQ.TTST(2) ) THEN - ILOC = ILOC + 1 - IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 - ENDIF - IF ( TIME(1).NE.TTST(1) .OR. TIME(2).NE.TTST(2) ) THEN - CALL STME21 ( TTST , STIME ) - WRITE (NDSO,941) STIME, ILOC, ISPEC - ILOC = 1 - ISPEC = 0 - IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 - TTST(1) = TIME(1) - TTST(2) = TIME(2) - ENDIF - ! - ! 4.b Check if sea point - ! - IF ( TSTSTR .NE. 'SEA' ) GOTO 400 - ! - ! 4.c Read all data - ! - READ (NDSINP,ERR=801,IOSTAT=IERR) DW, CX, CY, WX, WY, UST, AS, & - SPEC - IF ( UST .LT. 0. ) UST = -1.0 - ! - ! 4.d Write the basic stuff - ! - WRITE (NDSOUT,985,ERR=803,IOSTAT=IERR) & - DW, CX, CY, WX, WY, UST, AS, SCALE - ! - ! 4.e Start of integer packing - ! - STRING = EMPTY - ILAST = 0 - NZERO = 0 - ! - ! 4.e.1 Loop over spectrum - ! - DO IK=1, NK - DO ITH=1, NTH - VALUE = MAX ( 0.1 , 1.1*SPEC(IK,ITH)/SCALE ) - IWDTH = 2 + MAX( 0 , INT( ALOG10(VALUE) ) ) + READ (NDSINP,IOSTAT=IERR) TTST + IF (IERR.GT.0) THEN + CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT DATA',2) + ELSE IF(IERR.EQ.0) THEN + BACKSPACE (NDSINP) + WRITE (NDSO,940) + ! + DO ! - ! 4.e.2 Put value in string and test overflow + ! 4.a Read/write basic data ! - IF ( IWDTH .GT. 9 ) THEN - IWDTH = 9 - PART = ' 99999999' + READ (NDSINP,IOSTAT=IERR) TIME, X, Y, TSTSTR, & + TRCKID + IF (IERR.GT.0) THEN + CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT DATA',2) + ELSE IF(IERR.LT.0) THEN + EXIT + END IF + IF ( FLAGLL ) THEN + WRITE (NDSOUT,984,IOSTAT=IERR) & + TIME, FACTOR*X, FACTOR*Y, TSTSTR, TRCKID + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) ELSE - WRITE (PART,987) NINT(SPEC(IK,ITH)/SCALE) - IF ( PART(11-IWDTH:11-IWDTH) .EQ. ' ' ) & - IWDTH = IWDTH - 1 + WRITE (NDSOUT,974,IOSTAT=IERR) & + TIME, FACTOR*X, FACTOR*Y, TSTSTR, TRCKID + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + END IF + ! + IF ( TIME(1).EQ.TTST(1) .AND. TIME(2).EQ.TTST(2) ) THEN + ILOC = ILOC + 1 + IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 + ENDIF + IF ( TIME(1).NE.TTST(1) .OR. TIME(2).NE.TTST(2) ) THEN + CALL STME21 ( TTST , STIME ) + WRITE (NDSO,941) STIME, ILOC, ISPEC + ILOC = 1 + ISPEC = 0 + IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 + TTST(1) = TIME(1) + TTST(2) = TIME(2) ENDIF ! - ! 4.e.3 It's a zero, wait with writing + ! 4.b Check if sea point ! - IF ( PART(8:9) .EQ. ' 0' ) THEN - NZERO = NZERO + 1 - ELSE - ! - ! 4.e.4 It's not a zero, write unwritten zeros - ! - IF ( NZERO .NE. 0 ) THEN - IF ( NZERO .EQ. 1 ) THEN - ZEROS = ' 0' - IWZERO = 2 + IF ( TSTSTR .NE. 'SEA' ) CYCLE + ! + ! 4.c Read all data + ! + READ (NDSINP,IOSTAT=IERR) DW, CX, CY, WX, WY, UST, AS, & + SPEC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','INPUT DATA',2) + IF ( UST .LT. 0. ) UST = -1.0 + ! + ! 4.d Write the basic stuff + ! + WRITE (NDSOUT,985,IOSTAT=IERR) & + DW, CX, CY, WX, WY, UST, AS, SCALE + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + ! + ! 4.e Start of integer packing + ! + STRING = EMPTY + ILAST = 0 + NZERO = 0 + ! + ! 4.e.1 Loop over spectrum + ! + DO IK=1, NK + DO ITH=1, NTH + VALUE = MAX ( 0.1 , 1.1*SPEC(IK,ITH)/SCALE ) + IWDTH = 2 + MAX( 0 , INT( ALOG10(VALUE) ) ) + ! + ! 4.e.2 Put value in string and test overflow + ! + IF ( IWDTH .GT. 9 ) THEN + IWDTH = 9 + PART = ' 99999999' ELSE - WRITE (ZEROS,'(I7,A2)') NZERO, '*0' - IWZERO = 4 - DO - ICH = 10 - IWZERO - IF ( ZEROS(ICH:ICH) .NE. ' ' ) THEN - IWZERO = IWZERO + 1 + WRITE (PART,987) NINT(SPEC(IK,ITH)/SCALE) + IF ( PART(11-IWDTH:11-IWDTH) .EQ. ' ' ) & + IWDTH = IWDTH - 1 + ENDIF + ! + ! 4.e.3 It's a zero, wait with writing + ! + IF ( PART(8:9) .EQ. ' 0' ) THEN + NZERO = NZERO + 1 + ELSE + ! + ! 4.e.4 It's not a zero, write unwritten zeros + ! + IF ( NZERO .NE. 0 ) THEN + IF ( NZERO .EQ. 1 ) THEN + ZEROS = ' 0' + IWZERO = 2 ELSE - EXIT + WRITE (ZEROS,'(I7,A2)') NZERO, '*0' + IWZERO = 4 + DO + ICH = 10 - IWZERO + IF ( ZEROS(ICH:ICH) .NE. ' ' ) THEN + IWZERO = IWZERO + 1 + ELSE + EXIT + ENDIF + END DO ENDIF - END DO - ENDIF - IF ( ILAST+IWZERO .GT. LINELN ) THEN - WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) & - STRING(2:ILAST) - STRING = EMPTY - ILAST = 0 + IF ( ILAST+IWZERO .GT. LINELN ) THEN + WRITE (NDSOUT,986,IOSTAT=IERR) & + STRING(2:ILAST) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + STRING = EMPTY + ILAST = 0 + ENDIF + STRING(ILAST+1:ILAST+IWZERO) = & + ZEROS(10-IWZERO:9) + ILAST = ILAST + IWZERO + NZERO = 0 + ENDIF + ! + ! 4.e.5 It's not a zero, put in string + ! + IF ( ILAST+IWDTH .GT. LINELN ) THEN + WRITE (NDSOUT,986,IOSTAT=IERR) & + STRING(2:ILAST) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + STRING = EMPTY + ILAST = 0 + ENDIF + ! + STRING(ILAST+1:ILAST+IWDTH) = PART(10-IWDTH:9) + ILAST = ILAST + IWDTH + ! ENDIF - STRING(ILAST+1:ILAST+IWZERO) = & - ZEROS(10-IWZERO:9) - ILAST = ILAST + IWZERO - NZERO = 0 + ! + END DO + END DO + ! + ! ..... End of loop over spectrum (4.e.1) + ! + ! 4.e.6 Write trailing zeros + ! + IF ( NZERO .NE. 0 ) THEN + IF ( NZERO .EQ. 1 ) THEN + ZEROS = ' 0' + IWZERO = 2 + ELSE + WRITE (ZEROS,'(I7,A2)') NZERO, '*0' + IWZERO = 4 + DO + ICH = 10 - IWZERO + IF ( ZEROS(ICH:ICH) .NE. ' ' ) THEN + IWZERO = IWZERO + 1 + ELSE + EXIT + ENDIF + END DO ENDIF - ! - ! 4.e.5 It's not a zero, put in string - ! - IF ( ILAST+IWDTH .GT. LINELN ) THEN - WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) & + IF ( ILAST+IWZERO .GT. LINELN ) THEN + WRITE (NDSOUT,986,IOSTAT=IERR) & STRING(2:ILAST) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) STRING = EMPTY ILAST = 0 ENDIF - ! - STRING(ILAST+1:ILAST+IWDTH) = PART(10-IWDTH:9) - ILAST = ILAST + IWDTH - ! + STRING(ILAST+1:ILAST+IWZERO) = ZEROS(10-IWZERO:9) + ILAST = ILAST + IWZERO + NZERO = 0 ENDIF ! + ! 4.e.7 Write last line + ! + IF ( ILAST .NE. 0 ) THEN + WRITE (NDSOUT,986,IOSTAT=IERR) STRING(2:ILAST) + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3TRCK','OUTPUT',4) + ENDIF END DO - END DO - ! - ! ..... End of loop over spectrum (4.e.1) - ! - ! 4.e.6 Write trailing zeros - ! - IF ( NZERO .NE. 0 ) THEN - IF ( NZERO .EQ. 1 ) THEN - ZEROS = ' 0' - IWZERO = 2 - ELSE - WRITE (ZEROS,'(I7,A2)') NZERO, '*0' - IWZERO = 4 - DO - ICH = 10 - IWZERO - IF ( ZEROS(ICH:ICH) .NE. ' ' ) THEN - IWZERO = IWZERO + 1 - ELSE - EXIT - ENDIF - END DO - ENDIF - IF ( ILAST+IWZERO .GT. LINELN ) THEN - WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) & - STRING(2:ILAST) - STRING = EMPTY - ILAST = 0 - ENDIF - STRING(ILAST+1:ILAST+IWZERO) = ZEROS(10-IWZERO:9) - ILAST = ILAST + IWZERO - NZERO = 0 - ENDIF - ! - ! 4.e.7 Write last line - ! - IF ( ILAST .NE. 0 ) THEN - WRITE (NDSOUT,986,ERR=803,IOSTAT=IERR) STRING(2:ILAST) - ENDIF - ! - ! ... Loop back to top - ! - GOTO 400 + END IF ! ! 4.f All data done, write last batch info ! -444 CONTINUE - ! CALL STME21 ( TTST , STIME ) WRITE (NDSO,941) STIME, ILOC, ISPEC - ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 1 ) - ! -801 CONTINUE - WRITE (NDSE,1001) IERR - CALL EXTCDE ( 2 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 3 ) - ! -803 CONTINUE - WRITE (NDSE,1003) IERR - CALL EXTCDE ( 4 ) - ! -805 CONTINUE - WRITE (NDSE,1004) IERR - CALL EXTCDE ( 5 ) - ! -806 CONTINUE - WRITE (NDSE,1005) IERR - CALL EXTCDE ( 6 ) - ! -807 CONTINUE - WRITE (NDSE,1006) IERR - CALL EXTCDE ( 7 ) - ! -810 CONTINUE - WRITE (NDSE,1010) IDSTR, IDTST - CALL EXTCDE ( 5 ) - ! -811 CONTINUE - WRITE (NDSE,1011) MK, MTH, NK, NTH - CALL EXTCDE ( 6 ) - ! -888 CONTINUE ! WRITE (NDSO,999) ! @@ -437,34 +423,6 @@ PROGRAM W3TRCK ' ========================================='/ & ' WAVEWATCH III Track output '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN OPENING INPUT DATA FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN READING FROM INPUT DATA FILE'/ & - ' IOSTAT =',I5/) - ! -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN OPENING OUTPUT DATA FILE'/ & - ' IOSTAT =',I5/) - ! -1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN WRITING TO OUTPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & - ' ERROR IN OPENING OUTPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRCK : '/ & ' UNEXPECTED ID STRING IN INPUT : ',A/ & ' SHOULD BE : ',A/) diff --git a/model/src/ww3_trnc.F90 b/model/src/ww3_trnc.F90 index ec69db4dca..756e5d7d9a 100644 --- a/model/src/ww3_trnc.F90 +++ b/model/src/ww3_trnc.F90 @@ -25,6 +25,7 @@ PROGRAM W3TRNC !/ 11-Apr-2016 : Adapted to use more options ( version 5.11 ) !/ 15-May-2018 : Add namelist feature ( version 6.05 ) !/ 18-Jun-2020 : Support for 360-day calendar. ( version 7.08 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -76,7 +77,7 @@ PROGRAM W3TRNC #endif USE W3GDATMD, ONLY : W3NMOD, W3SETG, FLAGLL, XFR, GNAME USE W3ODATMD, ONLY : W3NOUT, W3SETO, FNMPRE - USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif @@ -196,27 +197,33 @@ PROGRAM W3TRNC ! process old ww3_trnc.inp format ! IF (.NOT. FLGNML) THEN - OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_trnc.inp',STATUS='OLD',ERR=805,IOSTAT=IERR) + OPEN (NDSI,FILE=TRIM(FNMPRE)//'ww3_trnc.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 14) REWIND (NDSI) - READ (NDSI,'(A)',END=806,ERR=807,IOSTAT=IERR) COMSTR + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 15) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! 3.1 Time setup IDTIME, DTREQ, NOUT CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=806,ERR=807) TOUT, DTREQ, NOUT + READ (NDSI,*,IOSTAT=IERR) TOUT, DTREQ, NOUT + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 15) ! 3.2 Output type CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=806,ERR=807) NCTYPE + READ (NDSI,*,IOSTAT=IERR) NCTYPE + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 15) CALL NEXTLN ( COMSTR , NDSI , NDSE ) FILEPREFIX= 'ww3.' - READ (NDSI,*,END=806,ERR=807) FILEPREFIX + READ (NDSI,*,IOSTAT=IERR) FILEPREFIX + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 15) CALL NEXTLN ( COMSTR , NDSI , NDSE ) - READ (NDSI,*,END=806,ERR=807) S3 + READ (NDSI,*,IOSTAT=IERR) S3 + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 15) END IF ! .NOT. FLGNML @@ -257,8 +264,10 @@ PROGRAM W3TRNC ! 4. Check consistency with input file and track_o.ww3 ! OPEN (NDSINP,FILE=TRIM(FNMPRE)//'track_o.ww3',form='UNFORMATTED', convert=file_endian, & - STATUS='OLD',ERR=800,IOSTAT=IERR) - READ (NDSINP,ERR=801,IOSTAT=IERR) IDSTR, FLAGLL, MK, MTH, XFR + STATUS='OLD',IOSTAT=IERR) + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, 'W3TRNC', 'INPUT', 10) + READ (NDSINP,IOSTAT=IERR) IDSTR, FLAGLL, MK, MTH, XFR + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3TRNC','INPUT',11) ! IF ( FLAGLL ) THEN M2KM = 1. @@ -266,14 +275,18 @@ PROGRAM W3TRNC M2KM = 1.E-3 END IF ! - IF ( IDSTR .NE. IDTST ) GOTO 810 + IF ( IDSTR .NE. IDTST ) THEN + WRITE (NDSE,1010) IDSTR, IDTST + CALL EXTCDE ( 20 ) + END IF WRITE (NDSO,902) MK, MTH NSPEC = MK * MTH ALLOCATE ( FREQ(MK), FREQ1(MK), FREQ2(MK), DSIP(MK), & SPEC(MK,MTH), E(MK,MTH), THD(MTH), DIR(MTH) ) ! - READ (NDSINP,ERR=801,IOSTAT=IERR) TH1, DTH, FREQ, DSIP + READ (NDSINP,IOSTAT=IERR) TH1, DTH, FREQ, DSIP + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3TRNC','INPUT',11) ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -282,69 +295,78 @@ PROGRAM W3TRNC IOUT = 0 NCID = 0 WRITE (NDSO,970) - READ (NDSINP,END=444, ERR=801,IOSTAT=IERR) TIME - BACKSPACE (NDSINP) - - - ! 5.1 Loops on track_o.ww3 to read the time and data - DO - DTEST = DSEC21 ( TIME , TOUT ) - - ! cycle to reach the start time of input file - IF ( DTEST .LT. 0. ) THEN - CALL TICK21 ( TOUT , DTREQ ) - CYCLE - END IF - - IF ( DTEST .GE. 0. ) THEN - TRCKID='' - READ (NDSINP,END=444, ERR=801,IOSTAT=IERR) TIME, X, Y, TSTSTR, TRCKID - IF ( TSTSTR .EQ. 'SEA' ) THEN - READ (NDSINP,ERR=801,IOSTAT=IERR) DW, CX, CY, WX, WY, UST, & - AS, SPEC + READ (NDSINP,IOSTAT=IERR) TIME + IF (IERR.GT.0) THEN + WRITE (NDSE,1001) + CALL EXTCDE ( 11 ) + ELSE IF (IERR.EQ.0) THEN + BACKSPACE (NDSINP) + + + ! 5.1 Loops on track_o.ww3 to read the time and data + DO + DTEST = DSEC21 ( TIME , TOUT ) + + ! cycle to reach the start time of input file + IF ( DTEST .LT. 0. ) THEN + CALL TICK21 ( TOUT , DTREQ ) + CYCLE END IF - IF ( IERR .EQ. -1 ) THEN - WRITE (NDSO,944) - EXIT - END IF - - IF ( TIME(1).EQ.TOUT(1) .AND. TIME(2).EQ.TOUT(2) ) THEN - ILOC = ILOC + 1 - IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 - ENDIF - IF ( TIME(1).GT.TOUT(1) .OR. TIME(2).GT.TOUT(2) ) THEN - CALL STME21 ( TIME , STIME ) - WRITE (NDSO,945) STIME, ILOC, ISPEC - ILOC = 1 - ISPEC = 0 - IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 - TOUT(1) = TIME(1) - TOUT(2) = TIME(2) - ENDIF - END IF - - - ! 5.1.1 Increments the global time counter IOUT - IOUT = IOUT + 1 - CALL STME21 ( TOUT , IDTIME ) - WRITE (NDSO,971) IDTIME + IF ( DTEST .GE. 0. ) THEN + TRCKID='' + READ (NDSINP,IOSTAT=IERR) TIME, X, Y, TSTSTR, TRCKID + IF (IERR.LT.0) THEN + EXIT + ELSE IF (IERR.GT.0) THEN + WRITE (NDSE,1001) + CALL EXTCDE ( 11 ) + END IF + IF ( TSTSTR .EQ. 'SEA' ) THEN + READ (NDSINP,IOSTAT=IERR) DW, CX, CY, WX, WY, UST, & + AS, SPEC + IF (IERR.GT.0) CALL EXTIOF(NDSE,IERR,'W3TRNC','INPUT',11) + END IF + IF ( IERR .LT.0 ) THEN + WRITE (NDSO,944) + EXIT + END IF + + + IF ( TIME(1).EQ.TOUT(1) .AND. TIME(2).EQ.TOUT(2) ) THEN + ILOC = ILOC + 1 + IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 + ENDIF + IF ( TIME(1).GT.TOUT(1) .OR. TIME(2).GT.TOUT(2) ) THEN + CALL STME21 ( TIME , STIME ) + WRITE (NDSO,945) STIME, ILOC, ISPEC + ILOC = 1 + ISPEC = 0 + IF ( TSTSTR .EQ. 'SEA' ) ISPEC = ISPEC + 1 + TOUT(1) = TIME(1) + TOUT(2) = TIME(2) + ENDIF + END IF - ! 5.1.2 Processes the variable value for the time step IOUT - CALL W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) + ! 5.1.1 Increments the global time counter IOUT + IOUT = IOUT + 1 + CALL STME21 ( TOUT , IDTIME ) + WRITE (NDSO,971) IDTIME - ! 5.1.3 Defines the stop date - CALL T2D(TOUT,STOPDATE,IERR) - WRITE(STRSTOPDATE,'(I4.4,A,4(I2.2,A),I2.2)') STOPDATE(1),'-',STOPDATE(2), & - '-',STOPDATE(3),' ',STOPDATE(5),':',STOPDATE(6),':',STOPDATE(7) + ! 5.1.2 Processes the variable value for the time step IOUT + CALL W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) - IF ( IOUT .GE. NOUT ) EXIT - END DO + ! 5.1.3 Defines the stop date + CALL T2D(TOUT,STOPDATE,IERR) + WRITE(STRSTOPDATE,'(I4.4,A,4(I2.2,A),I2.2)') STOPDATE(1),'-',STOPDATE(2), & + '-',STOPDATE(3),' ',STOPDATE(5),':',STOPDATE(6),':',STOPDATE(7) -444 CONTINUE + IF ( IOUT .GE. NOUT ) EXIT + END DO + END IF ! 5.2 Closes the netCDF file IF (NCID.NE.0) THEN @@ -357,37 +379,8 @@ PROGRAM W3TRNC END IF ! - GOTO 888 - ! - ! Escape locations read errors : - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 10 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 11 ) - ! -805 CONTINUE - WRITE (NDSE,1004) IERR - CALL EXTCDE ( 14 ) - ! -806 CONTINUE - WRITE (NDSE,1005) IERR - CALL EXTCDE ( 15 ) - ! -807 CONTINUE - WRITE (NDSE,1006) IERR - CALL EXTCDE ( 16 ) - ! - -810 CONTINUE - WRITE (NDSE,1010) IDSTR, IDTST - CALL EXTCDE ( 20 ) - ! -888 CONTINUE WRITE (NDSO,999) + STOP ! ! Formats ! @@ -418,25 +411,9 @@ PROGRAM W3TRNC ' ========================================='/ & ' WAVEWATCH III Track output '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRNC : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRNC : '/ & ' PREMATURE END OF INPUT FILE'/) ! -1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRNC : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRNC : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRNC : '/ & - ' ERROR IN OPENING OUTPUT FILE'/ & - ' IOSTAT =',I5/) - ! 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3TRNC : '/ & ' ILLEGAL TYPE, NCTYPE =',I4/) ! @@ -467,6 +444,7 @@ SUBROUTINE W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) !/ +-----------------------------------+ !/ !/ 8-apr-2016 : Creation ( version 5.11 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ ! 1. Purpose : ! @@ -702,8 +680,7 @@ SUBROUTINE W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) ! ! 1.6 Exit from W3EXNC if not sea point ! - IF ( TSTSTR .NE. 'SEA' ) GOTO 888 - + IF ( TSTSTR .NE. 'SEA' ) RETURN ! ! 1.6.1 Process speed and direction components @@ -776,9 +753,6 @@ SUBROUTINE W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) IRET=NF90_PUT_VAR(NCID,VARID(18),TRCKID,start=(/1,IT/),count=(/LEN_TRIM(TRCKID),1/)) CALL CHECK_ERR(IRET) - - ! -888 CONTINUE ! RETURN @@ -787,7 +761,6 @@ SUBROUTINE W3EXNC ( FILEPREFIX, NCTYPE, NCID, S3, STRSTOPDATE, MK, MTH ) ! 973 FORMAT ( 'NEW NetCDF file was created ',A) - !/ End of W3EXNC ----------------------------------------------------- / !/ END SUBROUTINE W3EXNC diff --git a/model/src/ww3_uprstr.F90 b/model/src/ww3_uprstr.F90 index f885cf7158..c769396d9d 100644 --- a/model/src/ww3_uprstr.F90 +++ b/model/src/ww3_uprstr.F90 @@ -46,6 +46,7 @@ PROGRAM W3UPRSTR !/ or from restart under WRST switch (Andy Saulter) !/ 06-Oct-2020 : Added namelist input options ( version 7.11 ) !/ 06-May-2021 : Use SMCTYPE and FSWND for SMC grid. ( version 7.13 ) + !/ 04-Jul-2025 : Remove labelled statements ( version X.XX ) !/ !/ Copyright 2010 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -278,6 +279,8 @@ PROGRAM W3UPRSTR ! W3SETA Subr. Id. Point to selected model for aux data. ! ITRACE Subr. W3SERVMD Subroutine tracing initialization. ! NEXTLN Subr. Id. Get next line from input file. + ! EXTIOF Subr. Id. Abort if error I/O file + ! EXTOPN Subr. Id. Abort if error opening file ! EXTCDE Subr. Id. Abort program as graceful as possible. ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file. ! WAVNU1 Subr. W3DISPMD @@ -334,7 +337,7 @@ PROGRAM W3UPRSTR USE W3ADATMD, ONLY: W3NAUX, W3SETA USE W3ODATMD, ONLY: W3NOUT, W3SETO USE W3IORSMD, ONLY: W3IORS - USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE + USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF USE W3IOGRMD, ONLY: W3IOGR USE W3DISPMD, ONLY: WAVNU1 ! @@ -455,32 +458,40 @@ PROGRAM W3UPRSTR ! otherwise read from the .inp file IF (.NOT. FLGNML) THEN J = LEN_TRIM(FNMPRE) - OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_uprstr.inp',STATUS='OLD', & - ERR=800,IOSTAT=IERR) - READ (NDSI,'(A)',END=801,ERR=802) COMSTR + OPEN (NDSI,FILE=FNMPRE(:J)//'ww3_uprstr.inp',STATUS='OLD',IOSTAT=IERR) + IF (IERR .NE. 0) CALL EXTOPN(NDSE,IERR, MYNAME, 'INPUT', 10) + READ (NDSI,'(A)',IOSTAT=IERR) COMSTR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',11) IF (COMSTR.EQ.' ') COMSTR = '$' WRITE (NDSO,901) COMSTR ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002) TIME + READ (NDSI,*,IOSTAT=IERR) TIME + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002) UPDPROC + READ (NDSI,*,IOSTAT=IERR) UPDPROC + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) CALL NEXTLN ( COMSTR , NDSI , NDSEN ) IF (UPDPROC .EQ. 'UPD0F') THEN - READ (NDSI,*,END=2001,ERR=2002) PRCNTG + READ (NDSI,*,IOSTAT=IERR) PRCNTG + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) ELSE IF ((UPDPROC .EQ. 'UPD2') .OR. (UPDPROC .EQ. 'UPD3')) THEN ! CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002) PRCNTG_CAP + READ (NDSI,*,IOSTAT=IERR) PRCNTG_CAP + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) #ifdef W3_F CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002) FLNMCOR + READ (NDSI,*,IOSTAT=IERR) FLNMCOR + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) #endif ELSE - READ (NDSI,*,END=2001,ERR=2002) PRCNTG_CAP, THRWSEA + READ (NDSI,*,IOSTAT=IERR) PRCNTG_CAP, THRWSEA + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) END IF CALL NEXTLN ( COMSTR , NDSI , NDSEN ) - READ (NDSI,*,END=2001,ERR=2002) FLNMANL + READ (NDSI,*,IOSTAT=IERR) FLNMANL + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3UPSTR','INPUT',1001) END IF ENDIF #ifdef W3_T @@ -1123,41 +1134,7 @@ PROGRAM W3UPRSTR CALL writeMatrix('VA02.txt', REAL(VA)) #endif ! - !/ - !/ ------------------------------------------------------------------- / - ! Escape locations read errors 08k: - !/ - GOTO 888 - ! -800 CONTINUE - WRITE (NDSE,1000) IERR - CALL EXTCDE ( 10 ) - ! -801 CONTINUE - WRITE (NDSE,1001) - CALL EXTCDE ( 11 ) - ! -802 CONTINUE - WRITE (NDSE,1002) IERR - CALL EXTCDE ( 12 ) - ! -888 CONTINUE WRITE (NDSO,999) - !/ - !/ ------------------------------------------------------------------- / - ! Escape locations read errors 2k: - !/ - GOTO 2222 - ! -2001 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1001) - GOTO 2222 - ! -2002 CONTINUE - IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1002) IERR - GOTO 2222 - ! -2222 CONTINUE !/ !/ ------------------------------------------------------------------- / ! Formats @@ -1183,16 +1160,6 @@ PROGRAM W3UPRSTR ' ========================================='/ & ' WAVEWATCH III ww3_uprstr '/) ! -1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3UPRSTR : '/ & - ' ERROR IN OPENING INPUT FILE'/ & - ' IOSTAT =',I5/) - ! -1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3UPRSTR : '/ & - ' PREMATURE END OF INPUT FILE'/) - -1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3UPRSTR : '/ & - ' ERROR IN READING FROM INPUT FILE'/ & - ' IOSTAT =',I5/) 1004 FORMAT (/' '/,A/) 1005 FORMAT (' ',A, F6.3/) 1006 FORMAT (' ',A, A/) From e7bacf5a5a57e725f4175f0669daafb695eea9db Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 25 Jul 2025 10:05:11 -0400 Subject: [PATCH 089/136] Fix uninitialized TRHO in W3IORS for consistent restart files (#1472) --- model/src/w3iorsmd.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 788ff438d1..85717530cd 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -1445,6 +1445,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) TICE(1) = -1 TICE(2) = 0 TRHO(1) = -1 + TRHO(2) = 0 TIC1(1) = -1 TIC1(2) = 0 TIC5(1) = -1 From 760af3b241a441520e602410b36b62f71b9cf43c Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 25 Jul 2025 16:47:24 -0400 Subject: [PATCH 090/136] Updates for SCOTCH 7.0.7 --- cmake/FindSCOTCH.cmake | 38 ++++++++++++++++++++++++++++++++ model/src/CMakeLists.txt | 31 ++++++++++++++++---------- model/src/PDLIB/yowpdlibmain.F90 | 10 +++++++++ 3 files changed, 67 insertions(+), 12 deletions(-) diff --git a/cmake/FindSCOTCH.cmake b/cmake/FindSCOTCH.cmake index c2a3272f47..95eabbd6e7 100644 --- a/cmake/FindSCOTCH.cmake +++ b/cmake/FindSCOTCH.cmake @@ -77,8 +77,46 @@ find_package_handle_standard_args( REQUIRED_VARS ptscotchparmetis_lib ptscotchparmetis_inc) + +## Find version of scotch if possible +if( EXISTS "${scotch_inc}/scotch.h" ) + + file(READ "${scotch_inc}/scotch.h" header_content) + + # Extract the major version number using regex + string(REGEX MATCH "SCOTCH_VERSION ([0-9]+)" VERSION_MAJOR_MATCH "${header_content}") + if(VERSION_MAJOR_MATCH) + set(SCOTCH_VERSION_MAJOR "${CMAKE_MATCH_1}") + message(STATUS "SCOTCH_VERSION_MAJOR: ${SCOTCH_VERSION_MAJOR}") + else() + message(WARNING "Could not find SCOTCH_VERSION in scotch.h") + endif() + + # Extract the minor version number using regex + string(REGEX MATCH "SCOTCH_RELEASE ([0-9]+)" VERSION_MINOR_MATCH "${header_content}") + if(VERSION_MINOR_MATCH) + set(SCOTCH_RELEASE "${CMAKE_MATCH_1}") + message(STATUS "SCOTCH_RELEASE: ${SCOTCH_RELEASE}") + else() + message(WARNING "Could not find SCOTCH_RELEASE in scotch.h") + endif() + + # Extract the patch version number using regex + string(REGEX MATCH "SCOTCH_PATCHLEVEL ([0-9]+)" VERSION_PATCH_MATCH "${header_content}") + if(VERSION_PATCH_MATCH) + set(SCOTCH_PATCHLEVEL "${CMAKE_MATCH_1}") + message(STATUS "SCOTCH_PATCHLEVEL: ${SCOTCH_PATCHLEVEL}") + else() + message(WARNING "Could not find VERSION_PATCH in scotch.h") + endif() + set(SCOTCH_VERSION "${SCOTCH_VERSION_MAJOR}.${SCOTCH_RELEASE}.${SCOTCH_PATCHLEVEL}") +endif() + message(STATUS "Found SCOTCH: ${scotch_lib}") message(STATUS "Found PTSCOTCH: ${ptscotch_lib}") message(STATUS "Found SCOTCHerr: ${scotcherr_lib}") message(STATUS "Found PTSCOTCHerr: ${ptscotcherr_lib}") message(STATUS "Found PTSCOTCHparmetis: ${ptscotchparmetis_lib}") +message(STATUS "SCOTCH version: ${SCOTCH_VERSION}") + + diff --git a/model/src/CMakeLists.txt b/model/src/CMakeLists.txt index bf530276ef..59dec391c2 100644 --- a/model/src/CMakeLists.txt +++ b/model/src/CMakeLists.txt @@ -91,10 +91,6 @@ elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Cray") set(compile_flags_debug -O0 -Rbcps -Ktrap=fp) endif() -target_compile_options(ww3_lib PUBLIC "$<$:${compile_flags}>") -target_compile_options(ww3_lib PUBLIC "$<$,$>:${compile_flags_debug}>") -target_compile_options(ww3_lib PUBLIC "$<$,$>:${compile_flags_release}>") - # Executables to always build set(programs ww3_strt ww3_grid ww3_bound ww3_outf ww3_outp ww3_trck ww3_grib ww3_gint gx_outf gx_outp ww3_uprstr ww3_shel ww3_prep ww3_gspl ww3_multi ww3_systrk) @@ -155,16 +151,23 @@ endif() # Handle PDLIB, SCRIP, SCRIPNC build files directly instead of through configuration file if("PDLIB" IN_LIST switches) if("SCOTCH" IN_LIST switches) - find_package(SCOTCH REQUIRED) - target_sources(ww3_lib PRIVATE ${pdlib_src}) - target_link_libraries(ww3_lib PUBLIC PTSCOTCHparmetis::PTSCOTCHparmetis) -elseif("METIS" IN_LIST switches) - find_package(ParMETIS REQUIRED) - target_sources(ww3_lib PRIVATE ${pdlib_src}) - target_link_libraries(ww3_lib PUBLIC ParMETIS::ParMETIS) + find_package(SCOTCH REQUIRED) + target_sources(ww3_lib PRIVATE ${pdlib_src}) + target_link_libraries(ww3_lib PUBLIC PTSCOTCHparmetis::PTSCOTCHparmetis) + if(SCOTCH_VERSION VERSION_GREATER "7.0.6") + list(APPEND compile_flags -DSCOTCH_707) + list(APPEND compile_flags_release -DSCOTCH_707) + list(APPEND compile_flags_debug -DSCOTCH_707) + else() + message(STATUS "SOCTCH version 7.06 or lower") + endif() + elseif("METIS" IN_LIST switches) + find_package(ParMETIS REQUIRED) + target_sources(ww3_lib PRIVATE ${pdlib_src}) + target_link_libraries(ww3_lib PUBLIC ParMETIS::ParMETIS) else() message(FATAL_ERROR "PDLIB requires METIS or SCOTCH library for domain decomposition") - endif() + endif() endif() if("MPI" IN_LIST switches) @@ -203,6 +206,10 @@ foreach(program ${programs}) target_link_libraries(${program} PRIVATE ww3_lib) endforeach() +target_compile_options(ww3_lib PUBLIC "$<$:${compile_flags}>") +target_compile_options(ww3_lib PUBLIC "$<$,$>:${compile_flags_debug}>") +target_compile_options(ww3_lib PUBLIC "$<$,$>:${compile_flags_release}>") + install( TARGETS ${programs} ww3_lib EXPORT WW3Exports diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index cc72b97fd8..7bc9293524 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -629,6 +629,15 @@ subroutine runParmetis(MNP) !if(debugParmetis) write(710+myrank,*) "Run ParMETIS now..." #ifdef W3_SCOTCH +#ifdef SCOTCH_707 +! Starting with SCOTCH 7.0.7 need ot explicitly call the SCOTCHF + call SCOTCHFParMETIS_V3_PartGeomKway(vtxdist, xadj, adjncy, & + vwgt, & !vwgt - ignore weights + adjwgt, & ! adjwgt - ignore weights + wgtflag, & + numflag,ndims,xyz,ncon,nparts,tpwgts,ubvec,options, & + edgecut,part, comm,ref) +#else call SCOTCH_ParMETIS_V3_PartGeomKway(vtxdist, xadj, adjncy, & vwgt, & !vwgt - ignore weights adjwgt, & ! adjwgt - ignore weights @@ -636,6 +645,7 @@ subroutine runParmetis(MNP) numflag,ndims,xyz,ncon,nparts,tpwgts,ubvec,options, & edgecut,part, comm,ref) #endif +#endif #ifdef W3_METIS call ParMETIS_V3_PartGeomKway(vtxdist, xadj, adjncy, & From 8c19f2e82b1b83dc8a5c75b2b1c6e97d5007c2bc Mon Sep 17 00:00:00 2001 From: "Max H. Balsmeier" Date: Mon, 28 Jul 2025 18:52:19 +0200 Subject: [PATCH 091/136] adding the possibility to set the fetch that is used by the fetch-limited JONSWAP(#1451) initialization manually in ww3_strt.inp --- model/inp/ww3_strt.inp | 6 + model/src/w3gdatmd.F90 | 5 +- model/src/w3iorsmd.F90 | 23 ++- model/src/w3updtmd.F90 | 9 +- model/src/ww3_strt.F90 | 17 ++- regtests/bin/matrix.base | 5 +- .../i_lowres_multi_jonswap/grdset_a | 4 + .../i_lowres_multi_jonswap/lowres.depth | 1 + .../i_lowres_multi_jonswap/lowres.obst | 2 + .../namelists_lowres.nml | 3 + .../i_lowres_multi_jonswap/points.list | 1 + .../i_lowres_multi_jonswap/switch | 1 + .../ww3_grid_lowres.inp | 73 ++++++++++ .../ww3_grid_lowres.nml | 81 +++++++++++ .../ww3_multi_grdset_a.inp | 72 ++++++++++ .../ww3_multi_grdset_a.nml | 60 ++++++++ .../i_lowres_multi_jonswap/ww3_ounf.inp | 43 ++++++ .../i_lowres_multi_jonswap/ww3_ounf.nml | 25 ++++ .../i_lowres_multi_jonswap/ww3_outf.inp | 11 ++ .../i_lowres_multi_jonswap/ww3_prep_ice.inp | 33 +++++ .../i_lowres_multi_jonswap/ww3_prep_wind.inp | 42 ++++++ .../i_lowres_multi_jonswap/ww3_strt.inp | 77 ++++++++++ .../i_lowres_shel_jonswap/namelists_outer.nml | 3 + .../i_lowres_shel_jonswap/outer.depth | 1 + .../i_lowres_shel_jonswap/outer.obst | 2 + .../i_lowres_shel_jonswap/points.list | 1 + .../mww3_test_08/i_lowres_shel_jonswap/switch | 1 + .../i_lowres_shel_jonswap/ww3_grid.inp | 73 ++++++++++ .../i_lowres_shel_jonswap/ww3_grid.nml | 81 +++++++++++ .../i_lowres_shel_jonswap/ww3_ounf.inp | 43 ++++++ .../i_lowres_shel_jonswap/ww3_ounf.nml | 25 ++++ .../i_lowres_shel_jonswap/ww3_outf.inp | 11 ++ .../i_lowres_shel_jonswap/ww3_prep_ice.inp | 33 +++++ .../i_lowres_shel_jonswap/ww3_prep_wind.inp | 42 ++++++ .../i_lowres_shel_jonswap/ww3_shel.inp | 132 ++++++++++++++++++ .../i_lowres_shel_jonswap/ww3_shel.nml | 49 +++++++ .../i_lowres_shel_jonswap/ww3_strt.inp | 77 ++++++++++ regtests/mww3_test_08/info | 4 +- 38 files changed, 1157 insertions(+), 15 deletions(-) create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/grdset_a create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.depth create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.obst create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/namelists_lowres.nml create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/points.list create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/switch create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.inp create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.nml create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.inp create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.nml create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.inp create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.nml create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_outf.inp create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_ice.inp create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_wind.inp create mode 100644 regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_strt.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/namelists_outer.nml create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/outer.depth create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/outer.obst create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/points.list create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/switch create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.nml create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.nml create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_outf.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_ice.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_wind.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.inp create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.nml create mode 100644 regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_strt.inp diff --git a/model/inp/ww3_strt.inp b/model/inp/ww3_strt.inp index 948c42911a..4701f623c9 100644 --- a/model/inp/ww3_strt.inp +++ b/model/inp/ww3_strt.inp @@ -67,6 +67,12 @@ $ ITYPE = 5 ---------------------------------------------------------- $ $ Starting from calm conditions. $ - No additional data. $ +$ ITYPE = 6 ---------------------------------------------------------- $ +$ Similar to ITYPE = 3, but with manually specified fetch. +$ - assumed fetch (m): +$ +$ 5000 +$ $ -------------------------------------------------------------------- $ $ End of input file $ $ -------------------------------------------------------------------- $ diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 328bf93d24..ee1ab25c16 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -670,7 +670,7 @@ MODULE W3GDATMD DTMIN, DMIN, CTMAX, FICE0, FICEN, FICEL, & PFMOVE, STEXU, STEYU, STEDU, IICEHMIN, & IICEHINIT, ICESCALES(4), IICEHFAC, IICEHDISP, & - IICEDDISP, IICEFDISP, BTBETA, AAIRCMIN, AAIRGB + IICEDDISP, IICEFDISP, BTBETA, AAIRCMIN, AAIRGB, FETCH REAL(8) :: GRIDSHIFT ! see notes in WMGHGH @@ -1187,7 +1187,7 @@ MODULE W3GDATMD FICEL, PFMOVE, STEXU, STEYU, STEDU, & IICEHMIN, IICEHINIT, ICESCALES(:), & IICEHFAC, IICEHDISP, IICEDDISP, IICEFDISP, & - BTBETA, AAIRCMIN, AAIRGB + BTBETA, AAIRCMIN, AAIRGB, FETCH REAL(8),POINTER :: GRIDSHIFT ! see notes in WMGHGH #ifdef W3_RTD REAL, POINTER :: PoLat, PoLon @@ -2376,6 +2376,7 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) STEDU => GRIDS(IMOD)%STEDU BTBETA => GRIDS(IMOD)%BTBETA AAIRGB => GRIDS(IMOD)%AAIRGB + FETCH => GRIDS(IMOD)%FETCH AAIRCMIN => GRIDS(IMOD)%AAIRCMIN ! GINIT => GRIDS(IMOD)%GINIT diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 85717530cd..48459d3de1 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -292,7 +292,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: W3SETG, W3SETREF, RSTYPE + USE W3GDATMD, ONLY: W3SETG, W3SETREF, RSTYPE, FETCH USE W3ODATMD, ONLY: W3SETO USE W3ADATMD, ONLY: W3SETA, W3XETA, NSEALM USE W3ADATMD, ONLY: CX, CY, HS, WLM, T0M1, T01, FP0, THM, CHARN,& @@ -419,7 +419,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! IF (INXOUT.NE.'READ' .AND. INXOUT.NE.'HOT' .AND. & INXOUT.NE.'COLD' .AND. INXOUT.NE.'WIND' .AND. & - INXOUT.NE.'CALM' ) THEN + INXOUT.NE.'CALM' .AND. INXOUT.NE.'FTCH') THEN IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,900) INXOUT CALL EXTCDE ( 1 ) END IF @@ -555,7 +555,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITE (NDSE,903) TNAME, GNAME END IF IF (TYPE.NE.'FULL' .AND. TYPE.NE.'COLD' .AND. & - TYPE.NE.'WIND' .AND. TYPE.NE.'CALM' ) THEN + TYPE.NE.'WIND' .AND. TYPE.NE.'CALM' .AND. TYPE.NE.'FTCH' ) THEN IF ( IAPROC .EQ. NAPERR ) & WRITE (NDSE,904) TYPE CALL EXTCDE ( 12 ) @@ -640,7 +640,13 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ( Bail out if write for TYPE.EQ.'WIND' ) ! IF ( WRITE ) THEN - IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' ) THEN + IF ( TYPE.EQ.'FTCH' ) THEN + RPOS = 1_8 + LRECL*(3-1_8) + WRITE (NDSR,POS=RPOS,IOSTAT=IERR) FETCH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',31, & + ISWRITE=.TRUE.,POS=RPOS) + ENDIF + IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' .OR. TYPE.EQ.'FTCH' ) THEN IF ( .NOT.IOSFLG .OR. IAPROC.EQ.NAPRST ) THEN CLOSE ( NDSR ) END IF @@ -767,7 +773,14 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! ! Reading spectra ! - IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' ) THEN + IF ( TYPE.EQ.'FTCH') THEN + RPOS = 1_8 + LRECL*(3-1_8) + READ(NDSR, POS=RPOS,IOSTAT=IERR) FETCH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IORS','',30) + ELSEIF ( TYPE.EQ.'WIND') THEN + FETCH = 0 + ENDIF + IF ( TYPE.EQ.'WIND' .OR. TYPE.EQ.'CALM' .OR. TYPE.EQ.'FTCH' ) THEN #ifdef W3_T WRITE (NDST,9020) TYPE #endif diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index 6286c28dc5..ca6e03fe53 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -1123,7 +1123,7 @@ SUBROUTINE W3UINI ( A ) USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, MAPSF, & NK, NTH, TH, SIG, DTH, DSIP, UNGTYPE, & RLGTYPE, CLGTYPE, GTYPE, FLAGLL, & - HPFAC, HQFAC + HPFAC, HQFAC, FETCH USE W3ADATMD, ONLY: U10, U10D, CG USE W3PARALL, only : INIT_GET_JSEA_ISPROC, INIT_GET_ISEA USE W3PARALL, only : GET_JSEA_IBELONG @@ -1177,16 +1177,19 @@ SUBROUTINE W3UINI ( A ) A(:,:,:)=0 DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) - IF (GTYPE.EQ.UNGTYPE) THEN + IF (FETCH>0.0) THEN + XGR = FETCH + ELSEIF (GTYPE.EQ.UNGTYPE) THEN XGR=1. ! to be fixed later ELSE IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) XGR = 0.5 * SQRT(HPFAC(IY,IX)**2+HQFAC(IY,IX)**2) END IF - IF ( FLAGLL ) THEN + IF ( FLAGLL .AND. FETCH==0.0 ) THEN XGR = XGR * RADIUS * DERA END IF + ! U10C = MAX ( MIN(U10(ISEA),U10MAX) , U10MIN ) ! diff --git a/model/src/ww3_strt.F90 b/model/src/ww3_strt.F90 index d098eb3967..30ed53821b 100644 --- a/model/src/ww3_strt.F90 +++ b/model/src/ww3_strt.F90 @@ -381,7 +381,7 @@ PROGRAM W3STRT CALL NEXTLN ( COMSTR , NDSI , NDSEN ) READ (NDSI,*,IOSTAT=IERR) ITYPE IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) - IF ( ITYPE.LT.1 .OR. ITYPE.GT.5 ) THEN + IF ( ITYPE.LT.1 .OR. ITYPE.GT.6 ) THEN IF ( IAPROC .EQ. NAPERR ) WRITE (NDSE,1010) ITYPE CALL EXTCDE ( 1 ) END IF @@ -828,10 +828,20 @@ PROGRAM W3STRT !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! 8. ITYPE = 5, fetch limited JONSWAP. ! - ELSE + ELSE IF ( ITYPE .EQ. 5 ) THEN INXOUT = 'CALM' IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,980) ! + ELSE IF ( ITYPE .EQ. 6 ) THEN + INXOUT = 'FTCH' + + CALL NEXTLN ( COMSTR , NDSI , NDSEN ) + READ (NDSI,*,IOSTAT=IERR) FETCH + IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3STRT','INPUT',11) + IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,961) FETCH + + ! + !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END IF ! !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -977,6 +987,9 @@ PROGRAM W3STRT 960 FORMAT ( ' Fetch-limited JONSWAP spectra based on local '/ & ' wind speed (fetch related to grid increment).') ! +961 FORMAT ( ' Fetch-limited JONSWAP spectra based on local '/ & + ' wind speed (manually set fetch / m): ',F11.4/) + ! 970 FORMAT ( ' User-defined energy spectrum F(f,theta).'// & ' Scale factor (-) : ',E12.4/) ! diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index c4eea304c9..95981c01ce 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -881,8 +881,9 @@ if [ "$multi08" = 'y' ] then echo ' ' >> matrix.body - echo "$rtst -s ST4_PR3_UQ_MPI -w work_ST4_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_08" >> matrix.body - echo "$rtst -i i_lowres_multi -w work_lowres -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_08" >> matrix.body + echo "$rtst -s ST4_PR3_UQ_MPI -w work_ST4_PR3_UQ_MPI -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_08" >> matrix.body + echo "$rtst -i i_lowres_multi -w work_lowres -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_08" >> matrix.body + echo "$rtst -i i_lowres_multi_jonswap -w work_lowres_jonswap -m grdset_a -f -p $mpi -n $np $ww3 mww3_test_08" >> matrix.body fi fi diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/grdset_a b/regtests/mww3_test_08/i_lowres_multi_jonswap/grdset_a new file mode 100644 index 0000000000..fd76ad1017 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/grdset_a @@ -0,0 +1,4 @@ +MODEL: lowres +INPUT: lowres +POINT: lowres + diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.depth b/regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.depth new file mode 100644 index 0000000000..0d2e328cfb --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.depth @@ -0,0 +1 @@ +400*1 diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.obst b/regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.obst new file mode 100644 index 0000000000..e2a7c9d765 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/lowres.obst @@ -0,0 +1,2 @@ +400*0 +400*0 diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/namelists_lowres.nml b/regtests/mww3_test_08/i_lowres_multi_jonswap/namelists_lowres.nml new file mode 100644 index 0000000000..be015afc52 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/namelists_lowres.nml @@ -0,0 +1,3 @@ +&MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +&SBT1 GAMMA = -0.038 / +END OF NAMELISTS diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/points.list b/regtests/mww3_test_08/i_lowres_multi_jonswap/points.list new file mode 100644 index 0000000000..1a493262d3 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/points.list @@ -0,0 +1 @@ +400e+3 400e+3 'center' diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/switch b/regtests/mww3_test_08/i_lowres_multi_jonswap/switch new file mode 100644 index 0000000000..d81e42bcd2 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/switch @@ -0,0 +1 @@ +PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB0 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 NOGRB DIST MPI IC0 REF0 IS0 diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.inp new file mode 100644 index 0000000000..5fa974fe60 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.inp @@ -0,0 +1,73 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + 'outer grid ' +$ +$ 0.0418 31: fmax = 0.7294 Hz +$ freq(1)=0.0418 , Cg(h=1000m)=18.67; Cg(h=142m)=22.4 m/s + 1.1 0.0418 31 36 5.0 +$ +$ Set model flags + F T T T F T +$ CFL time step: 20 km, 892 sec is OK + 800. 800. 800. 80. +$ +$&MISC CICE0 = 0.25, CICEN = 0.75, LICE = 1.0e+3, FLAGTR = 4 / + &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / + &SBT1 GAMMA = -0.038 / +END OF NAMELISTS +$ +$ Grid is designed using that of tp2.3 as a starting point +$ +$ GSTRG : String indicating type of grid +$ FLAGLL : Flag to indicate coordinate system +$ CSTRG : String indicating the type of grid index space closure + 'RECT' F 'NONE' +$ 2 NX, NY. + 20 20 +$ 3 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If CSTRG='SMPL', then SX is set to 360/NX. +$ Outer grid resolution: 20 km, 30x30 therefore implies 600 km x 600 km + 20.E3 20.E3 1. +$ 4 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ Origin = 100 km , 100 km so max x and y is 700 km 700 km + 100.E3 100.E3 1. +$ +$ 5 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. + -5. 5.75 10 -2500. 4 1 '(....)' 'UNIT' 'input' +$ + 400*1 +$ +$ If sub-grid information is available as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ + 10 1 4 1 '(....)' 'UNIT' 'input' + 400*0 + 400*0 +$ Input boundary points and excluded points -------------------------- $ + 10 1 1 '(....)' 'PART' 'input' +$ +$ Input boundary points from segment data ( FROM = PART ) ------------ $ +$ Close list by defining point (0,0) (mandatory) + 0 0 F +$ Excluded grid points from segment data ( FROM != PART ) +$ Close list by defining point (0,0) (mandatory) + 0 0 F +$ Second, define a point in a closed body of sea points to remove +$ the entire body of sea points. Also close by point (0,0) + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Close list by defining line with 0 points (mandatory) + 0. 0. 0. 0. 0 +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.nml b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.nml new file mode 100644 index 0000000000..3d4ff3d20f --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_grid_lowres.nml @@ -0,0 +1,81 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.0418 + SPECTRUM%NK = 31 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 5.0 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLCTH = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 800. + TIMESTEPS%DTXY = 800. + TIMESTEPS%DTKTH = 800. + TIMESTEPS%DTMIN = 80. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'outer grid' + GRID%NML = '../i_lowres_multi/namelists_lowres.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'CART' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 20 + RECT%NY = 20 + RECT%SX = 20.E3 + RECT%SY = 20.E3 + RECT%X0 = 100.E3 + RECT%Y0 = 100.E3 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../i_lowres_multi/lowres.depth' + DEPTH%IDLA = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the obstruction map via OBST_NML namelist +! -------------------------------------------------------------------- ! +&OBST_NML + OBST%SF = 1 + OBST%FILENAME = '../i_lowres_multi/lowres.obst' + OBST%IDLA = 4 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.inp new file mode 100644 index 0000000000..855ae2ad30 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.inp @@ -0,0 +1,72 @@ +$ WAVEWATCH III multi-scale input file +$ ------------------------------------ +$ 1) Number of wave model grids. ( NRGRD ) +$ 2) Number of grids defining input fields. ( NRINP ) +$ 3) Flag for using unified point output file. ( UNIPTS ) +$ 4) Output server type as in ww3_shel.inp +$ 5) Flag for dedicated process for unified point output. +$ 6) Flag for grids sharing dedicated output processes. + 1 0 F 1 F F +$ +$ input data grids : NONE +$ unified point output file : NONE +$ +$ Now each actual wave model grid is defined using 15 parameters to be +$ read fom a single line in the file. Each line contains the following +$ parameters +$ 1) Define the grid with the extension of the mod_def file. +$ 2-10) Define the inputs used by the grids with 10 keywords +$ corresponding to the 10 flags defining the input in the +$ input files. Valid keywords are: +$ 'no' : This input is not used. +$ 'native' : This grid has its own input files, e.g. grid +$ grdX (mod_def.grdX) uses ice.grdX. +$ 'MODID' : Take input from the grid identified by +$ MODID. In the example below, all grids get +$ their wind from wind.input (mod_def.input). +$ 11) Rank number of grid (internally sorted and reassigned). +$ 12) Group number (internally reassigned so that different +$ ranks result in different group numbers. +$ 13-14) Define fraction of communicator (processes) used for this +$ grid. +$ 15) Flag identifying dumping of boundary data used by this +$ grid. If true, the file nest.MODID is generated. +$ + 'lowres' 'no' 'no' 'native' 'native' 'no' 'no' 'no' 'no' 'no' 1 1 0.00 1.00 F +$ +$ Starting and ending times for the entire model run + 20151025 000000 20151026 000000 +$ 20151025 000000 20151031 000000 +$ +$ Flag for masking computation in two-way nesting +$ Flag for masking at printout time. + T T +$ +$ Conventional output requests as in ww3_shel.inp. Will be applied +$ to all grids. + 20151025 000000 10800 20151031 000000 +$ +$ Output request flags identifying fields as in ww3_shel.inp. + N + HS WND ICE DPT DIR +$ +$ Points + 20151025 000000 10800 20151031 000000 + 400e+3 400e+3 'center' + 0.E3 0.E3 'STOPSTRING' +$ +$ Track + 20090525 000000 0 20090526 000000 +$ Restart + 20090525 000000 0 20090526 000000 +$ Boundaries + 20090525 000000 0 20090526 000000 +$ Wave field data + 20090525 000000 36000 20090526 000000 + 0 999 1 0 999 1 F +$ + 'the_end' 0 +$ + 'STP' +$ +$ End of input file diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.nml b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.nml new file mode 100644 index 0000000000..dbcf606fa0 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_multi_grdset_a.nml @@ -0,0 +1,60 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_multi.nml - multi-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%FLGHG1 = T + DOMAIN%FLGHG2 = T + DOMAIN%START = '20151025 000000' + DOMAIN%STOP = '20151026 000000' +/ + +! -------------------------------------------------------------------- ! +! Define each input grid via the INPUT_GRID_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_GRID_NML +/ + +! -------------------------------------------------------------------- ! +! Define each model grid via the MODEL_GRID_NML namelist +! -------------------------------------------------------------------- ! +&MODEL_GRID_NML + MODEL(1)%NAME = 'lowres' + MODEL(1)%FORCING%WINDS = 'native' + MODEL(1)%FORCING%ICE_CONC = 'native' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + ALLTYPE%FIELD%LIST = 'HS WND ICE DPT DIR' + ALLTYPE%POINT%FILE = '../i_lowres_multi/points.list' + ALLTYPE%PARTITION = 0 999 1 0 999 1 F +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + ALLDATE%FIELD = '20151025 000000' '10800' '20151031 000000' + ALLDATE%POINT = '20151025 000000' '10800' '20151031 000000' + ALLDATE%PARTITION = '20090525 000000' '36000' '20090526 000000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML +/ + +&HOMOG_INPUT_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.inp new file mode 100644 index 0000000000..665a235251 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.inp @@ -0,0 +1,43 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151025 000000 10800 999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ + N + HS WND ICE DPT DIR +$ +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 3 4 + 0 1 2 + T +$ +$ -------------------------------------------------------------------- $ +$ File prefix +$ number of characters in date [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +$ IX and IY ranges [regular:IX NX IY NY, unstructured:IP NP 1 1] +$ + ww3. + 6 + 1 1000000 1 1000000 +$ +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time indicator with S3 +$ characters, and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.nml b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.nml new file mode 100644 index 0000000000..c68cf44976 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_ounf.nml @@ -0,0 +1,25 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20151025 000000' + FIELD%TIMESTRIDE = '10800' + FIELD%TIMECOUNT = '999' + FIELD%LIST = 'HS WND ICE DPT DIR' + FIELD%PARTITION = '0 1 2' + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_outf.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_outf.inp new file mode 100644 index 0000000000..16e2306972 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_outf.inp @@ -0,0 +1,11 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 20151025 000000 10800 999 +$ + N + HS WND ICE DPT DIR +$ +$ Output type ITYPE [0,1,2,3], and IPART [ 0,...,NOSWLL ] +$ ITYPE = 3, transfer files. + 3 0 + 1 999 1 999 1 1 diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_ice.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_ice.inp new file mode 100644 index 0000000000..3e02bdf58b --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_ice.inp @@ -0,0 +1,33 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ + 'ICE' 'LL' T T +$ +$ min(x) max(x) nx ; min(y) max(y) ny +$ We use a 2x2 grid, since the winds will be uniform + 0.0 1000.0e+3 2 0.0 1000.0e+3 2 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ +$ 'UNIT' 3 1 '(..T..)' '(..F..)' + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F5.2))' + 402 '../input/ice.ascii' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_wind.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_wind.inp new file mode 100644 index 0000000000..710a47f55a --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_prep_wind.inp @@ -0,0 +1,42 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ + 'WND' 'LL' T T +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680605 120000 +$ +$ Additional input format type 'LL' ---------------------------------- $ +$ Grid range (degr.) and number of points for longitudes and latitudes, +$ respectively. +$ min(x) max(x) nx ; min(y) max(y) ny +$ We use a 2x2 grid, since the winds will be uniform + 0.0 1000.0e+3 2 0.0 1000.0e+3 2 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ +$ 'UNIT' 3 1 '(..T..)' '(..F..)' + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F7.2))' + 401 '../input/wnd.ascii' +$ 10 'data_file.2' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_strt.inp b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_strt.inp new file mode 100644 index 0000000000..4c7f29a48e --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_multi_jonswap/ww3_strt.inp @@ -0,0 +1,77 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Initial conditions input file $ +$--------------------------------------------------------------------- $ +$ type of initial field ITYPE . +$ +$ +$ ITYPE = 1 ---------------------------------------------------------- $ +$ Gaussian in frequency and space, cos type in direction. +$ - fp and spread (Hz), mean direction (degr., oceanographic +$ convention) and cosine power, Xm and spread (degr. or m) Ym and +$ spread (degr. or m), Hmax (m) (Example for lon-lat grid in degr.). +$ +$ 0.10 0.01 270. 2 1. 0.5 1. 0.5 2.5 +$ 0.10 0.01 270. 2 0. 1000. 1. 1000. 0.01 +$ 0.10 0.01 270. 2 0. 1000. 1. 1000. 0. +$ +$ ITYPE = 2 ---------------------------------------------------------- $ +$ JONSWAP spectrum with Hasselmann et al. (1980) direct. distribution. +$ - alfa, peak freq. (Hz), mean direction (degr., oceanographical +$ convention), gamma, sigA, sigB, Xm and spread (degr. or m) Ym and +$ spread (degr. or m) (Example for lon-lat grid in degr.). +$ alfa, sigA, sigB give default values if less than or equal to 0. +$ +$ 0.0081 0.1 270. 1.0 0. 0. 1. 100. 1. 100. +$ +$ ITYPE = 3 ---------------------------------------------------------- $ +$ Fetch-limited JONSWAP +$ - No additional data, the local spectrum is calculated using the +$ local wind speed and direction, using the spatial grid size as +$ fetch, and assuring that the spectrum is within the discrete +$ frequency range. +$ +$ ITYPE = 4 ---------------------------------------------------------- $ +$ User-defined spectrum +$ - Scale factor., defaults to 1 if less than or equal 0. +$ - Spectrum F(f,theta) (single read statement) +$ +$ -0.1 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 1 4 2 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 1 2 3 2 1 1 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 1 3 9 7 5 3 2 1 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 1 3 4 3 2 1 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ ITYPE = 5 ---------------------------------------------------------- $ +$ Starting from calm conditions. +$ - No additional data. +$ +$ ITYPE = 6 ---------------------------------------------------------- $ +$ Similar to ITYPE = 3, but with manually specified fetch. +$ - assumed fetch (m): +$ +6 +10000 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/namelists_outer.nml b/regtests/mww3_test_08/i_lowres_shel_jonswap/namelists_outer.nml new file mode 100644 index 0000000000..be015afc52 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/namelists_outer.nml @@ -0,0 +1,3 @@ +&MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / +&SBT1 GAMMA = -0.038 / +END OF NAMELISTS diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/outer.depth b/regtests/mww3_test_08/i_lowres_shel_jonswap/outer.depth new file mode 100644 index 0000000000..0d2e328cfb --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/outer.depth @@ -0,0 +1 @@ +400*1 diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/outer.obst b/regtests/mww3_test_08/i_lowres_shel_jonswap/outer.obst new file mode 100644 index 0000000000..e2a7c9d765 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/outer.obst @@ -0,0 +1,2 @@ +400*0 +400*0 diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/points.list b/regtests/mww3_test_08/i_lowres_shel_jonswap/points.list new file mode 100644 index 0000000000..1a493262d3 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/points.list @@ -0,0 +1 @@ +400e+3 400e+3 'center' diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/switch b/regtests/mww3_test_08/i_lowres_shel_jonswap/switch new file mode 100644 index 0000000000..d81e42bcd2 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/switch @@ -0,0 +1 @@ +PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB0 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 NOGRB DIST MPI IC0 REF0 IS0 diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.inp new file mode 100644 index 0000000000..5fa974fe60 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.inp @@ -0,0 +1,73 @@ +$ WAVEWATCH III Grid preprocessor input file +$ ------------------------------------------ + 'outer grid ' +$ +$ 0.0418 31: fmax = 0.7294 Hz +$ freq(1)=0.0418 , Cg(h=1000m)=18.67; Cg(h=142m)=22.4 m/s + 1.1 0.0418 31 36 5.0 +$ +$ Set model flags + F T T T F T +$ CFL time step: 20 km, 892 sec is OK + 800. 800. 800. 80. +$ +$&MISC CICE0 = 0.25, CICEN = 0.75, LICE = 1.0e+3, FLAGTR = 4 / + &MISC CICE0 = 0.25, CICEN = 0.75, FLAGTR = 4 / + &SBT1 GAMMA = -0.038 / +END OF NAMELISTS +$ +$ Grid is designed using that of tp2.3 as a starting point +$ +$ GSTRG : String indicating type of grid +$ FLAGLL : Flag to indicate coordinate system +$ CSTRG : String indicating the type of grid index space closure + 'RECT' F 'NONE' +$ 2 NX, NY. + 20 20 +$ 3 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If CSTRG='SMPL', then SX is set to 360/NX. +$ Outer grid resolution: 20 km, 30x30 therefore implies 600 km x 600 km + 20.E3 20.E3 1. +$ 4 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ Origin = 100 km , 100 km so max x and y is 700 km 700 km + 100.E3 100.E3 1. +$ +$ 5 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. + -5. 5.75 10 -2500. 4 1 '(....)' 'UNIT' 'input' +$ + 400*1 +$ +$ If sub-grid information is available as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ + 10 1 4 1 '(....)' 'UNIT' 'input' + 400*0 + 400*0 +$ Input boundary points and excluded points -------------------------- $ + 10 1 1 '(....)' 'PART' 'input' +$ +$ Input boundary points from segment data ( FROM = PART ) ------------ $ +$ Close list by defining point (0,0) (mandatory) + 0 0 F +$ Excluded grid points from segment data ( FROM != PART ) +$ Close list by defining point (0,0) (mandatory) + 0 0 F +$ Second, define a point in a closed body of sea points to remove +$ the entire body of sea points. Also close by point (0,0) + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Close list by defining line with 0 points (mandatory) + 0. 0. 0. 0. 0 +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.nml b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.nml new file mode 100644 index 0000000000..0907d09978 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_grid.nml @@ -0,0 +1,81 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III - ww3_grid.nml - Grid pre-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the spectrum parameterization via SPECTRUM_NML namelist +! -------------------------------------------------------------------- ! +&SPECTRUM_NML + SPECTRUM%XFR = 1.1 + SPECTRUM%FREQ1 = 0.0418 + SPECTRUM%NK = 31 + SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 5.0 +/ + +! -------------------------------------------------------------------- ! +! Define the run parameterization via RUN_NML namelist +! -------------------------------------------------------------------- ! +&RUN_NML + RUN%FLCX = T + RUN%FLCY = T + RUN%FLCTH = T + RUN%FLSOU = T +/ + +! -------------------------------------------------------------------- ! +! Define the timesteps parameterization via TIMESTEPS_NML namelist +! -------------------------------------------------------------------- ! +&TIMESTEPS_NML + TIMESTEPS%DTMAX = 800. + TIMESTEPS%DTXY = 800. + TIMESTEPS%DTKTH = 800. + TIMESTEPS%DTMIN = 80. +/ + +! -------------------------------------------------------------------- ! +! Define the grid to preprocess via GRID_NML namelist +! -------------------------------------------------------------------- ! +&GRID_NML + GRID%NAME = 'outer grid' + GRID%NML = '../i_lowres_shel/namelists_outer.nml' + GRID%TYPE = 'RECT' + GRID%COORD = 'CART' + GRID%CLOS = 'NONE' + GRID%ZLIM = -5. + GRID%DMIN = 5.75 +/ + +! -------------------------------------------------------------------- ! +! Define the rectilinear grid type via RECT_NML namelist +! -------------------------------------------------------------------- ! +&RECT_NML + RECT%NX = 20 + RECT%NY = 20 + RECT%SX = 20.E3 + RECT%SY = 20.E3 + RECT%X0 = 100.E3 + RECT%Y0 = 100.E3 +/ + +! -------------------------------------------------------------------- ! +! Define the depth to preprocess via DEPTH_NML namelist +! -------------------------------------------------------------------- ! +&DEPTH_NML + DEPTH%SF = -2500. + DEPTH%FILENAME = '../i_lowres_shel/outer.depth' + DEPTH%IDLA = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the obstruction map via OBST_NML namelist +! -------------------------------------------------------------------- ! +&OBST_NML + OBST%SF = 1 + OBST%FILENAME = '../i_lowres_shel/outer.obst' + OBST%IDLA = 4 +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.inp new file mode 100644 index 0000000000..665a235251 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.inp @@ -0,0 +1,43 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151025 000000 10800 999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ + N + HS WND ICE DPT DIR +$ +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 3 4 + 0 1 2 + T +$ +$ -------------------------------------------------------------------- $ +$ File prefix +$ number of characters in date [0(nodate),4(yearly),6(monthly),8(daily),10(hourly)] +$ IX and IY ranges [regular:IX NX IY NY, unstructured:IP NP 1 1] +$ + ww3. + 6 + 1 1000000 1 1000000 +$ +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time indicator with S3 +$ characters, and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.nml b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.nml new file mode 100644 index 0000000000..c68cf44976 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_ounf.nml @@ -0,0 +1,25 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_ounf.nml - Grid output post-processing ! +! -------------------------------------------------------------------- ! + +! -------------------------------------------------------------------- ! +! Define the output fields to postprocess via FIELD_NML namelist +! -------------------------------------------------------------------- ! +&FIELD_NML + FIELD%TIMESTART = '20151025 000000' + FIELD%TIMESTRIDE = '10800' + FIELD%TIMECOUNT = '999' + FIELD%LIST = 'HS WND ICE DPT DIR' + FIELD%PARTITION = '0 1 2' + FIELD%TYPE = 4 +/ + +! -------------------------------------------------------------------- ! +! Define the content of the output file via FILE_NML namelist +! -------------------------------------------------------------------- ! +&FILE_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_outf.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_outf.inp new file mode 100644 index 0000000000..16e2306972 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_outf.inp @@ -0,0 +1,11 @@ +$ WAVEWATCH III Grid output post-processing +$ ----------------------------------------- + 20151025 000000 10800 999 +$ + N + HS WND ICE DPT DIR +$ +$ Output type ITYPE [0,1,2,3], and IPART [ 0,...,NOSWLL ] +$ ITYPE = 3, transfer files. + 3 0 + 1 999 1 999 1 1 diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_ice.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_ice.inp new file mode 100644 index 0000000000..3e02bdf58b --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_ice.inp @@ -0,0 +1,33 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ + 'ICE' 'LL' T T +$ +$ min(x) max(x) nx ; min(y) max(y) ny +$ We use a 2x2 grid, since the winds will be uniform + 0.0 1000.0e+3 2 0.0 1000.0e+3 2 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ +$ 'UNIT' 3 1 '(..T..)' '(..F..)' + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F5.2))' + 402 '../input/ice.ascii' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_wind.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_wind.inp new file mode 100644 index 0000000000..710a47f55a --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_prep_wind.inp @@ -0,0 +1,42 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ Format types : AI Transfer field 'as is'. +$ LL Field defined on longitude-latitude grid. +$ F1 Arbitrary grid, longitude and latitude of +$ each grid point given in separate file. +$ F2 Like F1, composite of 2 fields. +$ Time flag : If true, time is included in file. +$ + 'WND' 'LL' T T +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680605 120000 +$ +$ Additional input format type 'LL' ---------------------------------- $ +$ Grid range (degr.) and number of points for longitudes and latitudes, +$ respectively. +$ min(x) max(x) nx ; min(y) max(y) ny +$ We use a 2x2 grid, since the winds will be uniform + 0.0 1000.0e+3 2 0.0 1000.0e+3 2 +$ +$ Define data files -------------------------------------------------- $ +$ The first input line identifies the file format with FROM, IDLA and +$ IDFM, the second (third) lines give the file unit number and name. +$ +$ 'UNIT' 3 1 '(..T..)' '(..F..)' + 'NAME' 1 2 '(I10,1x,I10)' '(1000(F7.2))' + 401 '../input/wnd.ascii' +$ 10 'data_file.2' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.inp new file mode 100644 index 0000000000..0a3343dff7 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.inp @@ -0,0 +1,132 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ Define input to be used with flag for use and flag for definition +$ as a homogeneous field (first three only); eight input lines. +$ + F F Water levels + F F Currents + T F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ +$ Time frame of calculations ----------------------------------------- $ +$ - Starting time in yyyymmdd hhmmss format. +$ - Ending time in yyyymmdd hhmmss format. +$ + 20151025 000000 + 20151026 000000 +$ +$ Define output data ------------------------------------------------- $ +$ +$ Define output server mode. This is used only in the parallel version +$ of the model. To keep the input file consistent, it is always needed. +$ IOSTYP = 1 is generally recommended. IOSTYP > 2 may be more efficient +$ for massively parallel computations. Only IOSTYP = 0 requires a true +$ parallel file system like GPFS. +$ +$ IOSTYP = 0 : No data server processes, direct access output from +$ each process (requirese true parallel file system). +$ 1 : No data server process. All output for each type +$ performed by process that performes computations too. +$ 2 : Last process is reserved for all output, and does no +$ computing. +$ 3 : Multiple dedicated output processes. +$ + 1 +$ +$ Five output types are available (see below). All output types share +$ a similar format for the first input line: +$ - first time in yyyymmdd hhmmss format, output interval (s), and +$ last time in yyyymmdd hhmmss format (all integers). +$ Output is disabled by setting the output interval to 0. +$ +$ Type 1 : Fields of mean wave parameters +$ Standard line and line with logical flags to activate output +$ fields as defined in section 2.4 of the manual. The logical +$ flags are not supplied if no output is requested. The logical +$ flags can be placed on multiple consecutive lines. However, +$ the total number and order of the logical flags is fixed. +$ The raw data file is out_grd.ww3, +$ see w3iogo.ftn for additional doc. +$ + 20151025 000000 10800 20151031 000000 +$---------------------------------------------------------------- +$ Output request flags identifying fields as in ww3_shel input and +$ section 2.4 of the manual. If the first flag is 'N' then a namelist +$ is read. See ww3_ounf.inp for an example +$ + N + HS WND ICE DPT DIR +$ +$ +$---------------------------------------------------------------- +$ +$ Type 2 : Point output +$ Standard line and a number of lines identifying the +$ longitude, latitude and name (C*40) of output points. +$ The list is closed by defining a point with the name +$ 'STOPSTRING'. No point info read if no point output is +$ requested (i.e., no 'STOPSTRING' needed). +$ Example for spherical grid. +$ The raw data file is out_pnt.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ NOTE : Spaces may be included in the name, but this is not +$ advised, because it will break the GrADS utility to +$ plots spectra and source terms, and will make it more +$ diffucult to use point names in data files. +$ +$ Points + 20151025 000000 10800 20151031 000000 + 400e+3 400e+3 'center' + 0.E3 0.E3 'STOPSTRING' +$ +$ Type 3 : Output along track. +$ Flag for formatted input file. +$ The data files are track_i.ww3 and +$ track_o.ww3, see w3iotr.ftn for ad. doc. +$ + 20130801 000000 0 20130815 000000 +$ F +$ +$ Type 4 : Restart files (no additional data required). +$ The data file is restartN.ww3, see +$ w3iors.ftn for additional doc. +$ + 20130801 000000 0 20130815 000000 +$ +$ Type 5 : Boundary data (no additional data required). +$ The data file is nestN.ww3, see +$ w3iobp.ftn for additional doc. +$ + 20130801 000000 0 20130815 000000 +$ +$ Type 6 : Separated wave field data (dummy for now). +$ First, last step IX and IY, flag for formatted file +$ + 20130801 000000 0 20130815 000000 +$ 0 999 1 0 999 1 T +$ +$ Homogeneous field data --------------------------------------------- $ +$ Homogeneous fields can be defined by a list of lines containing an ID +$ string 'LEV' 'CUR' 'WND', date and time information (yyyymmdd +$ hhmmss), value (S.I. units), direction (current and wind, oceanogr. +$ convention degrees)) and air-sea temparature difference (degrees C). +$ 'STP' is mandatory stop string. +$ Also defined here are the speed with which the grid is moved +$ continuously, ID string 'MOV', parameters as for 'CUR'. +$ +$ 'LEV' 19680606 010000 1.00 +$ 'CUR' 19680606 073125 2.0 25. +$ 'WND' 19680606 000000 20. 145. 2.0 +$ 'MOV' 19680606 013000 4.0 25. + 'STP' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.nml b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.nml new file mode 100644 index 0000000000..adb8e3e672 --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_shel.nml @@ -0,0 +1,49 @@ +! -------------------------------------------------------------------- ! +! WAVEWATCH III ww3_shel.nml - single-grid model ! +! -------------------------------------------------------------------- ! + + +! -------------------------------------------------------------------- ! +! Define top-level model parameters via DOMAIN_NML namelist +! -------------------------------------------------------------------- ! +&DOMAIN_NML + DOMAIN%START = '20151025 000000' + DOMAIN%STOP = '20151026 000000' +/ + +! -------------------------------------------------------------------- ! +! Define each forcing via the INPUT_NML namelist +! -------------------------------------------------------------------- ! +&INPUT_NML + INPUT%FORCING%WINDS = 'T' + INPUT%FORCING%ICE_CONC = 'T' +/ + +! -------------------------------------------------------------------- ! +! Define the output types point parameters via OUTPUT_TYPE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_TYPE_NML + TYPE%FIELD%LIST = 'HS WND ICE DPT DIR' + TYPE%POINT%FILE = '../i_lowres_shel/points.list' +/ + +! -------------------------------------------------------------------- ! +! Define output dates via OUTPUT_DATE_NML namelist +! -------------------------------------------------------------------- ! +&OUTPUT_DATE_NML + DATE%FIELD = '20151025 000000' '10800' '20151031 000000' + DATE%POINT = '20151025 000000' '10800' '20151031 000000' +/ + +! -------------------------------------------------------------------- ! +! Define homogeneous input via HOMOG_COUNT_NML and HOMOG_INPUT_NML namelist +! -------------------------------------------------------------------- ! +&HOMOG_COUNT_NML +/ + +&HOMOG_INPUT_NML +/ + +! -------------------------------------------------------------------- ! +! WAVEWATCH III - end of namelist ! +! -------------------------------------------------------------------- ! diff --git a/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_strt.inp b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_strt.inp new file mode 100644 index 0000000000..4c7f29a48e --- /dev/null +++ b/regtests/mww3_test_08/i_lowres_shel_jonswap/ww3_strt.inp @@ -0,0 +1,77 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Initial conditions input file $ +$--------------------------------------------------------------------- $ +$ type of initial field ITYPE . +$ +$ +$ ITYPE = 1 ---------------------------------------------------------- $ +$ Gaussian in frequency and space, cos type in direction. +$ - fp and spread (Hz), mean direction (degr., oceanographic +$ convention) and cosine power, Xm and spread (degr. or m) Ym and +$ spread (degr. or m), Hmax (m) (Example for lon-lat grid in degr.). +$ +$ 0.10 0.01 270. 2 1. 0.5 1. 0.5 2.5 +$ 0.10 0.01 270. 2 0. 1000. 1. 1000. 0.01 +$ 0.10 0.01 270. 2 0. 1000. 1. 1000. 0. +$ +$ ITYPE = 2 ---------------------------------------------------------- $ +$ JONSWAP spectrum with Hasselmann et al. (1980) direct. distribution. +$ - alfa, peak freq. (Hz), mean direction (degr., oceanographical +$ convention), gamma, sigA, sigB, Xm and spread (degr. or m) Ym and +$ spread (degr. or m) (Example for lon-lat grid in degr.). +$ alfa, sigA, sigB give default values if less than or equal to 0. +$ +$ 0.0081 0.1 270. 1.0 0. 0. 1. 100. 1. 100. +$ +$ ITYPE = 3 ---------------------------------------------------------- $ +$ Fetch-limited JONSWAP +$ - No additional data, the local spectrum is calculated using the +$ local wind speed and direction, using the spatial grid size as +$ fetch, and assuring that the spectrum is within the discrete +$ frequency range. +$ +$ ITYPE = 4 ---------------------------------------------------------- $ +$ User-defined spectrum +$ - Scale factor., defaults to 1 if less than or equal 0. +$ - Spectrum F(f,theta) (single read statement) +$ +$ -0.1 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 1 4 2 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 1 2 3 2 1 1 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 1 3 9 7 5 3 2 1 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 1 3 4 3 2 1 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ ITYPE = 5 ---------------------------------------------------------- $ +$ Starting from calm conditions. +$ - No additional data. +$ +$ ITYPE = 6 ---------------------------------------------------------- $ +$ Similar to ITYPE = 3, but with manually specified fetch. +$ - assumed fetch (m): +$ +6 +10000 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/mww3_test_08/info b/regtests/mww3_test_08/info index b86805c646..e9e1fc3f3d 100644 --- a/regtests/mww3_test_08/info +++ b/regtests/mww3_test_08/info @@ -6,14 +6,16 @@ # directories # # # # Available input directories are as follows: # -# Directory Grid Set Example below # +# Directory Grid Set Example below # # /input/ grdset_a (E1), (E2) # # /i_highres_multi/ grdset_a (E6) # # /i_highres_shel/ N/A (E4) # # /i_highres_shel_IC1/ N/A # # /i_lowres_multi/ grdset_a (E5) # +# /i_lowres_multi_jonswap/ grdset_a # # /i_lowres_shel/ N/A (E3) # # /i_lowres_shel_IC1/ N/A # +# /i_lowres_shel_jonswap/ N/A # # # # In case of /input/ , there are alternative switches: # # S1) switch # From 1d58d7c367d1b16abeff3318e9105053655d35d2 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Mon, 28 Jul 2025 16:42:40 -0400 Subject: [PATCH 092/136] Add -check all -check noarg_temp_created -ftrapuv flags to intel DEBUG builds Co-authored-by: Brian Curtis --- CMakeLists.txt | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5070e3aa58..b958d205f3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -16,6 +16,13 @@ if(hasParent) # Unset flags that come from Parent (ie UFS or other coupled build) # for potential (-r8/-r4) conflict set(CMAKE_Fortran_FLAGS "") + if(CMAKE_Fortran_COMPILER_ID MATCHES "^(Intel)$") + set(CMAKE_Fortran_FLAGS_DEBUG "-check all -check noarg_temp_created -ftrapuv") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^(IntelLLVM)$") + set(CMAKE_Fortran_FLAGS_DEBUG "-check all -check noarg_temp_created -ftrapuv") + else() + message(WARNING "Fortran compiler with ID ${CMAKE_Fortran_COMPILER_ID} will be used with CMake default options") + endif() set(CMAKE_C_FLAGS "") remove_definitions(-DDEBUG) endif() From aa7c2d73131f975becbfbbe2a047d87a54ddcd52 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Mon, 28 Jul 2025 19:12:58 -0400 Subject: [PATCH 093/136] Fix 3/2 integer division in W3FLD1 Co-authored-by: Nicholas Szapiro <149816583+NickSzapiro-NOAA@users.noreply.github.com> --- model/src/w3fld1md.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 1a7ca926d8..0fa18457b9 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -586,12 +586,12 @@ SUBROUTINE W3FLD1( ASPC, FPI, WNDX,WNDY, ZWND, & Z2=NKT UP1(ZI) = ( ( ( WN(Z2)**2 / DELTA ) * FTILDE(z2) ) + & ( DAIR / ( ZOFK(Z2) * KAPPA ) ) * ( SQRT( & - TLTN(ZI)**2 + TLTE(ZI)**2 ) / DAIR )**(3/2) ) & + TLTN(ZI)**2 + TLTE(ZI)**2 ) / DAIR )**(1.5) ) & * ( TLTE(ZI) ) / ( TLTE(ZI) * TAUX & + TLTN(ZI) * TAUY ) VP1(ZI) = ( ( ( WN(Z2)**2 / DELTA ) * FTILDE(z2) ) + & ( DAIR / ( ZOFK(Z2) * KAPPA ) ) * ( SQRT ( & - TLTN(ZI)**2 + TLTE(ZI)**2 ) / DAIR )**(3/2) ) & + TLTN(ZI)**2 + TLTE(ZI)**2 ) / DAIR )**(1.5) ) & * ( TLTN(ZI) ) / ( TLTE(ZI) * TAUX & + TLTN(ZI) * TAUY ) UP(ZI) = UP1(ZI) From c5780b8a7d87cd94ed2f861620af18f0483aab84 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Thu, 31 Jul 2025 15:14:20 -0400 Subject: [PATCH 094/136] Fix uninitialized FLOGRR for consistent restart files (#1478) --- model/src/w3odatmd.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 845e025676..7ac39a6fc0 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -695,6 +695,7 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) OUTPTS(I)%TBPIN = (-1,0) ! OUTPTS(I)%OUT1%IPASS1 = 0 + OUTPTS(I)%OUT1%FLOGRR = .FALSE. #ifdef W3_MPI OUTPTS(I)%OUT1%NRQGO = 0 OUTPTS(I)%OUT1%NRQGO2 = 0 From 1b77ef2bdcb6da9e0a6d6de02971d246f47fe351 Mon Sep 17 00:00:00 2001 From: "Max H. Balsmeier" Date: Wed, 13 Aug 2025 14:39:32 +0200 Subject: [PATCH 095/136] Bugfix regarding JONSWAP initialization --- model/src/w3iorsmd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 48459d3de1..32652e0e94 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -567,7 +567,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) END IF IF (TYPE.EQ.'FULL') THEN RSTYPE = 2 - ELSE IF (TYPE.EQ.'WIND') THEN + ELSE IF (TYPE.EQ.'WIND' .OR. TYPE.EQ.'FTCH') THEN RSTYPE = 1 ELSE IF (TYPE.EQ.'CALM') THEN RSTYPE = 4 From 643cb5a68f013b6dacec72cb67eaf44dea11203b Mon Sep 17 00:00:00 2001 From: "W. Erick Rogers" <156342000+ErickRogers@users.noreply.github.com> Date: Wed, 20 Aug 2025 15:19:08 -0500 Subject: [PATCH 096/136] branch=IC4_safety_fix --- manual/eqs/ICE4.tex | 20 +++++++++++--------- manual/manual.bib | 16 ++++++++++++++++ model/src/w3sic4md.F90 | 26 ++++++++++++++------------ 3 files changed, 41 insertions(+), 21 deletions(-) diff --git a/manual/eqs/ICE4.tex b/manual/eqs/ICE4.tex index 1ee257d606..f38296c7f8 100644 --- a/manual/eqs/ICE4.tex +++ b/manual/eqs/ICE4.tex @@ -5,9 +5,9 @@ \subsubsection{~$S_{ice}$: Empirical/parametric damping by sea ice} \label{sec:I \opthead{IC4}{\ws/NRL}{C. Collins and E. Rogers} \noindent -The fourth option ({\code IC4}) for damping of waves by sea ice was introduced by \cite{rep:CR17}. It gives methods to implement one of several simple, empirical/parametric forms for the dissipation of wave energy by sea ice. The motivation for {\code IC4} is to provide a simple, flexible, and efficient source term which reproduces, albeit in a highly parameterized way, some basic physics of wave-ice interaction. The method is set by the integer value (presently 1 to 7) for {\code IC4METHOD} namelist parameter: 1) an exponential fit to the field data of \cite{art:WAD88}, 2) the polynomial fit in \cite{art:MBK14}, 3) a quadratic fit to the calculations of \cite{art:KM08} given in \cite{art:HT15}, 4) Eq. 1 of \cite{art:Ko14}, 5) a simple step function with up to 4 steps (may be nonstationary and non-uniform), and 6) a simple step function with up to 10 steps (must be stationary and uniform), and 7) a formula from \cite{art:Dob15} which uses ice thickness. All but the fourth method of {\code IC4} feature frequency-dependent attenuation. With the fourth method, attenuation varies with waveheight but is uniform in frequency space. +The fourth option ({\code IC4}) for damping of waves by sea ice was introduced (in its earliest form) by \cite{rep:CR17}. It gives methods to implement one of several simple, empirical/parametric forms for the dissipation of wave energy by sea ice. The motivation for {\code IC4} is to provide a simple, flexible, and efficient source term which reproduces, albeit in a highly parameterized way, some basic physics of wave-ice interaction. The method is set by the integer value (presently 1 to 10) for {\code IC4METHOD} namelist parameter. The first six are: 1) an exponential fit to the field data of \cite{art:WAD88}, 2) the polynomial fit in \cite{art:MBK14}, 3) a quadratic fit to the calculations of \cite{art:KM08} given in \cite{art:HT15}, 4) Eq. 1 of \cite{art:Ko14}, 5) a simple step function with up to 4 steps (may be nonstationary and non-uniform), and 6) a simple step function with up to 10 steps (must be stationary and uniform). Methods 7, 8, and 9 use multivariate power fits with dependence on frequency and ice thickness. All but the fourth method of {\code IC4} feature frequency-dependent attenuation. With the fourth method, attenuation varies with waveheight but is uniform in frequency space. -In the following discussion we use {\code IC4M1} to denote {\code IC4} method 1, and so forth. {\code IC4} appears in the {\file switch} and namelist {\code IC4METHOD=1} (for example) appears in the file {\file ww3\_grid.inp}. Whereas in {\code IC1}, ${C_{ice,1}}$ is the user-determined attenuation, for {\code IC4M1}, {\code IC4M2}, and {\code IC4M4} ${C_{ice,n}}$ are constants of the equations. For {\code IC4M3}, ${C_{ice,1}}$ is ice thickness. For {\code IC4M5}, ${C_{ice,n}}$ controls the step function. Note that ${C_{ice,n}}$ may be provided by the user as non-stationary and non-uniform using methods analogous to methods used to input water levels. +In the following discussion we use {\code IC4M1} to denote {\code IC4} method 1, and so forth. {\code IC4} appears in the {\file switch} and namelist {\code IC4METHOD=1} (for example) appears in the file {\file ww3\_grid.inp}. Whereas in {\code IC1}, ${C_{ice,1}}$ is the user-determined attenuation, here the meaning of ${C_{ice,n}}$ is context-dependent. With {\code IC4M1}, {\code IC4M2}, and {\code IC4M4} ${C_{ice,n}}$ are constants of the equations. For {\code IC4M3}, {\code IC4M7}, {\code IC4M8}, and {\code IC4M9}, ${C_{ice,1}}$ is ice thickness. For {\code IC4M5}, ${C_{ice,n}}$ controls the step function. For {\code IC4M6}, namelist variables control the step function. Note that, for methods which use it, ${C_{ice,n}}$ may be provided by the user as non-stationary and non-uniform using methods analogous to methods used to input water levels. {\code IC4M1}: an exponential equation was chosen to fit the data contained in table 2 of \cite{art:WAD88} which results in preferential attenuation of high frequency waves. This parameterizes the well-known low-pass filtering effect of ice. The equation has the following form: \begin{equation}\label{eq:ice1} @@ -26,13 +26,15 @@ \subsubsection{~$S_{ice}$: Empirical/parametric damping by sea ice} \label{sec:I With appropriate coefficients, this polynomial method can be used to reproduce the so-called “roll-over effect” where the attenuation is non-monotonic in frequency space. However, some recent studies do not indicate this effect, e.g. \cite{art:RTS16} and \cite{art:LK17}, and it may just be a spurious artifact in prior observational studies. +Though ${C_{ice,1...5}}$ can be specified to vary in time and space, this feature is rarely used in practice. Most users will prefer to use constant values, and for convenience, these can be set using namelist parameters, where $C_{ice,i}$ is specified as {\code IC4CN(i)} in the {\code SIC4} namelist rather than as an input field using {\file ww3\_prep}, etc. + {\code IC4M3}: \cite{art:HT15} fit a quadratic equation to the attenuation coefficient calculated by \cite{art:KM08} as a function of frequency, $T$, and ice thickness, $h$. Attenuation increases for thicker ice and higher frequencies (lower periods). The number of coefficients of the quadratic equation were prohibitively large to be user-determined, so the equation is hardwired in and the tunable parameter, ${C_{ice,1}}$, is ice thickness $h$. This method is described and applied in \cite{rep:CR17}. For reference, the equation is the following: \begin{equation}\label{eq:ice3} {\ln{\alpha(T,h)}} = -0.3203 + 2.058h - 0.9375T - 0.4269h^2 + 0.1566hT + 0.0006T^2 \end{equation} \noindent -There are two warnings to make about {\code IC4M3}. First, the equation itself was an extrapolation of the original range of $h$ used to calculate the attenuation coefficients in \cite{art:KM08} which was between 0.5 and 3 m, see \cite{art:HT15}. Second, in \cite{art:KM08}, wave attenuation predicted is based on scattering (a conservative process), whereas in {\code IC4M3}, the wave attenuation is treated as dissipation (non-conservative). This is ad hoc and not recommended for general use. Most especially, users should think twice before using {\code IC4M3} in combination with scattering routines {\code IS1} or {\code IS2}, since this is essentially double-counting scattering. +There are four warnings to make about {\code IC4M3}. First, the equation itself was an extrapolation of the original range of $h$ used to calculate the attenuation coefficients in \cite{art:KM08} which was between 0.5 and 3 m, see \cite{art:HT15}. Second, in \cite{art:KM08}, wave attenuation predicted is based on scattering (a conservative process), whereas in {\code IC4M3}, the wave attenuation is treated as dissipation (non-conservative). Third, we recommend against using {\code IC4M3} in combination with scattering routines {\code IS1} or {\code IS2}, since this would include scattering twice. Fourth, the implementation assumes that one floe is encountered per meter. This is a departure from \cite{art:HT15} which allows this length scale to vary. The reader is referred to the inline documentation in {\file w3sic4md.F90} for further detail. {\code IC4M4}: \cite{art:Ko14} found that attenuation was a function of significant wave height. Attenuation increased linearly with ${H_s}$ until ${H_s} = 3$ m at which point attenuation is capped, thus: \begin{equation} @@ -44,11 +46,11 @@ \subsubsection{~$S_{ice}$: Empirical/parametric damping by sea ice} \label{sec:I \end{equation} where {$k_i=\frac{\partial H_s}{\partial dx}/H_s$}. -The values given in \cite{art:Ko14} are ${C_{ice,1...2}}=[5.35\times 10^{-6}, 16.05\times 10^{-6}]$. See regression test {\file ww3\_tic1.1/input\_IC4/M4} for examples. This method is described and applied in \cite{rep:CR17}. +The values given in \cite{art:Ko14} are ${C_{ice,1...2}}=[5.35\times 10^{-6}, 16.05\times 10^{-6}]$. See regression test {\file ww3\_tic1.1/input\_IC4\_M4} for examples. This method is described and applied in \cite{rep:CR17}. -{\code IC4M5}: This is a simple step function with up to 4 steps. It is controlled by the optionally nonstationary and non-uniform parameters ${C_{ice,1...7}}$. Parameters ${C_{ice,1...4}}$ control the step levels, which are in terms of dissipation rate, ${k_i}$. Parameters ${C_{ice,5...7}}$ control the step boundaries (given in Hz). See regression test {\file ww3\_tic1.1/input\_IC4/M5} for examples. This method is described in \cite{rep:CR17}. +{\code IC4M5}: This is a simple step function with up to 4 steps. It is controlled by the optionally nonstationary and non-uniform parameters ${C_{ice,1...7}}$. Parameters ${C_{ice,1...4}}$ control the step levels, which are in terms of dissipation rate, ${k_i}$. Parameters ${C_{ice,5...7}}$ control the step boundaries (given in Hz). See regression test {\file ww3\_tic1.1/input\_IC4\_M5} for examples. This method is described in \cite{rep:CR17}. -{\code IC4M6}: This is a simple step function with up to 10 steps. It is controlled by the stationary and uniform namelist parameters {\code IC4KI} and {\code IC4FC}. Array {\code IC4KI} controls the step levels, which are in terms of dissipation rate, ${k_i}$, in radians per meter. Array {\code IC4FC} controls the step boundaries (given in Hz). See regression test {\file ww3\_tic1.1/input\_IC4/M6} for examples. +{\code IC4M6}: This is a simple step function with up to 10 steps. It is controlled by the stationary and uniform namelist parameters {\code IC4KI} and {\code IC4FC}. Array {\code IC4KI} controls the step levels, which are in terms of dissipation rate, ${k_i}$, in radians per meter. Array {\code IC4FC} controls the step boundaries (given in Hz). See regression test {\file ww3\_tic1.1/input\_IC4\_M6} for examples. {\code IC4M7}: This is a formula for dissipation from \cite{art:Dob15}, developed for a mixture of pancake and frazil ice, using data collected in the Weddell Sea (Antarctica). The formula depends on wave frequency and ice thickness: \begin{equation}\label{eq:ice7} @@ -60,12 +62,12 @@ \subsubsection{~$S_{ice}$: Empirical/parametric damping by sea ice} \label{sec:I \begin{equation}\label{eq:ice8} {k_i=C_{hf}h^mf^n} \:\:\: . \end{equation} -The formula is taken from \cite{Meylan2018}, where it is described as a ``Model with Order 3 Power Law''. It is applied by \cite{Liu2020}, where it is referred to as the ``M2'' model. The model specifies $m=1$ and $n=3$, and $C_{hf}$ is a user-specified calibration coefficient. \cite{Liu2020} provide calibration to two field cases and \cite{rep:RYW2021} provides a calibration to a third field case, \cite{art:RMK2021}. The third calibration is set as the default for {\code IC4M8}, $C_{hf}=0.059$, but can be changed in using the namelist parameter (constant and uniform) {\code IC4CN}, or using the spatially and/or temporally variable parameter ${C_{ice,2}}$ . Further details on the calibrations are available in the inline documentation in {\file w3sic4md.F90}. This method is functionally the same as the ``{\code M2}'' model in {\code IC5} (i.e., {\code IC5} with {\code IC5VEMOD=3}) and is redundantly included here as {\code IC4M8} because it is in the same ``family'' as {\code IC4M7} and {\code IC4M9}, being in the form of Eq. (\ref{eq:ice8}). +The formula is taken from \cite{Meylan2018}, where it is described as a ``Model with Order 3 Power Law''. It is applied by \cite{Liu2020}, where it is referred to as the ``M2'' model. The model specifies $m=1$ and $n=3$, and $C_{hf}$ is a user-specified calibration coefficient. \cite{Liu2020} provide calibration to two field cases and \cite{rep:RYW2021} provides a calibration to a third field case, \cite{art:RMK2021}. The third calibration is set as the default for {\code IC4M8}, $C_{hf}=0.059$, but can be changed via the namelist parameter {\code IC4CN} (constant and uniform settings), or by using the spatially and/or temporally variable parameter ${C_{ice,2}}$ . Further details on the calibrations are available in the inline documentation in {\file w3sic4md.F90}. This method is functionally the same as the ``{\code M2}'' model in {\code IC5} (i.e., {\code IC5} with {\code IC5VEMOD=3}) and is redundantly included here as {\code IC4M8} because it is in the same ``family'' as {\code IC4M7} and {\code IC4M9}, being in the form of Eq. (\ref{eq:ice8}). For an example of setting the namelist parameter, see {\file /regtests/ww3\_tic1.1/input\_IC4\_M8}. -{\code IC4M9}: This formula is taken from the ``monomial power fit'' given in section 2.2.3 of \cite{rep:RYW2021}. Like {\code IC4M7} and {\code IC4M8}, it is a specific case of the general form of Eq. (\ref{eq:ice8}). The specificity is the constraint that $m=n/2-1$. This constraint is derived by \cite{rep:RYW2021} by invoking the scaling from \cite{art:YRW2019}, which is based on Reynolds number with ice thickness as the relevant length scale. This is also given as equation 2 in \cite{art:YRW2022}. The default namelist settings are $C_{hf}=2.9$ and $n=4.5$, from calibration by \cite{rep:RYW2021} to \cite{art:RMK2021}. Further details, including alternative calibrations such as \cite{art:Yu2022}, are available in the inline documentation in {\file w3sic4md.F90}. Constant values can be set using namelist parameters, where $C_{hf}$ and $n$ are {\code IC4CN(1)} and {\code IC4CN(2)}, respectively. Spatially and/or temporally versions of the same can be specified as ${C_{ice,2}}$ and ${C_{ice,3}}$, respectively. +{\code IC4M9}: This formula is taken from the ``monomial power fit'' given in section 2.2.3 of \cite{rep:RYW2021}. Like {\code IC4M7} and {\code IC4M8}, it is a specific case of the general form of Eq. (\ref{eq:ice8}). The specificity is the constraint that $m=n/2-1$. This constraint is derived by \cite{rep:RYW2021} by invoking the scaling from \cite{art:YRW2019}, which is based on Reynolds number with ice thickness as the relevant length scale. This is also given as equation 2 in \cite{art:YRW2022}. The default namelist settings are $C_{hf}=2.9$ and $n=4.5$, from calibration by \cite{rep:RYW2021} and \cite{art:YRW2022} to \cite{art:RMK2021}. Further details, including alternative calibrations such as \cite{art:Yu2022}, are available in the inline documentation in {\file w3sic4md.F90}. Constant values can be set using namelist parameters, where $C_{hf}$ and $n$ are {\code IC4CN(1)} and {\code IC4CN(2)}, respectively. Spatial and/or temporal variability of the same can be specified using ${C_{ice,2}}$ and ${C_{ice,3}}$, respectively. The namelist default $C_{hf}$ values in {\code IC4M8} and {\code IC4M9} are consistent with those of identical formulae implemented in \cite{man:SWAN4145A}. - +{\code IC4M10} is a method for attenuation due to scattering by sea ice floes, depending on ice thickness and floe size, based on \cite{art:MHB21}. diff --git a/manual/manual.bib b/manual/manual.bib index 33e0a9fdd5..363c21c271 100644 --- a/manual/manual.bib +++ b/manual/manual.bib @@ -3226,6 +3226,22 @@ @ARTICLE{art:MBK14 number = "C14", PAGES = "5,046--5,051" } +% item art:MHB21 + +@article{art:MHB21, + author = {Michael H. Meylan and Christopher Horvat and Cecilia M. Bitz and Luke G. Bennetts}, + year = {2021}, + title = {A floe size dependent scattering model in two- and three-dimensions for wave attenuation by ice floes}, + journal=OMOD, + volume = {161}, + pages = {101779}, + issn = {1463-5003}, + doi = {https://doi.org/10.1016/j.ocemod.2021.101779}, + url = {https://www.sciencedirect.com/science/article/pii/S1463500321000299}, + keywords = {Sea ice, Ocean waves, Scattering}, + publisher={Elsevier} +} + % item art:HT15 @ARTICLE{art:HT15, diff --git a/model/src/w3sic4md.F90 b/model/src/w3sic4md.F90 index c6daacb201..40bc72c355 100644 --- a/model/src/w3sic4md.F90 +++ b/model/src/w3sic4md.F90 @@ -140,6 +140,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) !/ 11-Jan-2024 : Method 9 added (Rogers et al., 2021) !/ denoted "RYW2021" (E. Rogers) !/ 14-Aug-2024 : Method 10 added (Meylan et al. 2021) (E. Thomas) + !/ 15-Aug-2025 : Safety fix for negative hice (E. Rogers) !/ !/ FIXME : Move field input to W3SRCE and provide !/ (S.Zieger) input parameter to W3SIC1 to make the subroutine @@ -370,20 +371,21 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ! 7. Remarks : ! ! If ice parameter 1 is zero, no calculations are made. - ! For questions, comments and/or corrections, please refer to: - ! Method 1 : C. Collins - ! Method 2 : C. Collins - ! Method 3 : C. Collins - ! Method 4 : C. Collins - ! Method 5 : E. Rogers - ! Method 6 : E. Rogers - ! Method 7 : E. Rogers + ! For questions, comments and/or corrections, please contact the + ! authors in the updates list, above. ! ! ALPHA = 2 * WN_I ! Though it may seem redundant/unnecessary to have *both* in the ! code, we do it this way to make the code easier to read and ! relate to other codes and source material, and hopefully avoid ! mistakes. + ! + ! For sub-methods M3, M7, M8, and M9, ICECOEF1 (ICEP1) is used + ! to represent ice thickness. When ice thickness is taken from an + ! ice model such as CICE, we have encountered cases with spurious, + ! small, negative values, which can result in NaNs in WW3. Thus, + ! for these sub-methods, we set a lower limit of zero for ICECOEF1. + ! !/ ------------------------------------------------------------------- / ! ! 8. Structure : @@ -576,7 +578,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) WN_I = 0.5 * ALPHA CASE (3) ! IC4M3 : Quadratic fit to Kohout & Meylan'08 in Horvat & Tziperman'15 - HICE=ICECOEF1 ! For this method, ICECOEF1=ice thickness + HICE=MAX(0.0,ICECOEF1) ! For this method, ICECOEF1=ice thickness, which cannot be less than zero KARG1 = -0.3203 + 2.058*HICE - 0.9375*(TPI/SIG) KARG2 = -0.4269*HICE**2 + 0.1566*HICE*(TPI/SIG) KARG3 = 0.0006 * (TPI/SIG)**2 @@ -653,7 +655,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) CASE (7) ! Doble et al. (GRL 2015) - HICE=ICECOEF1 ! For this method, ICECOEF1=ice thickness + HICE=MAX(0.0,ICECOEF1) ! For this method, ICECOEF1=ice thickness, which cannot be less than zero DO IK=1,NK ALPHA(IK) = 0.2*(FREQ(IK)**2.13)*HICE END DO @@ -675,7 +677,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ENDIF ! Rename variable, for clarity - hice=ICECOEF1 ! For this method, ICECOEF1 is ice thickness + hice=MAX(0.0,ICECOEF1) ! For this method, ICECOEF1 is ice thickness, which cannot be less than zero DO IK=1,NK WN_I(IK) = Chf*hice*(FREQ(IK)**3) @@ -699,7 +701,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ENDIF ! Rename variable, for clarity - hice=ICECOEF1 ! For this method, ICECOEF1 is ice thickness + hice=MAX(0.0,ICECOEF1) ! For this method, ICECOEF1 is ice thickness, which cannot be less than zero ! Compute mpow=0.5*npow-1.0 ! Denoted "m" in documentation DO IK=1,NK From 3788ad40f5a5e3b8c4657350f3546caf5c0f70b9 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Thu, 4 Sep 2025 08:59:58 -0400 Subject: [PATCH 097/136] Update CMAKE so that OASIS requires MPI (#1490) --- model/src/cmake/switches.json | 7 ++++++- regtests/bin/run_cmake_test | 6 ++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/model/src/cmake/switches.json b/model/src/cmake/switches.json index 5431947d41..922c17f51d 100644 --- a/model/src/cmake/switches.json +++ b/model/src/cmake/switches.json @@ -697,6 +697,7 @@ "valid-options": [ { "name": "OASACM", + "requires": ["OASIS"], "build_files": ["w3agcmmd.F90"] } ] @@ -708,6 +709,7 @@ "valid-options": [ { "name": "OASOCM", + "requires": ["OASIS"], "build_files": ["w3ogcmmd.F90"] } ] @@ -719,6 +721,7 @@ "valid-options": [ { "name": "OASICM", + "requires": ["OASIS"], "build_files": ["w3igcmmd.F90"] } ] @@ -729,7 +732,8 @@ "description": "use of the coupler", "valid-options": [ { - "name": "COU" + "name": "COU", + "requires": ["MPI"] } ] }, @@ -740,6 +744,7 @@ "valid-options": [ { "name": "OASIS", + "requires": ["MPI"], "build_files": ["w3oacpmd.F90"], "conflicts": ["FLX1", "FLX2", "FLX3", "FLX4"] diff --git a/regtests/bin/run_cmake_test b/regtests/bin/run_cmake_test index e5e90c0cd6..8a5f3b2690 100755 --- a/regtests/bin/run_cmake_test +++ b/regtests/bin/run_cmake_test @@ -426,6 +426,9 @@ then sed 's/OMPG //' | sed 's/NOGRB/NCEP2/' | \ sed 's/OMPH //' | sed 's/PDLIB //' | \ sed 's/B4B //' | sed 's/METIS //' | \ + sed 's/OASIS //' | sed 's/OASACM //' | \ + sed 's/OASOCM //' | sed 's/OASICM //' | \ + sed 's/COU //' | \ sed 's/SCOTCH //' > $path_build/switch else cat $file_c | sed 's/SCRIPMPI //'| \ @@ -433,6 +436,9 @@ then sed 's/OMPG //' | \ sed 's/OMPH //' | sed 's/PDLIB //' | \ sed 's/B4B //' | sed 's/METIS //' | \ + sed 's/OASIS //' | sed 's/OASACM //' | \ + sed 's/OASOCM //' | sed 's/OASICM //' | \ + sed 's/COU //' | \ sed 's/SCOTCH //' > $path_build/switch fi From 814c1a424fdd24d3c6183ad4b594ef7167ec040a Mon Sep 17 00:00:00 2001 From: Juan Manuel Castillo Sanchez <48921434+ukmo-juan-castillo@users.noreply.github.com> Date: Thu, 4 Sep 2025 14:03:53 +0100 Subject: [PATCH 098/136] Correct the OASIS SMC grid by shifting one grid cell to the south-west (#1465) --- model/bin/ww3_from_ftp.sh | 2 +- model/src/w3oacpmd.F90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/model/bin/ww3_from_ftp.sh b/model/bin/ww3_from_ftp.sh index 4ab231e542..ca404deefe 100755 --- a/model/bin/ww3_from_ftp.sh +++ b/model/bin/ww3_from_ftp.sh @@ -20,7 +20,7 @@ usage() curr_dir=`pwd` # Set WW3 code version -ww3ver=v7.14.1 +ww3ver=v7.14.2 interactive='n' keep='n' diff --git a/model/src/w3oacpmd.F90 b/model/src/w3oacpmd.F90 index 19f1421f16..e5f3dde148 100644 --- a/model/src/w3oacpmd.F90 +++ b/model/src/w3oacpmd.F90 @@ -300,9 +300,9 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) ALLOCATE ( AREA(NNODES,1), CORLON(NNODES,1,4), CORLAT(NNODES,1,4) ) ALLOCATE ( MASK(NNODES,1) ) DO I=1, NNODES - ! lat/lon - LON(I,1) = X0 + (IJKCel(1,I) + IJKCel(3,I)*0.5)*DLON - LAT(I,1) = Y0 + (IJKCel(2,I) + IJKCel(4,I)*0.5)*DLAT + ! lat/lon (see e.g. ww3_ounf) + LON(I,1) = X0 + (IJKCel(1,I) + IJKCel(3,I)*0.5 - 1.0)*DLON + LAT(I,1) = Y0 + (IJKCel(2,I) + IJKCel(4,I)*0.5 - 1.0)*DLAT ! corners CORLON(I,1,1) = X0 + IJKCel(1,I)*DLON CORLON(I,1,2) = X0 + (IJKCel(1,I) + IJKCel(3,I))*DLON From 9d9e3d0148a400aac71947924d5f1fffa88c76a0 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Fri, 5 Sep 2025 09:09:44 -0400 Subject: [PATCH 099/136] Remove esmf directory (#1491) --- model/esmf/Makefile | 199 -------- model/esmf/README | 61 --- model/esmf/concomp.F90 | 493 ------------------- model/esmf/dum.F90 | 26 - model/esmf/esm.F90 | 1024 ---------------------------------------- model/esmf/esmApp.F90 | 98 ---- model/esmf/macros.h | 32 -- model/esmf/mdl.F90 | 911 ----------------------------------- model/esmf/switch | 40 -- model/esmf/utl.F90 | 173 ------- 10 files changed, 3057 deletions(-) delete mode 100644 model/esmf/Makefile delete mode 100644 model/esmf/README delete mode 100644 model/esmf/concomp.F90 delete mode 100644 model/esmf/dum.F90 delete mode 100644 model/esmf/esm.F90 delete mode 100644 model/esmf/esmApp.F90 delete mode 100644 model/esmf/macros.h delete mode 100644 model/esmf/mdl.F90 delete mode 100644 model/esmf/switch delete mode 100644 model/esmf/utl.F90 diff --git a/model/esmf/Makefile b/model/esmf/Makefile deleted file mode 100644 index d09482bc54..0000000000 --- a/model/esmf/Makefile +++ /dev/null @@ -1,199 +0,0 @@ -# GNU Makefile for WAVEWATCH III Implementation using NEMS at NCEP - -################################################################################ - -WW3_DIR := $(shell cd .. 1>/dev/null 2>&1 && pwd) -WW3_BASEDIR := $(shell cd ../.. 1>/dev/null 2>&1 && pwd) -WW3_BINDIR := $(WW3_DIR)/bin -WW3_TMPDIR := $(WW3_DIR)/tmp -WW3_EXEDIR := $(WW3_DIR)/exe -WW3_COMP ?= gnu -WW3_F90 := gfortran -SWITCHES := $(shell cat switch) - -WWATCH3_ENV := $(WW3_BINDIR)/wwatch3.env -NETCDF_CONFIG := $(shell which nc-config) -export WWATCH3_ENV NETCDF_CONFIG - -EXE := $(WW3_EXEDIR)/ww3_multi_esmf - -################################################################################ - -ifneq ($(origin ESMFMKFILE), environment) -$(error Environment variable ESMFMKFILE was not set.) -endif - -include $(ESMFMKFILE) - -################################################################################ - -# pgi -ifeq ($(WW3_COMP),Portland) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -byteswapio -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","pgi" "datarmor_pgi" "datarmor_pgi_debug")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -byteswapio -# intel -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","Intel" "hera.intel" "orion.intel" "jet.intel" "s4.intel")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -convert big_endian -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)", "cheyenne.intel" "stampede.intel" "expanse.intel")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -convert big_endian -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","wcoss_cray" "wcoss_dell_p3" "gaea.intel")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -convert big_endian -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","wcoss2")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -convert big_endian - WW3_CC=cc - WW3_F90=ftn -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","intel" "datarmor_intel" "datarmor_intel_debug")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -convert big_endian -# mpt -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","mpt" "datarmor_mpt" "datarmor_mpt_debug")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -convert big_endian -# gnu -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","gnu" "datarmor_gnu" "datarmor_gnu_debug")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -fconvert=big-endian -else ifeq ("$(WW3_COMP)",$(filter "$(WW3_COMP)","hera.gnu" "cheyenne.gnu")) - ESMF_F90COMPILEOPTS := $(ESMF_F90COMPILEOPTS) -fconvert=big-endian -# error -else - $(error Unsupported WW3_COMP: $(WW3_COMP)) -endif - -################################################################################ - -DEP_FRONTS := -DFRONT_ESM=ESM -DEP_FRONTS += -DFRONT_ATM=MDL -DEP_FRONTS += -DFRONT_OCN=MDL -DEP_FRONTS += -DFRONT_ICE=MDL -DEP_CMPL_OBJS := utl.o concomp.o mdl.o dum.o -DEP_LINK_OBJS := esm.o utl.o concomp.o mdl.o dum.o - -ifeq ($(MAKECMDGOALS),ww3_multi_esmf) -include $(WW3_DIR)/nuopc.mk -DEP_FRONTS += -DFRONT_WAV=$(ESMF_DEP_FRONT) -DEP_INCS += $(addprefix -I, $(ESMF_DEP_INCPATH)) -DEP_CMPL_OBJS += $(ESMF_DEP_CMPL_OBJS) -DEP_LINK_OBJS += $(ESMF_DEP_LINK_OBJS) -endif - -################################################################################ -################################################################################ - -.SUFFIXES: .F90 - -%.o : %.F90 - $(ESMF_F90COMPILER) -c $(DEP_FRONTS) $(DEP_INCS) \ - $(ESMF_F90COMPILEOPTS) $(ESMF_F90COMPILEPATHS) \ - $(ESMF_F90COMPILEFREECPP) $(ESMF_F90COMPILECPPFLAGS) $< - - -# ----------------------------------------------------------------------------- -# ------------------------------------------------------------------------------ -default: env setup gout switch - $(WW3_BINDIR)/w3_make ww3_multi_esmf - $(MAKE) ww3_multi_esmf - -ww3_nems: env setup gout switch - $(WW3_BINDIR)/w3_make ww3_multi_esmf - $(WW3_BINDIR)/w3_make ww3_multi - \cp -f $(WW3_EXEDIR)/ww3_multi $(WW3_BASEDIR)/exec - -ww3_nemslibonly: env setup switch - $(WW3_BINDIR)/w3_make ww3_multi_esmf - -ww3_multi_esmf: esmApp.o $(DEP_LINK_OBJS) - $(ESMF_F90LINKER) $(ESMF_F90LINKOPTS) -o $(EXE) $^ \ - $(ESMF_F90LINKPATHS) $(ESMF_F90LINKRPATHS) $(ESMF_F90ESMFLINKLIBS) - -# module dependencies: -esmApp.o: macros.h utl.o esm.o -esm.o: macros.h $(DEP_CMPL_OBJS) -utl.o: macros.h -concomp.o: macros.h utl.o -mdl.o: macros.h utl.o -dum.o: macros.h - -# ----------------------------------------------------------------------------- -# ----------------------------------------------------------------------------- -.PHONY: env setup switch dust clean -dust: - \rm -f PET*.ESMF_LogFile -clean: - \rm -f $(EXE) *.o *.mod -distclean: env clean - $(WW3_BINDIR)/w3_clean -c - \rm -fr $(WW3_TMPDIR) - \rm -f $(WWATCH3_ENV) - - -# ------------------------------------------------------------------------------ -# Setup wwatch3.env file for WW3 build or clean -# ------------------------------------------------------------------------------ -env: - @rm -f $(WWATCH3_ENV) - @touch $(WWATCH3_ENV) - @echo '#' >> $(WWATCH3_ENV) - @echo '# ---------------------------------------' >> $(WWATCH3_ENV) - @echo '# Environment variables for wavewatch III' >> $(WWATCH3_ENV) - @echo '# ---------------------------------------' >> $(WWATCH3_ENV) - @echo '#' >> $(WWATCH3_ENV) - @echo 'WWATCH3_F90 $(WW3_F90)' >> $(WWATCH3_ENV) - @echo 'WWATCH3_DIR $(WW3_DIR)' >> $(WWATCH3_ENV) - @echo 'WWATCH3_TMP $(WW3_TMPDIR)' >> $(WWATCH3_ENV) - @echo 'WWATCH3_SOURCE yes' >> $(WWATCH3_ENV) - @echo 'WWATCH3_LIST yes' >> $(WWATCH3_ENV) - @echo '' >> $(WWATCH3_ENV) -# ------------------------------------------------------------------------------ - - -# ------------------------------------------------------------------------------ -# Setup comp & link files and auxiliary programs (this is done using w3_setup) -# ------------------------------------------------------------------------------ -setup: env - @$(WW3_BINDIR)/w3_setup -q -c $(WW3_COMP) $(WW3_DIR) -# ------------------------------------------------------------------------------ - - -# ------------------------------------------------------------------------------ -# Setup switch file -# ------------------------------------------------------------------------------ -switch: - @echo "$(SWITCHES)" > $(WW3_BINDIR)/switch -# ------------------------------------------------------------------------------ - -# ------------------------------------------------------------------------------ -# Setup switch file and compile serial routines ww3_grid, ww3_outf and ww3_outp -# ------------------------------------------------------------------------------ -gout: - @echo "$(SWITCHES)" > $(WW3_BINDIR)/tempswitch - @sed -e "s/DIST/SHRD/g"\ - -e "s/OMPG/ /g"\ - -e "s/OMPH/ /g"\ - -e "s/MPIT/ /g"\ - -e "s/MPI/ /g"\ - -e "s/PDLIB/ /g"\ - $(WW3_BINDIR)/tempswitch > $(WW3_BINDIR)/switch - \rm -f $(WW3_BINDIR)/tempswitch - $(WW3_BINDIR)/w3_make ww3_grid - $(WW3_BINDIR)/w3_make ww3_outf - $(WW3_BINDIR)/w3_make ww3_outp - $(WW3_BINDIR)/w3_make ww3_prep - $(WW3_BINDIR)/w3_make ww3_gint - $(WW3_BINDIR)/w3_make ww3_prnc - $(WW3_BINDIR)/w3_make ww3_ounf - $(WW3_BINDIR)/w3_make ww3_ounp - @echo "$(SWITCHES)" > $(WW3_BINDIR)/tempswitch - @sed -e "s/DIST/SHRD/g"\ - -e "s/OMPG/ /g"\ - -e "s/OMPH/ /g"\ - -e "s/MPIT/ /g"\ - -e "s/MPI/ /g"\ - -e "s/PDLIB/ /g"\ - -e "s/NOGRB/NCEP2 NCO/g"\ - $(WW3_BINDIR)/tempswitch > $(WW3_BINDIR)/switch - \rm -f $(WW3_BINDIR)/tempswitch - $(WW3_BINDIR)/w3_make ww3_grib - \rm -rf $(WW3_BASEDIR)/exec - \mkdir -p $(WW3_BASEDIR)/exec - \cp -f $(WW3_EXEDIR)/ww3_* $(WW3_BASEDIR)/exec - -# ------------------------------------------------------------------------------ diff --git a/model/esmf/README b/model/esmf/README deleted file mode 100644 index 4102026a5e..0000000000 --- a/model/esmf/README +++ /dev/null @@ -1,61 +0,0 @@ -& ESMF/NUOPC Documentation - -ESMF Fortran Reference Documentation: -http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_1/ESMF_refdoc/ - -NUOPC Layer Reference: -http://www.earthsystemmodeling.org/esmf_releases/non_public/ESMF_7_0_1/NUOPC_refdoc/ - -NUOPC Layer Documents: -https://earthsystemcog.org/projects/nuopc/ - - - - -& Test coupled application - -esmApp.F90: coupled application main program -esm.F90: coupled application driver component -concomp.F90: coupled application connector component -mdl.F90: coupled application model components (ATM, OCN, or ICE) -dum.F90: dummy model component -utl.F90: utilities module -Makefile: the - -The WAV model component is Wavewatch (wmesmfmd.ftn). - -The ATM, OCN, and ICE components read in and export forcing fields required -by the WAV model. The connector components (ATM->WAV, OCN->WAV, ICE->WAV) -defined in concomp.F90 setup and execute the required data transforms (regrid or -redist). The driver component (esm.F90) creates the model components and -connector components and sets up the run sequence. - -Set ESMFMKFILE environment variable to point to the "esmf.mk" Makefile fragment. - -The default target will create a wwatch3.env environment file and switch file -in the bin directory and then compile ww3_multi_esmf. - -The ww3_multi_esmf target is used by regtest/bin/run_test when invoked with the -'-z' option. - - - - -& Compiling WW3 ESMF component - -bin/w3_make ww3_multi_esmf does not create an executable, rather it compiles the -ww3 esmf module (wmesmfmd), creates an object archive (libww3_esmf_multi.a) and -the ESMF/NUOPC makefile fragment (nuopc.mk) - -ESMFMKFILE is required to get the ESMF compile options. Specifically, -ESMF_F90COMPILEPATHS is used in comp to set the include paths required for the -ESMF modules. - -The ESMF build requires DIST switch. - - - - -& The WW3 ESMF component (wmesmfmd.ftn) - -Source code uses "Camel Case" convention. diff --git a/model/esmf/concomp.F90 b/model/esmf/concomp.F90 deleted file mode 100644 index 9ee7d61e1d..0000000000 --- a/model/esmf/concomp.F90 +++ /dev/null @@ -1,493 +0,0 @@ -#include "macros.h" -!------------------------------------------------------------------------------- -! A test coupled application connector component -! -! Author: -! Tim Campbell -! Naval Research Laboratory -! November 2014 -!------------------------------------------------------------------------------- - -module CON - - use ESMF - use NUOPC -! use NUOPC_Connector, parent_SetServices => SetServices - use NUOPC_Connector, only: parent_SetServices => SetServices, & - label_ComputeRouteHandle, label_ExecuteRouteHandle, & - label_ReleaseRouteHandle, label_Finalize, & - NUOPC_ConnectorGet, NUOPC_ConnectorSet - use UTL - - implicit none - - private - - public SetServices - - character (*), parameter :: label_InternalState = 'InternalState' - - type type_InternalStateStruct - logical :: verbose - type(ESMF_VM) :: vm - integer :: cplCount - character(ESMF_MAXSTR) ,pointer :: srcNames(:) => null() - character(ESMF_MAXSTR) ,pointer :: dstNames(:) => null() - type(ESMF_RouteHandle) :: remapRH - integer(ESMF_KIND_I4) :: numwt - character(ESMF_MAXSTR) ,pointer :: wtnam(:) => null() - integer(ESMF_KIND_I4) ,pointer :: wtcnt(:) => null() - real(ESMF_KIND_R8) ,pointer :: wtime(:) => null() - end type - - type type_InternalState - type(type_InternalStateStruct), pointer :: wrap - end type - - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine SetServices(ccomp, rc) - type(ESMF_CplComp) :: ccomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - type(type_InternalState) :: is - integer :: lrc, stat - integer :: i - - rc = ESMF_SUCCESS - - ! query the Component for its name - call ESMF_CplCompGet(ccomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! allocate memory for this internal state and set it in the component - allocate(is%wrap, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of internal state memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - call ESMF_UserCompSetInternalState(ccomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! initialize timers - is%wrap%numwt = 5 - allocate(is%wrap%wtnam(is%wrap%numwt), is%wrap%wtcnt(is%wrap%numwt), & - is%wrap%wtime(is%wrap%numwt), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of wall timer memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - is%wrap%wtnam(1) = 'InitializeP0' - is%wrap%wtnam(2) = 'ComputeRH' - is%wrap%wtnam(3) = 'ExecuteRH' - is%wrap%wtnam(4) = 'ReleaseRH' - is%wrap%wtnam(5) = 'Finalize' - is%wrap%wtcnt(:) = 0 - is%wrap%wtime(:) = 0d0 - - ! the NUOPC connector component will register the generic methods - call NUOPC_CompDerive(ccomp, parent_SetServices, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set initialize phase 0 requires use of ESMF method - call ESMF_CplCompSetEntryPoint(ccomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! attach specializing method(s) - call NUOPC_CompSpecialize(ccomp, specLabel=label_ComputeRouteHandle, & - specRoutine=ComputeRH, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(ccomp, specLabel=label_ExecuteRouteHandle, & - specRoutine=ExecuteRH, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(ccomp, specLabel=label_ReleaseRouteHandle, & - specRoutine=ReleaseRH, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(ccomp, specLabel=label_Finalize, & - specRoutine=Finalize, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine InitializeP0(ccomp, importState, exportState, clock, rc) - type(ESMF_CplComp) :: ccomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - character(ESMF_MAXSTR) :: verbosity - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=1, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - integer :: i - character(ESMF_MAXSTR) :: attrString - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_CplCompGet(ccomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(ccomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! determine verbosity - call NUOPC_CompAttributeGet(ccomp, name='Verbosity', value=verbosity, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (trim(verbosity)=='high') then - is%wrap%verbose = .true. - else - is%wrap%verbose = .false. - endif - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered InitializeP0', ESMF_LOGMSG_INFO) - - ! query Component for its vm - call ESMF_CplCompGet(ccomp, vm=is%wrap%vm, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(ccomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! finish timing -1 call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving InitializeP0', ESMF_LOGMSG_INFO) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine ComputeRH(ccomp, rc) - type(ESMF_CplComp) :: ccomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=2, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - integer :: i - character(ESMF_MAXSTR), pointer :: cplList(:) - integer :: srcCount, dstCount - type(ESMF_FieldBundle) :: srcFields, dstFields - type(ESMF_Config) :: config - character(ESMF_MAXSTR) :: label - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_CplCompGet(ccomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(ccomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered ComputeRH', ESMF_LOGMSG_INFO) - - ! query Component for its config - call ESMF_CplCompGet(ccomp, config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get size of couple list - call NUOPC_CompAttributeGet(ccomp, name='CplList', itemCount=is%wrap%cplCount, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - write(msgString,'(a,i0,a)') trim(cname)// & - ': List of coupled fields (',is%wrap%cplCount,'):' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - - ! if no coupled fields, then return - if (is%wrap%cplCount.eq.0) goto 1 - - ! get field bundles from connecter internal state - call NUOPC_ConnectorGet(ccomp, srcFields=srcFields, dstFields=dstFields, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! report the cplList and FieldBundle lists - call ESMF_FieldBundleGet(srcFields, fieldCount=srcCount, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_FieldBundleGet(dstFields, fieldCount=dstCount, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (is%wrap%cplCount.ne.srcCount .or. is%wrap%cplCount.ne.dstCount) then - write(msgString,'(a)') trim(cname)// & - ': cplList count does not agree with FieldBundle counts' - call ESMF_LogSetError(ESMF_FAILURE, msg=trim(msgString), rcToReturn=rc) - return ! bail out - endif - write(msgString,'(a,a5,a,a10,a,a10,a3,a)') & - trim(cname)//': ','index',' ','srcField',' ','dstField',' ','standardName' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - allocate(is%wrap%srcNames(is%wrap%cplCount), is%wrap%dstNames(is%wrap%cplCount), & - cplList(is%wrap%cplCount), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of cplList() failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - call NUOPC_CompAttributeGet(ccomp, name='CplList', valueList=cplList, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_FieldBundleGet(srcFields, fieldNameList=is%wrap%srcNames, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_FieldBundleGet(dstFields, fieldNameList=is%wrap%dstNames, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - do i=1, is%wrap%cplCount - write(msgString,'(a,i5,a,a10,a,a10,a3,a)') & - trim(cname)//': ',i,' ',trim(is%wrap%srcNames(i)),' ', & - trim(is%wrap%dstNames(i)),' ',trim(cplList(i)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - deallocate(cplList, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of cplList() failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - - ! store remap - call ESMF_FieldBundleRedistStore(srcFields, dstFields, is%wrap%remapRH, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! finish timing -1 call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving ComputeRH', ESMF_LOGMSG_INFO) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine ExecuteRH(ccomp, rc) - type(ESMF_CplComp) :: ccomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=3, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - type(ESMF_FieldBundle) :: srcFields, dstFields - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_CplCompGet(ccomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(ccomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - ! if no coupled fields, then return - if (is%wrap%cplCount.eq.0) return - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered ExecuteRH', ESMF_LOGMSG_INFO) - - ! get field bundles from connecter internal state - call NUOPC_ConnectorGet(ccomp, srcFields=srcFields, dstFields=dstFields, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! apply remap - call ESMF_FieldBundleRedist(srcFields, dstFields, is%wrap%remapRH, checkFlag=.false., rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! finish timing -1 call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving ExecuteRH', ESMF_LOGMSG_INFO) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine ReleaseRH(ccomp, rc) - type(ESMF_CplComp) :: ccomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=4, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_CplCompGet(ccomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(ccomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - ! if no coupled fields, then return - if (is%wrap%cplCount.eq.0) return - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered ReleaseRH', ESMF_LOGMSG_INFO) - - ! release remap - call ESMF_FieldBundleRedistRelease(is%wrap%remapRH, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! deallocate field name arrays - if (associated(is%wrap%srcNames)) then - deallocate(is%wrap%srcNames, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of srcNames array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - if (associated(is%wrap%dstNames)) then - deallocate(is%wrap%dstNames, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of dstNames array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - - ! finish timing -1 call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving ReleaseRH', ESMF_LOGMSG_INFO) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine Finalize(ccomp, rc) - type(ESMF_CplComp) :: ccomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=5, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_CplCompGet(ccomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(ccomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered Finalize', ESMF_LOGMSG_INFO) - - ! finish timing -1 call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - ! print timing - call PrintTimers(trim(cname), is%wrap%wtnam, is%wrap%wtcnt, is%wrap%wtime) - - ! deallocate timers - if (associated(is%wrap%wtnam)) then - deallocate(is%wrap%wtnam, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of wtnam array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - if (associated(is%wrap%wtcnt)) then - deallocate(is%wrap%wtcnt, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of wtcnt array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - if (associated(is%wrap%wtime)) then - deallocate(is%wrap%wtime, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of wtime array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - - ! deallocate internal state memory - if (associated(is%wrap)) then - deallocate(is%wrap, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of internal state memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving Finalize', ESMF_LOGMSG_INFO) - - end subroutine - -end module diff --git a/model/esmf/dum.F90 b/model/esmf/dum.F90 deleted file mode 100644 index af6d97326c..0000000000 --- a/model/esmf/dum.F90 +++ /dev/null @@ -1,26 +0,0 @@ -#include "macros.h" -!------------------------------------------------------------------------------- -! A test coupled application dummy model component -! -! Author: -! Tim Campbell -! Naval Research Laboratory -! November 2014 -!------------------------------------------------------------------------------- - -module DUM - use ESMF - implicit none - private - public SetServices - contains - subroutine SetServices(comp, rc) - type(ESMF_GridComp) :: comp - integer, intent(out) :: rc - character(ESMF_MAXSTR) :: cname, msg - call ESMF_GridCompGet(comp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - msg=trim(cname)//': dummy component should never be invoked' - call ESMF_LogSetError(ESMF_FAILURE, msg=trim(msg), rcToReturn=rc) - end subroutine -end module diff --git a/model/esmf/esm.F90 b/model/esmf/esm.F90 deleted file mode 100644 index 3537eafa0d..0000000000 --- a/model/esmf/esm.F90 +++ /dev/null @@ -1,1024 +0,0 @@ -#include "macros.h" -#define FRONT_CON CON -#define FRONT_DUM DUM -!------------------------------------------------------------------------------- -! A test coupled application driver component -! -! Author: -! Tim Campbell -! Naval Research Laboratory -! November 2014 -!------------------------------------------------------------------------------- - -module FRONT_ESM - - use ESMF - use NUOPC - use NUOPC_Driver, parent_SetServices => SetServices - use UTL - - use FRONT_CON, only: cplSS => SetServices -#ifdef FRONT_MED - use FRONT_MED, only: medSS => SetServices -#else - use FRONT_DUM, only: medSS => SetServices -#endif -#ifdef FRONT_ATM - use FRONT_ATM, only: atmSS => SetServices -#else - use FRONT_DUM, only: atmSS => SetServices -#endif -#ifdef FRONT_OCN - use FRONT_OCN, only: ocnSS => SetServices -#else - use FRONT_DUM, only: ocnSS => SetServices -#endif -#ifdef FRONT_WAV - use FRONT_WAV, only: wavSS => SetServices -#else - use FRONT_DUM, only: wavSS => SetServices -#endif -#ifdef FRONT_ICE - use FRONT_ICE, only: iceSS => SetServices -#else - use FRONT_DUM, only: iceSS => SetServices -#endif -#ifdef FRONT_LND - use FRONT_LND, only: lndSS => SetServices -#else - use FRONT_DUM, only: lndSS => SetServices -#endif - - implicit none - save - private - - public SetServices - - integer , parameter :: maxModCount = 6 - logical , parameter :: defaultVerbose = .false. - logical , parameter :: defaultModActive = .false. - character(*), parameter :: label_InternalState = 'InternalState' - - type type_PL - integer, pointer :: p(:) - end type - - type type_InternalStateStruct - logical :: verbose - integer :: modCount=0 - integer :: med=0, atm=0, ocn=0, wav=0, ice=0, lnd=0 - character(3) :: modName(0:maxModCount) - logical :: modActive(0:maxModCount) - type(type_PL):: modPetList(0:maxModCount) - character(10):: conName(0:maxModCount,0:maxModCount) - logical :: conActive(0:maxModCount,0:maxModCount) - end type - - type type_InternalState - type(type_InternalStateStruct), pointer :: wrap - end type - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine SetServices(driver, rc) - type(ESMF_GridComp) :: driver - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - type(ESMF_Config) :: config - type(type_InternalState) :: is - logical ,pointer :: verbose - integer ,pointer :: modCount - integer ,pointer :: med, atm, ocn, wav, ice, lnd - character(3) ,pointer :: modName(:) - logical ,pointer :: modActive(:) - type(type_PL),pointer :: modPetList(:) - character(10),pointer :: conName(:,:) - logical ,pointer :: conActive(:,:) - character(ESMF_MAXSTR) :: msgString - integer :: lrc, stat - logical :: configIsPresent - integer :: i, j, k - - rc = ESMF_SUCCESS - - ! query the component for its name - call ESMF_GridCompGet(driver, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! config is required - call ESMF_GridCompGet(driver, configIsPresent=configIsPresent, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (.not.configIsPresent) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': missing required config') - return ! bail out - endif - - ! allocate memory for this internal state and set it in the component - allocate(is%wrap, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of internal state memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - call ESMF_UserCompSetInternalState(driver, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set local pointers for internal state members - verbose => is%wrap%verbose - modCount => is%wrap%modCount - med => is%wrap%med - atm => is%wrap%atm - ocn => is%wrap%ocn - wav => is%wrap%wav - ice => is%wrap%ice - lnd => is%wrap%lnd - modName => is%wrap%modName - modActive => is%wrap%modActive - modPetList => is%wrap%modPetList - conName => is%wrap%conName - conActive => is%wrap%conActive - - ! initialize - modCount = 0 - med = 0 - atm = 0 - ocn = 0 - wav = 0 - ice = 0 - lnd = 0 - modActive = .false. - conActive = .false. - - ! *** report compiled modules, set model count, model index mapping, and model names *** - - ! CON component -#ifdef FRONT_CON - call ESMF_LogWrite(trim(cname)//': compiled with CON module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without CON module', ESMF_LOGMSG_INFO) -#endif - - ! MED component -#ifdef FRONT_MED - modCount = modCount + 1 - med = modCount - modName(med) = 'MED' - call ESMF_LogWrite(trim(cname)//': compiled with MED module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without MED module', ESMF_LOGMSG_INFO) -#endif - - ! ATM component -#ifdef FRONT_ATM - modCount = modCount + 1 - atm = modCount - modName(atm) = 'ATM' - call ESMF_LogWrite(trim(cname)//': compiled with ATM module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without ATM module', ESMF_LOGMSG_INFO) -#endif - - ! OCN component -#ifdef FRONT_OCN - modCount = modCount + 1 - ocn = modCount - modName(ocn) = 'OCN' - call ESMF_LogWrite(trim(cname)//': compiled with OCN module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without OCN module', ESMF_LOGMSG_INFO) -#endif - - ! WAV component -#ifdef FRONT_WAV - modCount = modCount + 1 - wav = modCount - modName(wav) = 'WAV' - call ESMF_LogWrite(trim(cname)//': compiled with WAV module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without WAV module', ESMF_LOGMSG_INFO) -#endif - - ! ICE component -#ifdef FRONT_ICE - modCount = modCount + 1 - ice = modCount - modName(ice) = 'ICE' - call ESMF_LogWrite(trim(cname)//': compiled with ICE module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without ICE module', ESMF_LOGMSG_INFO) -#endif - - ! LND component -#ifdef FRONT_LND - modCount = modCount + 1 - lnd = modCount - modName(lnd) = 'LND' - call ESMF_LogWrite(trim(cname)//': compiled with LND module', ESMF_LOGMSG_INFO) -#else - call ESMF_LogWrite(trim(cname)//': compiled without LND module', ESMF_LOGMSG_INFO) -#endif - - ! report model indexing - do i = 1,modCount - write(msgString,'(a,i0)') trim(cname)//': '//modName(i)//' model index: ',i - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - ! NUOPC_Driver registers the generic methods - call NUOPC_CompDerive(driver, parent_SetServices, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! attach specializing method(s) - call NUOPC_CompSpecialize(driver, specLabel=label_SetModelServices, & - specRoutine=SetModelServices, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(driver, specLabel=label_SetRunSequence, & - specRoutine=SetRunSequence, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(driver, specLabel=label_Finalize, & - specRoutine=Finalize, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine SetModelServices(driver, rc) - type(ESMF_GridComp) :: driver - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - type(ESMF_Config) :: config - type(type_InternalState) :: is - logical ,pointer :: verbose - integer ,pointer :: modCount - integer ,pointer :: med, atm, ocn, wav, ice, lnd - character(3) ,pointer :: modName(:) - logical ,pointer :: modActive(:) - type(type_PL),pointer :: modPetList(:) - character(10),pointer :: conName(:,:) - logical ,pointer :: conActive(:,:) - character(ESMF_MAXSTR) :: msgString - integer :: lrc, stat - integer :: i, j, k - character(ESMF_MAXSTR) :: verbosity - character(ESMF_MAXSTR) :: label - type(ESMF_GridComp) :: modComp(maxModCount) - type(ESMF_CplComp) :: conComp(maxModCount,maxModCount) - integer(ESMF_KIND_I4) :: time(6) - type(ESMF_Time) :: startTime - type(ESMF_Time) :: stopTime - type(ESMF_TimeInterval) :: runDuration - type(ESMF_TimeInterval) :: timeStep - type(ESMF_TimeInterval) :: zeroTimeInterval - type(ESMF_Clock) :: internalClock - - rc = ESMF_SUCCESS - - ! query the component for its name - call ESMF_GridCompGet(driver, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query the component for its config - call ESMF_GridCompGet(driver, config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query component for internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(driver, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set local pointers for internal state members - verbose => is%wrap%verbose - modCount => is%wrap%modCount - med => is%wrap%med - atm => is%wrap%atm - ocn => is%wrap%ocn - wav => is%wrap%wav - ice => is%wrap%ice - lnd => is%wrap%lnd - modName => is%wrap%modName - modActive => is%wrap%modActive - modPetList => is%wrap%modPetList - conName => is%wrap%conName - conActive => is%wrap%conActive - - ! process config for verbose - label = 'verbose:' - call ESMF_ConfigGetAttribute(config, verbose, default=defaultVerbose, & - label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (verbose) then - verbosity = 'high' - else - verbosity = 'low' - endif - - ! process config for modActive - do i = 1,modCount - label = modName(i)//'_active:' - call ESMF_ConfigGetAttribute(config, modActive(i), default=defaultModActive, & - label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogWrite(trim(cname)//': ESMF_ConfigGetAttribute: '// & - trim(label), ESMF_LOGMSG_ERROR) - return ! bail out - endif - ! report active/inactive models - if (modActive(i)) then - write(msgString,'(a)') trim(cname)//': '//modName(i)//' is active' - else - write(msgString,'(a)') trim(cname)//': '//modName(i)//' is not active' - endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - ! set connector names (use same as NUOPC) - do j = 1,modCount - do i = 1,modCount - conName(i,j) = modName(i)//'-TO-'//modName(j) - enddo - enddo - - ! set active connectors - if (modActive(med)) then - ! mediator is active - ! * active model to mediator connections - do i = med+1,modCount - conActive(i,med) = modActive(i) - enddo - ! * mediator to active model connections - do i = med+1,modCount - conActive(med,i) = modActive(i) - enddo - else - ! mediator is not active - ! * active model to active model connections - do j = med+1,modCount - do i = med+1,modCount - if (i.eq.j) cycle - conActive(i,j) = modActive(i).and.modActive(j) - conActive(j,i) = modActive(j).and.modActive(i) - enddo - enddo - endif - - ! report active connections - do j = 1,modCount - do i = 1,modCount - if (.not.conActive(i,j)) cycle - write(msgString,'(a)') trim(cname)//': '//conName(i,j)//' connector is active' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - enddo - - ! process config for pet lists - call SetModelPetLists(driver, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! SetServices for active models - ! The model setServices function reference must be compile-time valid - ! so that CPP macros are not required here. - do i = 1,modCount - if (.not.modActive(i)) cycle - select case (modName(i)) - case ('MED') - call NUOPC_DriverAddComp(driver, modName(i), medSS, & - petList=modPetList(i)%p, comp=modComp(i), rc=rc) - case ('ATM') - call NUOPC_DriverAddComp(driver, modName(i), atmSS, & - petList=modPetList(i)%p, comp=modComp(i), rc=rc) - case ('OCN') - call NUOPC_DriverAddComp(driver, modName(i), ocnSS, & - petList=modPetList(i)%p, comp=modComp(i), rc=rc) - case ('WAV') - call NUOPC_DriverAddComp(driver, modName(i), wavSS, & - petList=modPetList(i)%p, comp=modComp(i), rc=rc) - case ('ICE') - call NUOPC_DriverAddComp(driver, modName(i), iceSS, & - petList=modPetList(i)%p, comp=modComp(i), rc=rc) - case ('LND') - call NUOPC_DriverAddComp(driver, modName(i), lndSS, & - petList=modPetList(i)%p, comp=modComp(i), rc=rc) - endselect - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,1i2,a)') 'NUOPC_DriverAddComp: ',i,', '//modName(i) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - return ! bail out - endif - enddo - - ! set component attributes for active models - do i = 1,modCount - if (.not.modActive(i)) cycle - ! set config - call ESMF_GridCompSet(modComp(i), config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,1i2,a)') 'Set config: ',i,', '//modName(i) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - return ! bail out - endif - ! set verbosity - call NUOPC_CompAttributeSet(modComp(i), name='Verbosity', value=trim(verbosity), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,1i2,a)') 'NUOPC_CompAttributeSet: ',i,', '//modName(i) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - return ! bail out - endif - enddo - - ! SetServices for active connectors - do j = 1,modCount - do i = 1,modCount - if (.not.conActive(i,j)) cycle - call NUOPC_DriverAddComp(driver, modName(i), modName(j), cplSS, comp=conComp(i,j), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,2i2,a)') 'NUOPC_DriverAddComp: ',i,j,', '//conName(i,j) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - return ! bail out - endif - enddo - enddo - - ! set connector component attributes for active connectors - do j = 1,modCount - do i = 1,modCount - if (.not.conActive(i,j)) cycle - ! set config - call ESMF_CplCompSet(conComp(i,j), config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,2i2,a)') 'Set Config: ',i,j,', '//conName(i,j) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - return ! bail out - endif - ! set verbosity - call NUOPC_CompAttributeSet(conComp(i,j), name='Verbosity', value=trim(verbosity), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,2i2,a)') 'NUOPC_CompAttributeSet: ',i,j,', '//conName(i,j) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) - return ! bail out - endif - enddo - enddo - - ! process config for required timeStep input - label = 'time_step:' - call ESMF_ConfigGetAttribute(config, time(4:6), count=3, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': missing required config input: '// & - trim(label)//' hh mm ss') - return ! bail out - endif - write(msgString,'(a,3(a,i0))') trim(cname)//': '//trim(label),(' ',time(k),k=4,6) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - call ESMF_TimeIntervalSet(timeStep, h=time(4), m=time(5), s=time(6), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! process config for required startTime input - label = 'start_time:' - call ESMF_ConfigGetAttribute(config, time, count=6, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': missing required config input: '// & - trim(label)//' YYYY MM DD hh mm ss') - return ! bail out - endif - write(msgString,'(a,6(a,i0))') trim(cname)//': '//trim(label),(' ',time(k),k=1,6) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - call ESMF_TimeSet(startTime, yy=time(1), mm=time(2), dd=time(3), & - h=time(4), m=time(5), s=time(6), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! process config for required stopTime input - label = 'stop_time:' - call ESMF_ConfigGetAttribute(config, time, count=6, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': missing required config input: '// & - trim(label)//' YYYY MM DD hh mm ss') - return ! bail out - endif - write(msgString,'(a,6(a,i0))') trim(cname)//': '//trim(label),(' ',time(k),k=1,6) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - call ESMF_TimeSet(stopTime, yy=time(1), mm=time(2), dd=time(3), & - h=time(4), m=time(5), s=time(6), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! check that simulation time is multiple of timeStep - runDuration = stopTime - startTime - call ESMF_TimeIntervalSet(zeroTimeInterval, h=0, m=0, s=0, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (mod(runDuration,timeStep) .ne. zeroTimeInterval) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': run duration is not a multiple of timeStep') - return ! bail out - endif - - ! create/set the driver clock - internalClock = ESMF_ClockCreate(name=trim(cname)//'_clock', & - timeStep=timeStep, startTime=startTime, stopTime=stopTime, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_GridCompSet(driver, clock=internalClock, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine SetModelPetLists(driver, rc) - type(ESMF_GridComp) :: driver - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - type(ESMF_Config) :: config - type(type_InternalState) :: is - logical ,pointer :: verbose - integer ,pointer :: modCount - integer ,pointer :: med, atm, ocn, wav, ice, lnd - character(3) ,pointer :: modName(:) - logical ,pointer :: modActive(:) - type(type_PL),pointer :: modPetList(:) - character(10),pointer :: conName(:,:) - logical ,pointer :: conActive(:,:) - character(ESMF_MAXSTR) :: msgString - integer :: lrc, stat - integer :: i, j, k - integer :: l, m, n, p - integer :: k1, k2 - integer :: modStart - integer :: petCount, npet - integer :: modPetCount(maxModCount) - character(ESMF_MAXSTR) :: label - character(ESMF_MAXSTR) :: petLayoutOption - logical :: isPresent - integer , allocatable :: list(:), ncol(:) - - rc = ESMF_SUCCESS - - ! query the component for its name - call ESMF_GridCompGet(driver, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query the component for its config - call ESMF_GridCompGet(driver, config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query component for internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(driver, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set local pointers for internal state members - verbose => is%wrap%verbose - modCount => is%wrap%modCount - med => is%wrap%med - atm => is%wrap%atm - ocn => is%wrap%ocn - wav => is%wrap%wav - ice => is%wrap%ice - lnd => is%wrap%lnd - modName => is%wrap%modName - modActive => is%wrap%modActive - modPetList => is%wrap%modPetList - conName => is%wrap%conName - conActive => is%wrap%conActive - - ! get the petCount - call ESMF_GridCompGet(driver, petCount=petCount, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! process config for pet_layout_option: - label = 'pet_layout_option:' - call ESMF_ConfigGetAttribute(config, petLayoutOption, default='sequential', & - label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_LogWrite(trim(cname)//': '//trim(label)//' '//trim(petLayoutOption), & - ESMF_LOGMSG_INFO) - - ! set the model petLists based on petLayoutOption - select case (trim(petLayoutOption)) - - ! pet_layout_option: sequential - ! * active models defined on pet_count pets - ! * MED defined on pet_count pets - ! * requires pet_count input - case ('sequential') - label='pet_count:' - call ESMF_ConfigGetAttribute(config, npet, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)//' is required when pet_layout_option'// & - ' = sequential') - return ! bail out - endif - if (npet.lt.1.or.npet.gt.petCount) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)//' must be > 0 and <= # PETs') - return ! bail out - endif - do i = 1,modCount - if (.not.modActive(i)) cycle - allocate(modPetList(i)%p(npet), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of '//modName(i)//' PET list array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - do j = 1,npet - modPetList(i)%p(j) = j-1 - enddo - enddo - - ! pet_layout_option: concurrent - ! * active models defined on non-overlapping sets of PETs - ! * requires _pet_count input for active models - ! * MED_pet_count optional, default is MED defined on all PETs - ! * requires \sum(_pet_count) <= petCount - case ('concurrent') - modStart = 1 - if (modActive(med)) then - label=modName(med)//'_pet_count:' - call ESMF_ConfigFindLabel(config, label=trim(label), isPresent=isPresent, rc=rc) - if (.not.isPresent.or.rc.ne.ESMF_SUCCESS) then - modPetCount(med) = petCount - if (verbose) then - write(msgString,'(a,i0)') trim(cname)//': '// & - modName(med)//' PET count: ',modPetCount(med) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - allocate(modPetList(med)%p(petCount), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of '//modName(med)//' PET list array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - do j = 1,petCount - modPetList(med)%p(j) = j-1 - enddo - modStart = med+1 - endif - endif - npet = 0 - do i = modStart,modCount - if (.not.modActive(i)) cycle - label=modName(i)//'_pet_count:' - call ESMF_ConfigGetAttribute(config, modPetCount(i), label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)//' is required when pet_layout_option'// & - ' = concurrent and '//modName(i)//' is active') - return ! bail out - endif - if (modPetCount(i).lt.1.or.modPetCount(i).ge.petCount) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)//' must be > 0 and < # PETs') - return ! bail out - endif - npet = npet + modPetCount(i) - enddo - if (npet.gt.petCount) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': pet_layout_option = concurrent requires'// & - ' \sum(_pet_count) <= # PETs for active models') - return ! bail out - endif - npet = 0 - do i = modStart,modCount - if (.not.modActive(i)) cycle - allocate(modPetList(i)%p(modPetCount(i)), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of '//modName(i)//' PET list array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - do j = 1,modPetCount(i) - modPetList(i)%p(j) = npet - npet = npet + 1 - enddo - if (verbose) then - write(msgString,'(a,i0)') trim(cname)//': '// & - modName(i)//' PET count: ',modPetCount(i) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - n = 10 - m = ceiling(real(modPetCount(i))/real(n)) - write(msgString,'(a)') trim(cname)//': '//modName(i)//' PET list:' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - do l = 1,m - k1 = min((l-1)*n+1,modPetCount(i)) - k2 = min((l-1)*n+n,modPetCount(i)) - write(msgString,'(a,100i7)') trim(cname)//': ', (modPetList(i)%p(k),k=k1,k2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - endif - enddo - - ! pet_layout_option: specified - ! * active models defined on specified sets of PETs - ! * requires _pet_list input for active models - ! * MED_pet_list optional, default is MED defined on all PETs - ! * requires min(_pet_list) >= 0 && max(_pet_list) < petCount - case ('specified') - modStart = 1 - if (modActive(med)) then - label=modName(med)//'_pet_list::' - call ESMF_ConfigFindLabel(config, label=trim(label), isPresent=isPresent, rc=rc) - if (.not.isPresent.or.rc.ne.ESMF_SUCCESS) then - modPetCount(med) = petCount - if (verbose) then - write(msgString,'(a,i0)') trim(cname)//': '// & - modName(med)//' PET count: ',modPetCount(med) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - allocate(modPetList(med)%p(petCount), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of '//modName(med)//' PET list array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - do j = 1,petCount - modPetList(i)%p(j) = j-1 - enddo - modStart = med+1 - endif - endif - do i = modStart,modCount - if (.not.modActive(i)) cycle - label=modName(i)//'_pet_list::' - call ESMF_ConfigGetDim(config, m, n, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)//' is required when pet_layout_option'// & - ' = specified and '//modName(i)//' is active') - return ! bail out - endif - if (verbose) then - write(msgString,'(a,i0)') trim(cname)//': '// & - trim(label)//' table number of rows: ',m - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(a,i0)') trim(cname)//': '// & - trim(label)//' table max number of columns: ',n - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - allocate(list(n), ncol(m), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of '//modName(i)//' PET list table failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - do p = 1,2 - if (p.eq.2) then - if (verbose) then - write(msgString,'(a,i0)') trim(cname)//': '// & - modName(i)//' PET count: ',modPetCount(i) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - endif - if (modPetCount(i).lt.1.or.modPetCount(i).gt.petCount) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//modName(i)// & - ' PET count must be > 0 and <= # PETs') - return ! bail out - endif - allocate(modPetList(i)%p(modPetCount(i)), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of '//modName(i)//' PET list array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - call ESMF_ConfigFindLabel(config, trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)//' is required when pet_layout_option'// & - ' = specified and '//modName(i)//' is active') - return ! bail out - endif - modPetCount(i) = 0 - do l=1,m - call ESMF_ConfigNextLine(config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,i0,a)') trim(cname)//': '//trim(label)// & - ' next line ',l,' failed' - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, msg=trim(msgString)) - return ! bail out - endif - if (p.eq.1) then - ncol(l) = ESMF_ConfigGetLen(config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,i0,a)') trim(cname)//': '//trim(label)// & - ' get length ',l,' failed' - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, msg=trim(msgString)) - return ! bail out - endif - modPetCount(i) = modPetCount(i) + ncol(l) - else - call ESMF_ConfigGetAttribute(config, list(1:ncol(l)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) then - write(msgString,'(a,i0,a)') trim(cname)//': '//trim(label)// & - ' get row ',l,' failed' - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, msg=trim(msgString)) - return ! bail out - endif - modPetCount(i) = modPetCount(i) + ncol(l) - modPetList(i)%p(modPetCount(i)-ncol(l)+1:modPetCount(i)) = list(1:ncol(l)) - endif - enddo - enddo - deallocate(list, ncol, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of '//modName(i)//' PET list table failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - if (verbose) then - n = 10 - m = ceiling(real(modPetCount(i))/real(n)) - write(msgString,'(a)') trim(cname)//': '//modName(i)//' PET list:' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - do l = 1,m - k1 = min((l-1)*n+1,modPetCount(i)) - k2 = min((l-1)*n+n,modPetCount(i)) - write(msgString,'(a,100i7)') trim(cname)//': ', (modPetList(i)%p(k),k=k1,k2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - endif - if (minval(modPetList(i)%p).lt.0.or.maxval(modPetList(i)%p).ge.petCount) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//modName(i)//' PET list ids must be > 0 and < # PETs') - return ! bail out - endif - do j = 1,modPetCount(i) - if (count(modPetList(i)%p.eq.modPetList(i)%p(j)).gt.1) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//modName(i)//' PET list has duplicate entries') - return ! bail out - endif - enddo - enddo - - ! unsupported pet_layout_option: - case default - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': pet_layout_option not supported: '//trim(petLayoutOption)) - return ! bail out - endselect - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine SetRunSequence(driver, rc) - type(ESMF_GridComp) :: driver - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - type(ESMF_Config) :: config - type(type_InternalState) :: is - logical ,pointer :: verbose - integer ,pointer :: modCount - integer ,pointer :: med, atm, ocn, wav, ice, lnd - character(3) ,pointer :: modName(:) - logical ,pointer :: modActive(:) - type(type_PL),pointer :: modPetList(:) - character(10),pointer :: conName(:,:) - logical ,pointer :: conActive(:,:) - character(ESMF_MAXSTR) :: msgString - integer :: lrc, stat - integer :: i, j, k - - rc = ESMF_SUCCESS - - ! query the component for its name - call ESMF_GridCompGet(driver, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query the component for its config - call ESMF_GridCompGet(driver, config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query component for internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(driver, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set local pointers for internal state members - verbose => is%wrap%verbose - modCount => is%wrap%modCount - med => is%wrap%med - atm => is%wrap%atm - ocn => is%wrap%ocn - wav => is%wrap%wav - ice => is%wrap%ice - lnd => is%wrap%lnd - modName => is%wrap%modName - modActive => is%wrap%modActive - modPetList => is%wrap%modPetList - conName => is%wrap%conName - conActive => is%wrap%conActive - - ! override the default run sequence defined by the generic Driver - call NUOPC_DriverNewRunSequence(driver, slotCount=1, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (modActive(med)) then - ! *** run sequence with mediator *** - ! 1: connect active models to mediator - do i = med+1,modCount - if (.not.conActive(i,med)) cycle - call NUOPC_DriverAddRunElement(driver, 1, modName(i), modName(med), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - ! 2: advance mediator - call NUOPC_DriverAddRunElement(driver, 1, modName(med), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - ! 3: connect mediator to active models - do j = med+1,modCount - if (.not.conActive(med,j)) cycle - call NUOPC_DriverAddRunElement(driver, 1, modName(med), modName(j), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - ! 4: advance active models - do i = med+1,modCount - if (.not.modActive(i)) cycle - call NUOPC_DriverAddRunElement(driver, 1, modName(i), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - else - ! *** run sequence without mediator *** - ! 1: connect active models to active models - do j = 1,modCount - do i = 1,modCount - if (i.eq.j) cycle - if (.not.conActive(i,j)) cycle - call NUOPC_DriverAddRunElement(driver, 1, modName(i), modName(j), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - enddo - ! 2: advance active models - do i = 1,modCount - if (.not.modActive(i)) cycle - call NUOPC_DriverAddRunElement(driver, 1, modName(i), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - endif - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine Finalize(driver, rc) - type(ESMF_GridComp) :: driver - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - type(ESMF_Config) :: config - type(type_InternalState) :: is - logical :: verbose - integer ,pointer :: modCount - integer ,pointer :: med, atm, ocn, wav, ice, lnd - character(3) ,pointer :: modName(:) - logical ,pointer :: modActive(:) - type(type_PL),pointer :: modPetList(:) - character(10),pointer :: conName(:,:) - logical ,pointer :: conActive(:,:) - character(ESMF_MAXSTR) :: msgString - integer :: lrc, stat - integer :: i, j, k - - rc = ESMF_SUCCESS - - ! query the component for its name - call ESMF_GridCompGet(driver, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query component for internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(driver, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set local pointers for internal state members - verbose = is%wrap%verbose - modCount => is%wrap%modCount - med => is%wrap%med - atm => is%wrap%atm - ocn => is%wrap%ocn - wav => is%wrap%wav - ice => is%wrap%ice - lnd => is%wrap%lnd - modName => is%wrap%modName - modActive => is%wrap%modActive - modPetList => is%wrap%modPetList - conName => is%wrap%conName - conActive => is%wrap%conActive - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered Finalize', ESMF_LOGMSG_INFO) - - ! clean up internal state - do i = 1,modCount - if (.not.modActive(i)) cycle - deallocate(modPetList(i)%p, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of '//modName(i)//' PET list array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - enddo - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving Finalize', ESMF_LOGMSG_INFO) - - end subroutine - -end module diff --git a/model/esmf/esmApp.F90 b/model/esmf/esmApp.F90 deleted file mode 100644 index 3610dc9825..0000000000 --- a/model/esmf/esmApp.F90 +++ /dev/null @@ -1,98 +0,0 @@ -#include "macros.h" -!------------------------------------------------------------------------------- -! A test coupled application driver -! -! Author: -! Tim Campbell -! Naval Research Laboratory -! November 2014 -!------------------------------------------------------------------------------- - -program esmApp - - use ESMF - use NUOPC - use FRONT_ESM, only: drmSS => SetServices - use UTL - - implicit none - - integer :: rc, urc - type(ESMF_GridComp) :: gcomp - integer :: argCount - type(ESMF_Config) :: config - character(ESMF_MAXSTR) :: configFile - - ! Initialize ESMF - call ESMF_Initialize(logkindflag=ESMF_LOGKIND_MULTI, & - defaultCalkind=ESMF_CALKIND_GREGORIAN, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Set log defaults - call ESMF_LogSet(flush=.true.) - - ! Add required fields to NUOPC field dictionary - call InitFieldDictionary(rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Create the driver Component - gcomp = ESMF_GridCompCreate(name='WW3ESM', rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Create & set config for the driver Component - configFile = 'ww3_esmf.rc' - call ESMF_UtilGetArgC(argCount, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if (argCount.eq.1) then - call ESMF_UtilGetArg(1, argValue=configFile, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - endif - config = ESMF_ConfigCreate(rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_ConfigLoadFile(config, trim(configFile), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - call ESMF_GridCompSet(gcomp, config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! SetServices for the driver Component - call ESMF_GridCompSetServices(gcomp, drmSS, userRc=urc, rc=rc) - if (ESMF_LogFoundError( rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if (ESMF_LogFoundError(urc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Call Initialize for the driver Component - call ESMF_GridCompInitialize(gcomp, userRc=urc, rc=rc) - if (ESMF_LogFoundError( rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if (ESMF_LogFoundError(urc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Call Run for the driver Component - call ESMF_GridCompRun(gcomp, userRc=urc, rc=rc) - if (ESMF_LogFoundError( rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if (ESMF_LogFoundError(urc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Call Finalize for the driver Component - call ESMF_GridCompFinalize(gcomp, userRc=urc, rc=rc) - if (ESMF_LogFoundError( rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - if (ESMF_LogFoundError(urc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Destroy the driver Component - call ESMF_GridCompDestroy(gcomp, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) call ESMF_Finalize(endflag=ESMF_END_ABORT) - - ! Finalize ESMF - call ESMF_Finalize() - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine DummyRoutine(rc) - integer, intent(out) :: rc - - ! local variables - ! none - - rc = ESMF_SUCCESS - - end subroutine - -end program diff --git a/model/esmf/macros.h b/model/esmf/macros.h deleted file mode 100644 index 479cd64a4e..0000000000 --- a/model/esmf/macros.h +++ /dev/null @@ -1,32 +0,0 @@ -/* -------------------------------------------------------------------------- */ -/* Macros for ESMF logging */ -/* -------------------------------------------------------------------------- */ -#ifndef FILENAME -#define FILENAME __FILE__ -#endif -#define CONTEXT line=__LINE__,file=FILENAME -#define PASSTHRU msg=ESMF_LOGERR_PASSTHRU,CONTEXT - - -/* -------------------------------------------------------------------------- */ -/* Define real kind for data passed through ESMF interface */ -/* -------------------------------------------------------------------------- */ -#if defined(ESMF_R8) -#define _ESMF_KIND_RX _ESMF_KIND_R8 -#define ESMF_KIND_RX ESMF_KIND_R8 -#define ESMF_TYPEKIND_RX ESMF_TYPEKIND_R8 -#else -#define _ESMF_KIND_RX _ESMF_KIND_R4 -#define ESMF_KIND_RX ESMF_KIND_R4 -#define ESMF_TYPEKIND_RX ESMF_TYPEKIND_R4 -#endif - - -/* -------------------------------------------------------------------------- */ -/* Define macros for mask values */ -/* -------------------------------------------------------------------------- */ -#define MASK_INLAND_WATER -1 -#define MASK_WATER 0 -#define MASK_LAND 1 -#define MASK_FROZEN_WATER 2 -#define MASK_FROZEN_LAND 3 diff --git a/model/esmf/mdl.F90 b/model/esmf/mdl.F90 deleted file mode 100644 index 0b8ef7de51..0000000000 --- a/model/esmf/mdl.F90 +++ /dev/null @@ -1,911 +0,0 @@ -#include "macros.h" -!------------------------------------------------------------------------------- -! A test coupled application model component -! -! Author: -! Tim Campbell -! Naval Research Laboratory -! November 2014 -!------------------------------------------------------------------------------- - -module MDL - - use ESMF - use NUOPC -! use NUOPC_Model, parent_SetServices => SetServices - use NUOPC_Model, only: parent_SetServices => SetServices, & - label_DataInitialize, label_SetClock, label_Advance, label_Finalize - use UTL - - implicit none - - private - - public SetServices - - character (*), parameter :: label_InternalState = 'InternalState' - character (*), parameter :: inputAlarmName = 'InputAlarm' - integer , parameter :: maxFields = 25 - - integer, parameter :: modTypeConstant = 0 - integer, parameter :: modTypeTendency = 1 - integer, parameter :: modTypeForecast = 2 - integer, parameter :: modTypeHindcast = 3 - - type type_InternalStateStruct - logical :: verbose - integer :: modType - type(ESMF_TimeInterval) :: timeStep - type(ESMF_TimeInterval) :: inputInterval - real(ESMF_KIND_RX) :: dtRatio - character(ESMF_MAXSTR) :: dataDir - integer :: numf - logical ,pointer :: isActive(:) => null() - character(ESMF_MAXSTR) ,pointer :: sname(:) => null() - character(6) ,pointer :: fname(:) => null() - type(ESMF_Field) ,pointer :: field(:) => null() - logical :: realizeAllExport - integer(ESMF_KIND_I4) :: numwt - character(ESMF_MAXSTR) ,pointer :: wtnam(:) => null() - integer(ESMF_KIND_I4) ,pointer :: wtcnt(:) => null() - real(ESMF_KIND_R8) ,pointer :: wtime(:) => null() - end type - - type type_InternalState - type(type_InternalStateStruct), pointer :: wrap - end type - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine SetServices(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: msgString - type(type_InternalState) :: is - integer :: lrc, stat - - rc = ESMF_SUCCESS - - ! allocate memory for this internal state and set it in the component - allocate(is%wrap, stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of internal state memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - call ESMF_UserCompSetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! initialize timers - is%wrap%numwt = 6 - allocate(is%wrap%wtnam(is%wrap%numwt), is%wrap%wtcnt(is%wrap%numwt), & - is%wrap%wtime(is%wrap%numwt), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of wall timer memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - is%wrap%wtnam(1) = 'InitializeP0' - is%wrap%wtnam(2) = 'InitializeP1' - is%wrap%wtnam(3) = 'InitializeP3' - is%wrap%wtnam(4) = 'DataInitialize' - is%wrap%wtnam(5) = 'ModelAdvance' - is%wrap%wtnam(6) = 'Finalize' - is%wrap%wtcnt(:) = 0 - is%wrap%wtime(:) = 0d0 - - ! the NUOPC model component will register the generic methods - call NUOPC_CompDerive(gcomp, parent_SetServices, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set initialize phase 0 requires use of ESMF method - call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - userRoutine=InitializeP0, phase=0, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! set entry points for initialize methods - ! >= IPDv03 supports satisfying inter-model data dependencies and the transfer of ESMF - ! Grid & Mesh objects between Model and/or Mediator components during initialization - ! IPDv03p1: advertise import & export fields - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeP1, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - ! IPDv03p2: unspecified by NUOPC -- not required - ! IPDv03p3: realize import & export fields - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeP3, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - ! IPDv03p4: relevant for TransferActionGeomObject=="accept" - ! IPDv03p5: relevant for TransferActionGeomObject=="accept" - ! IPDv03p6: check compatibility of fields connected status - ! IPDv03p7: handle field data initialization - - ! attach specializing method(s) - call NUOPC_CompSpecialize(gcomp, specLabel=label_SetClock, & - specRoutine=SetClock, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=label_DataInitialize, & - specRoutine=DataInitialize, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=label_Advance, & - specRoutine=ModelAdvance, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_CompSpecialize(gcomp, specLabel=label_Finalize, & - specRoutine=Finalize, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine InitializeP0(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - character(ESMF_MAXSTR) :: verbosity - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=1, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - integer :: i - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! determine verbosity - call NUOPC_CompAttributeGet(gcomp, name='Verbosity', value=verbosity, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (trim(verbosity)=='high') then - is%wrap%verbose = .true. - else - is%wrap%verbose = .false. - endif - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered InitializeP0', ESMF_LOGMSG_INFO) - - ! check supported component names - select case (trim(cname)) - case ('ATM') - case ('OCN') - case ('WAV') - case ('ICE') - case default - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg='MDL: unsupported component name'//trim(cname)) - return ! bail out - endselect - - ! switch to IPDv03 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, & - acceptStringList=(/"IPDv03p"/), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - -1 if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving InitializeP0', ESMF_LOGMSG_INFO) - - ! finish timing - call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine InitializeP1(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=2, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - type(ESMF_VM) :: vm - type(ESMF_Config) :: config - character(ESMF_MAXSTR) :: label - character(ESMF_MAXSTR) :: inpstr - integer :: i, numf - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered InitializeP1', ESMF_LOGMSG_INFO) - - ! query Component for its config & vm - call ESMF_GridCompGet(gcomp, config=config, vm=vm, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get realize all export flag - label=trim(cname)//'_realize_all_export:' - call ESMF_ConfigGetAttribute(config, is%wrap%realizeAllExport, & - default=.false., label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get data directory - label=trim(cname)//'_work_dir:' - call ESMF_ConfigGetAttribute(config, is%wrap%dataDir, label=trim(label), default='.', rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! allocate field/data arrays - allocate(is%wrap%isActive(maxFields), & - is%wrap%sname(maxFields), is%wrap%fname(maxFields), & - is%wrap%field(maxFields), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, & - msg='Allocation of internal state data arrays failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - is%wrap%isActive = .false. - - ! set attributes for fields - i = 0 - select case (trim(cname)) - case ('ATM') - i = i+1 - is%wrap%sname(i) = 'air_pressure_at_sea_level' - is%wrap%fname(i) = 'slpres' !'pres' - i = i+1 - is%wrap%sname(i) = 'eastward_wind_at_10m_height' - is%wrap%fname(i) = 'uutrue' !'wnd_utru' - i = i+1 - is%wrap%sname(i) = 'northward_wind_at_10m_height' - is%wrap%fname(i) = 'vvtrue' !'wnd_vtru' - i = i+1 - is%wrap%sname(i) = 'magnitude_of_surface_downward_stress' - is%wrap%fname(i) = 'wstres' !'wnd_strs' - i = i+1 - is%wrap%sname(i) = 'air_temperature_at_2m_height' - is%wrap%fname(i) = 'airtmp' !'air_temp' - i = i+1 - is%wrap%sname(i) = 'relative_humidity_at_2m_height' - is%wrap%fname(i) = 'relhum' !'rltv_hum' - i = i+1 - is%wrap%sname(i) = 'surface_net_downward_shortwave_flux' - is%wrap%fname(i) = 'solflx' !'sol_rad' - i = i+1 - is%wrap%sname(i) = 'surface_net_downward_longwave_flux' - is%wrap%fname(i) = 'lonflx' !'ir_flux' - case ('OCN') - i = i+1 - is%wrap%sname(i) = 'sea_surface_temperature' - is%wrap%fname(i) = 'seatmp' - i = i+1 - is%wrap%sname(i) = 'sea_surface_salinity' - is%wrap%fname(i) = 'salint' - i = i+1 - is%wrap%sname(i) = 'sea_surface_height_above_sea_level' - is%wrap%fname(i) = 'seahgt' - i = i+1 - is%wrap%sname(i) = 'surface_eastward_sea_water_velocity' - is%wrap%fname(i) = 'uucurr' - i = i+1 - is%wrap%sname(i) = 'surface_northward_sea_water_velocity' - is%wrap%fname(i) = 'vvcurr' - case ('WAV') - i = i+1 - is%wrap%sname(i) = 'wave_induced_charnock_parameter' - is%wrap%fname(i) = 'charno' - i = i+1 - is%wrap%sname(i) = 'surface_total_wave_induced_stress' - is%wrap%fname(i) = 'wvstrs' - i = i+1 - is%wrap%sname(i) = 'surface_eastward_wave_induced_stress' - is%wrap%fname(i) = 'wvstru' - i = i+1 - is%wrap%sname(i) = 'surface_northward_wave_induced_stress' - is%wrap%fname(i) = 'wvstrv' - i = i+1 - is%wrap%sname(i) = 'eastward_stokes_drift_current' - is%wrap%fname(i) = 'uscurr' - i = i+1 - is%wrap%sname(i) = 'northward_stokes_drift_current' - is%wrap%fname(i) = 'vscurr' - i = i+1 - is%wrap%sname(i) = 'eastward_wave_bottom_current' - is%wrap%fname(i) = 'wbcuru' - i = i+1 - is%wrap%sname(i) = 'northward_wave_bottom_current' - is%wrap%fname(i) = 'wbcurv' - i = i+1 - is%wrap%sname(i) = 'wave_bottom_current_radian_frequency' - is%wrap%fname(i) = 'wbcurf' - i = i+1 - is%wrap%sname(i) = 'eastward_wave_radiation_stress_gradient' - is%wrap%fname(i) = 'wavsgu' - i = i+1 - is%wrap%sname(i) = 'northward_wave_radiation_stress_gradient' - is%wrap%fname(i) = 'wavsgv' - case ('ICE') - i = i+1 - is%wrap%sname(i) = 'sea_ice_concentration' - is%wrap%fname(i) = 'icecon' - endselect - numf = i - is%wrap%numf = numf - if (numf.gt.maxFields) then - write(msgString,'(a,i3)') trim(cname)//': increase maxFields to ',numf - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, msg=trim(msgString)) - return ! bail out - endif - - ! advertise exportable fields - do i=1,numf - call NUOPC_Advertise(exportState, & - StandardName=trim(is%wrap%sname(i)), name=trim(is%wrap%fname(i)), & - TransferOfferGeomObject="will provide", rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - - ! report advertised export fields - write(msgString,'(a,i0,a)') trim(cname)// & - ': List of advertised export fields(',numf,'):' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(a,a5,a,a10,a3,a)') trim(cname)// & - ': ','index',' ','name',' ','standardName' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - do i=1,numf - write(msgString,'(a,i5,a,a10,a3,a)') trim(cname)// & - ': ',i,' ',trim(is%wrap%fname(i)),' ',trim(is%wrap%sname(i)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - -1 if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving InitializeP1', ESMF_LOGMSG_INFO) - - ! finish timing - call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine InitializeP3(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=3, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - integer, parameter :: localDE=0 - type(ESMF_VM) :: vm - type(ESMF_Config) :: config - character(ESMF_MAXSTR) :: label - character(ESMF_MAXSTR) :: inpstr - type(ESMF_Time) :: startTime - integer :: i, n - type(ESMF_ArraySpec) :: arraySpec2d, arraySpec3d - type(ESMF_Grid) :: grid - logical :: inc3d - logical :: isConnected - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered InitializeP3', ESMF_LOGMSG_INFO) - - ! query Component for its config & vm - call ESMF_GridCompGet(gcomp, config=config, vm=vm, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! flag connected export fields - ! remove unconnected if not realize all export - n = 0 - do i = 1,is%wrap%numf - isConnected = NUOPC_IsConnected(exportState, is%wrap%fname(i), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - is%wrap%isActive(i) = isConnected .or. is%wrap%realizeAllExport - if (is%wrap%isActive(i)) then - n = n + 1 - else - call ESMF_StateRemove(exportState, (/is%wrap%fname(i)/), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - endif - enddo - - ! report realized export fields - write(msgString,'(a,i0,a)') trim(cname)// & - ': List of realized export fields(',n,'):' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - write(msgString,'(a,a5,a,a10,a3,a)') trim(cname)// & - ': ','index',' ','name',' ','standardName' - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - n = 0 - do i = 1,is%wrap%numf - if (.not.is%wrap%isActive(i)) cycle - n = n + 1 - write(msgString,'(a,i5,a,a10,a3,a)') trim(cname)// & - ': ',n,' ',trim(is%wrap%fname(i)),' ',trim(is%wrap%sname(i)) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - enddo - - ! if no active export fields, then skip the rest - if (.not.any(is%wrap%isActive)) goto 1 - - ! query Component for its config & vm - call ESMF_GridCompGet(gcomp, config=config, vm=vm, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get time information from clock - call ESMF_ClockGet(clock, startTime=startTime, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get coord and create grid - !TODO - - ! create arraySpec - call ESMF_ArraySpecSet(arraySpec2d, rank=2, typeKind=ESMF_TYPEKIND_RX, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_ArraySpecSet(arraySpec3d, rank=3, typeKind=ESMF_TYPEKIND_RX, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! realize active export fields - do i = 1,is%wrap%numf - if (.not.is%wrap%isActive(i)) cycle - is%wrap%field(i) = ESMF_FieldCreate(grid, arraySpec2d, & - name=is%wrap%fname(i), indexFlag=ESMF_INDEX_GLOBAL, & - staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call NUOPC_Realize(exportState, is%wrap%field(i), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - -1 if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving InitializeP3', ESMF_LOGMSG_INFO) - - ! finish timing - call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine DataInitialize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=4, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - integer, parameter :: localDE=0 - integer :: localPet - integer :: i - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - ! query the Component for PET info - call ESMF_GridCompGet(gcomp, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! report - write(msgString,'(a)') trim(cname)//': entered DataInitialize' - if (verbose) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - if (localPet.eq.0) write(*,'(///a)') trim(msgString) - - ! set export fields - call SetExport(gcomp, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! report all import dependencies are satisfied - write(msgString,'(a)') trim(cname)//': all inter-model data dependencies SATISFIED' - if (verbose) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - if (localPet.eq.0) write(*,'(a)') trim(msgString) - - ! set Updated Field Attribute to "true", indicating to the - ! generic code to set the timestamp for these fields - do i=1,is%wrap%numf - if (.not.is%wrap%isActive(i)) cycle - call NUOPC_SetAttribute(is%wrap%field(i), name="Updated", value="true", rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - - ! set InitializeDataComplete Attribute to "true", indicating to the - ! generic code that all inter-model data dependencies are satisfied - call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! report -1 write(msgString,'(a)') trim(cname)//': leaving DataInitialize' - if (verbose) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) - if (localPet.eq.0) write(*,'(/a)') trim(msgString) - - ! finish timing - call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine ModelAdvance(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=5, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - type(ESMF_Clock) :: clock - integer :: localPet - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered ModelAdvance', ESMF_LOGMSG_INFO) - - ! query the Component for PET info - call ESMF_GridCompGet(gcomp, localPet=localPet, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query the Component for its clock - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (localPet.eq.0) then - write(*,'(///)') - call ESMF_ClockPrint(clock, options='currTime', & - preString='-->Advancing '//trim(cname)//' from: ') - call ESMF_ClockPrint(clock, options='stopTime', & - preString='-----------------> to: ') - endif - - ! set export fields - call SetExport(gcomp, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - -1 if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving ModelAdvance', ESMF_LOGMSG_INFO) - - ! finish timing - call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine Finalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - integer, parameter :: it1=6, it2=0, it3=0 - real(ESMF_KIND_R8) :: ws1Time, wf1Time - real(ESMF_KIND_R8) :: ws2Time, wf2Time - real(ESMF_KIND_R8) :: ws3Time, wf3Time - integer :: i - - rc = ESMF_SUCCESS - - ! start timing - call ESMF_VMWtime(ws1Time) - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': entered Finalize', ESMF_LOGMSG_INFO) - - ! destroy fields - do i = 1,is%wrap%numf - if (.not.is%wrap%isActive(i)) cycle - call ESMF_FieldDestroy(is%wrap%field(i),rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - enddo - - ! deallocate field/data arrays - deallocate(is%wrap%isActive, & - is%wrap%sname, is%wrap%fname, & - is%wrap%field, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of internal state data arrays failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - - ! finish timing - call ESMF_VMWtime(wf1Time) - is%wrap%wtime(it1) = is%wrap%wtime(it1) + wf1Time - ws1Time - is%wrap%wtcnt(it1) = is%wrap%wtcnt(it1) + 1 - - ! print timing - call PrintTimers(trim(cname), is%wrap%wtnam, is%wrap%wtcnt, is%wrap%wtime) - - ! deallocate timers - if (associated(is%wrap%wtnam)) then - deallocate(is%wrap%wtnam, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of wtnam array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - if (associated(is%wrap%wtcnt)) then - deallocate(is%wrap%wtcnt, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of wtcnt array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - if (associated(is%wrap%wtime)) then - deallocate(is%wrap%wtime, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of wtime array failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - endif - - ! deallocate internal state memory - deallocate(is%wrap, stat=stat) - if (ESMF_LogFoundDeallocError(statusToCheck=stat, & - msg='Deallocation of internal state memory failed.', & - CONTEXT, rcToReturn=rc)) return ! bail out - - if (verbose) & - call ESMF_LogWrite(trim(cname)//': leaving Finalize', ESMF_LOGMSG_INFO) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine SetClock(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - type(ESMF_Config) :: config - character(ESMF_MAXSTR) :: label - type(ESMF_Clock) :: clock - type(ESMF_TimeInterval) :: zeroti - type(ESMF_TimeInterval) :: timeStep - type(ESMF_TimeInterval) :: inputInterval - type(ESMF_Alarm) :: inputAlarm - real(ESMF_KIND_R8) :: dtRatio - integer(ESMF_KIND_I4) :: time(3) - logical :: isPresent - - rc = ESMF_SUCCESS - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - ! set zero time interval - call ESMF_TimeIntervalSet(zeroti, s=0, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get clock and config - call ESMF_GridCompGet(gcomp, clock=clock, config=config, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get driver time step (coupling interval) - call ESMF_ClockGet(clock, timeStep=timeStep, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get time step from config - is%wrap%timeStep = timeStep - label=trim(cname)//'_time_step:' - call ESMF_ConfigFindLabel(config, label=trim(label), isPresent=isPresent, rc=rc) - if (isPresent.and.rc.eq.ESMF_SUCCESS) then - call ESMF_ConfigGetAttribute(config, time, count=3, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_TimeIntervalSet(is%wrap%timeStep, h=time(1), m=time(2), s=time(3), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - endif - if (mod(timeStep,is%wrap%timeStep) /= zeroti) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)// & - ' must be divisible into the driver time step') - return ! bail out - endif - - ! get data input interval from config - is%wrap%inputInterval = timeStep - label=trim(cname)//'_input_interval:' - call ESMF_ConfigFindLabel(config, label=trim(label), isPresent=isPresent, rc=rc) - if (isPresent.and.rc.eq.ESMF_SUCCESS) then - call ESMF_ConfigGetAttribute(config, time, count=3, label=trim(label), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - call ESMF_TimeIntervalSet(is%wrap%inputInterval, h=time(1), m=time(2), s=time(3), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - endif - if (mod(is%wrap%inputInterval,timeStep) /= zeroti) then - call ESMF_LogSetError(ESMF_FAILURE, rcToReturn=rc, & - msg=trim(cname)//': '//trim(label)// & - ' must be a multiple of driver time step') - return ! bail out - endif - - ! setup alarm for reading input fields - inputAlarm = ESMF_AlarmCreate(clock, ringInterval=is%wrap%inputInterval, & - name=inputAlarmName, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! compute ratio of driver timeStep to model input interval - dtRatio = timeStep / is%wrap%inputInterval - is%wrap%dtRatio = real(dtRatio,ESMF_KIND_RX) - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine SetExport(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(ESMF_MAXSTR) :: cname - character(ESMF_MAXSTR) :: msgString - logical :: verbose - type(type_InternalState) :: is - integer :: lrc, stat - type(ESMF_VM) :: vm - type(ESMF_Clock) :: clock - type(ESMF_Time) :: startTime, currTime - type(ESMF_Alarm) :: inputAlarm - integer :: i - - rc = ESMF_SUCCESS - - ! query the Component for its name - call ESMF_GridCompGet(gcomp, name=cname, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! query Component for its internal State - nullify(is%wrap) - call ESMF_UserCompGetInternalState(gcomp, label_InternalState, is, rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - verbose = is%wrap%verbose - - ! if no active export fields, then return - if (.not.any(is%wrap%isActive)) return - - ! query the Component for its clock & vm - call ESMF_GridCompGet(gcomp, clock=clock, vm=vm, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get time information from clock - call ESMF_ClockGet(clock, startTime=startTime, currTime=currTime, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! get input alarm from clock - call ESMF_ClockGetAlarm(clock, inputAlarmName, inputAlarm, rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - - ! time for new input - if (ESMF_AlarmIsRinging(inputAlarm)) then - do i=1,is%wrap%numf - ! skip if not active - if (.not.is%wrap%isActive(i)) cycle - ! read next field - ! TODO - enddo - ! turn off alarm - call ESMF_AlarmRingerOff(inputAlarm) - endif - - end subroutine - -end module diff --git a/model/esmf/switch b/model/esmf/switch deleted file mode 100644 index eff22206fb..0000000000 --- a/model/esmf/switch +++ /dev/null @@ -1,40 +0,0 @@ -NCO -NOGRB -DIST -MPI -OMPG -OMPH -SCRIP -SCRIPNC -WRST -PR3 -UQ -FLX0 -SEED -ST4 -STAB0 -NL1 -BT1 -DB1 -MLIM -FLD2 -TR0 -BS0 -RWND -WNX1 -WNT1 -CRX1 -CRT1 -O0 -O1 -O2 -O3 -O4 -O5 -O6 -O7 -O14 -O15 -IC0 -IS0 -REF0 diff --git a/model/esmf/utl.F90 b/model/esmf/utl.F90 deleted file mode 100644 index 145b6a4321..0000000000 --- a/model/esmf/utl.F90 +++ /dev/null @@ -1,173 +0,0 @@ -#include "macros.h" -!------------------------------------------------------------------------------- -! A test coupled application utility module -! -! Author: -! Tim Campbell -! Naval Research Laboratory -! November 2014 -!------------------------------------------------------------------------------- - -module UTL - - use ESMF - use NUOPC - - implicit none - save - private - - public InitFieldDictionary - public PrintTimers - - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- - - subroutine InitFieldDictionary(rc) - integer, intent(out) :: rc - - ! local variables - integer, parameter :: maxFields = 50 - character(ESMF_MAXSTR) :: standardName(maxFields) - character(ESMF_MAXSTR) :: canonicalUnits(maxFields) - integer :: i, numFields - logical :: isPresent - - rc = ESMF_SUCCESS - - i = 0 - ! ATM export fields - i = i+1; standardName(i) = 'air_pressure_at_sea_level' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'eastward_wind_at_10m_height' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'northward_wind_at_10m_height' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'magnitude_of_surface_downward_stress' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'surface_downward_eastward_stress' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'surface_downward_northward_stress' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'air_temperature_at_2m_height' - canonicalUnits(i)='K' - i = i+1; standardName(i) = 'relative_humidity_at_2m_height' - canonicalUnits(i)='1' - i = i+1; standardName(i) = 'surface_downward_latent_heat_flux' - canonicalUnits(i)='W m-2' - i = i+1; standardName(i) = 'surface_downward_sensible_heat_flux' - canonicalUnits(i)='W m-2' - i = i+1; standardName(i) = 'surface_net_downward_shortwave_flux' - canonicalUnits(i)='W m-2' - i = i+1; standardName(i) = 'surface_net_downward_longwave_flux' - canonicalUnits(i)='W m-2' - ! OCN export fields - i = i+1; standardName(i) = 'sea_surface_height_above_sea_level' - canonicalUnits(i)='m' - i = i+1; standardName(i) = 'sea_surface_temperature' - canonicalUnits(i)='K' - i = i+1; standardName(i) = 'sea_surface_salinity' - canonicalUnits(i)='1e-3' - i = i+1; standardName(i) = 'surface_eastward_sea_water_velocity' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'surface_northward_sea_water_velocity' - canonicalUnits(i)='m s-1' - ! WAV export fields - i = i+1; standardName(i) = 'wave_z0_roughness_length' - canonicalUnits(i)='m' - i = i+1; standardName(i) = 'wave_induced_charnock_parameter' - canonicalUnits(i)='1' - i = i+1; standardName(i) = 'surface_total_wave_induced_stress' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'surface_eastward_wave_induced_stress' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'surface_northward_wave_induced_stress' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'eastward_stokes_drift_current' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'northward_stokes_drift_current' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'eastward_wave_bottom_current' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'northward_wave_bottom_current' - canonicalUnits(i)='m s-1' - i = i+1; standardName(i) = 'wave_bottom_current_radian_frequency' - canonicalUnits(i)='rad s-1' - i = i+1; standardName(i) = 'eastward_wave_radiation_stress' - canonicalUnits(i)='Pa m' - i = i+1; standardName(i) = 'eastward_northward_wave_radiation_stress' - canonicalUnits(i)='Pa m' - i = i+1; standardName(i) = 'northward_wave_radiation_stress' - canonicalUnits(i)='Pa m' - i = i+1; standardName(i) = 'eastward_wave_radiation_stress_gradient' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'northward_wave_radiation_stress_gradient' - canonicalUnits(i)='Pa' - i = i+1; standardName(i) = 'wave_orbital_turbulence_production' - canonicalUnits(i)='m2 s-3' - i = i+1; standardName(i) = 'sea_floor_depth_below_sea_surface' - canonicalUnits(i)='m' - i = i+1; standardName(i) = 'air_sea_temperature_difference' - canonicalUnits(i)='K' - i = i+1; standardName(i) = 'bottom_friction_coefficient' - canonicalUnits(i)='1' - ! ICE export fields - i = i+1; standardName(i) = 'sea_ice_concentration' - canonicalUnits(i)='m' - numFields = i - - do i=1,numFields - ! normal fields - isPresent = NUOPC_FieldDictionaryHasEntry(trim(standardName(i)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (.not.isPresent) then - call NUOPC_FieldDictionaryAddEntry(trim(standardName(i)), & - trim(canonicalUnits(i)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - endif - ! background fields (add mbg_ prefix) - isPresent = NUOPC_FieldDictionaryHasEntry('mbg_'//trim(standardName(i)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (.not.isPresent) then - call NUOPC_FieldDictionaryAddEntry('mbg_'//trim(standardName(i)), & - trim(canonicalUnits(i)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - endif - ! perturbation fields (add pert_ prefix) - isPresent = NUOPC_FieldDictionaryHasEntry('pert_'//trim(standardName(i)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - if (.not.isPresent) then - call NUOPC_FieldDictionaryAddEntry('pert_'//trim(standardName(i)), & - trim(canonicalUnits(i)), rc=rc) - if (ESMF_LogFoundError(rc, PASSTHRU)) return ! bail out - endif - enddo - - end subroutine - - !----------------------------------------------------------------------------- - - subroutine PrintTimers(cname, wtnam, wtcnt, wtime) - character(*) :: cname - character(*) :: wtnam(:) - integer(ESMF_KIND_I4) :: wtcnt(:) - real(ESMF_KIND_R8) :: wtime(:) - - ! local variables - character(ESMF_MAXSTR) :: msg - integer(ESMF_KIND_I4) :: k - - write(msg,1) trim(cname),'timer','count','time' - call ESMF_LogWrite(TRIM(msg), ESMF_LOGMSG_INFO) - do k=lbound(wtcnt,1),ubound(wtcnt,1) - write(msg,2) trim(cname),trim(wtnam(k)),wtcnt(k),wtime(k) - call ESMF_LogWrite(TRIM(msg), ESMF_LOGMSG_INFO) - enddo - -1 format(a,': wtime: ',a20,a10,a14) -2 format(a,': wtime: ',a20,i10,e14.6) - - end subroutine - -end module From 5721ada3893bf8df4a5ed3f3ad19eb28bac9a776 Mon Sep 17 00:00:00 2001 From: Juan Manuel Castillo Sanchez <48921434+ukmo-juan-castillo@users.noreply.github.com> Date: Wed, 17 Sep 2025 21:46:56 +0100 Subject: [PATCH 100/136] Remove gotos in smc_docs/ (#1495) --- smc_docs/SMCG_TKs/G50SAcSide.f90 | 255 ++++++++++++++--------------- smc_docs/SMCG_TKs/G50SGlSide.f90 | 193 +++++++++++----------- smc_docs/SMCG_TKs/g50smcswhglb.pro | 2 - smc_docs/SMCG_TKs/g50smstrspb.pro | 2 - smc_docs/SMCG_TKs/smc625swhGlb.pro | 2 - 5 files changed, 221 insertions(+), 233 deletions(-) diff --git a/smc_docs/SMCG_TKs/G50SAcSide.f90 b/smc_docs/SMCG_TKs/G50SAcSide.f90 index 142cf67c75..6dd6639bd1 100644 --- a/smc_docs/SMCG_TKs/G50SAcSide.f90 +++ b/smc_docs/SMCG_TKs/G50SAcSide.f90 @@ -108,7 +108,7 @@ PROGRAM AdapGrid ! Close all files CLOSE(16) - 9999 PRINT*, ' AdapGrid completed ' + PRINT*, ' AdapGrid completed ' END PROGRAM AdapGrid ! End of main program @@ -192,7 +192,7 @@ SUBROUTINE CellSide WRITE(6,*) " Start creating u boundary face II JJ=", II, JJ !! Exclude last cell, the North Polar cell. - DO 111 L=1, NC-1 + DO L=1, NC-1 !! Loop over all cells. ! DO 111 L=1, NC i=0 @@ -237,93 +237,91 @@ SUBROUTINE CellSide END DO IF(kk+ij .gt. 2*ICE(4,L) ) WRITE(6,*) "Over done i-side for cell L,ij,kk=", L, ij, kk - IF(kk+ij .ge. 2*ICE(4,L) ) GOTO 111 + IF(kk+ij .ge. 2*ICE(4,L) ) CYCLE - IF(ij .eq. 0) THEN + IF(ij .eq. 0) THEN !! Full boundary cell for west side - II=II+1 - ISD(1,II)=ICE(1,L) - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L) + II=II+1 + ISD(1,II)=ICE(1,L) + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L) !! New boundary cells proportional to cell x-sizes !! Updated for any 2**n sizes -! ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ISD(5,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) - ISD(6,II)=L - ENDIF - IF(kk .eq. 0) THEN +! ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(5,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) + ISD(6,II)=L + ENDIF + IF(kk .eq. 0) THEN !! Full boundary cell for east side - II=II+1 - ISD(1,II)=LM - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L) - ISD(5,II)=L + II=II+1 + ISD(1,II)=LM + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L) + ISD(5,II)=L !! Updated for any 2**n sizes -! ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ISD(6,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) - ENDIF +! ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(6,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) + ENDIF !! Half cell size west boundary faces - IF(ij .gt. 0 .and. ij .lt. ICE(4,L) ) THEN - IF( i .eq. 0 ) THEN + IF(ij .gt. 0 .and. ij .lt. ICE(4,L) ) THEN + IF( i .eq. 0 ) THEN !! lower half west cell face - II=II+1 - ISD(1,II)=ICE(1,L) - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=ICE(1,L) + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L)/2 !! Updated for any 2**n sizes - ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) !! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2 - ISD(6,II)=L - ENDIF - IF( j .eq. 0 ) THEN + ISD(6,II)=L + ENDIF + IF( j .eq. 0 ) THEN !! Upper half west cell face - II=II+1 - ISD(1,II)=ICE(1,L) - ISD(2,II)=ICE(2,L)+ICE(4,L)/2 - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=ICE(1,L) + ISD(2,II)=ICE(2,L)+ICE(4,L)/2 + ISD(3,II)=ICE(4,L)/2 !! Updated for any 2**n sizes - ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ISD(6,II)=L - ENDIF - ENDIF + ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(6,II)=L + ENDIF + ENDIF !! Half cell size east boundary faces - IF(kk .gt. 0 .and. kk .lt. ICE(4,L) ) THEN - IF( k .eq. 0 ) THEN + IF(kk .gt. 0 .and. kk .lt. ICE(4,L) ) THEN + IF( k .eq. 0 ) THEN !! lower half east cell face - II=II+1 - ISD(1,II)=LM - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=LM + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L)/2 !! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2 - ISD(5,II)=L + ISD(5,II)=L !! Updated for any 2**n sizes - ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ENDIF - IF( n .eq. 0 ) THEN + ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ENDIF + IF( n .eq. 0 ) THEN !! Upper half west cell face - II=II+1 - ISD(1,II)=LM - ISD(2,II)=ICE(2,L)+ICE(4,L)/2 - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=LM + ISD(2,II)=ICE(2,L)+ICE(4,L)/2 + ISD(3,II)=ICE(4,L)/2 !! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2 - ISD(5,II)=L + ISD(5,II)=L !! Updated for any 2**n sizes - ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ENDIF - ENDIF - - 111 CONTINUE - + ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ENDIF + ENDIF + ENDDO ! Set boundary v faces WRITE(6,*) " Start creating v boundary face II JJ=", II, JJ !! Exclude the last polar cell - DO 222 L=1, NC-1 + DO L=1, NC-1 !! Loop over all cells -! DO 222 L=1, NC +! DO L=1, NC i=0 j=0 ij=0 @@ -361,97 +359,96 @@ SUBROUTINE CellSide END DO IF(nn+ij .gt. 2*ICE(3,L) ) WRITE(6,*) "Over done j-side for L, ij, nn=", L, ij, nn - IF(nn+ij .ge. 2*ICE(3,L) ) GOTO 222 + IF(nn+ij .ge. 2*ICE(3,L) ) CYCLE - IF(ij .eq. 0) THEN + IF(ij .eq. 0) THEN !! Full boundary cell for south side - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L) - JSD(2,JJ)=ICE(2,L) - JSD(3,JJ)=ICE(3,L) + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L) + JSD(2,JJ)=ICE(2,L) + JSD(3,JJ)=ICE(3,L) !! New boundary cells proportional to cell sizes !! Updated for any 2**n sizes - JSD(5,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) - JSD(6,JJ)=L - JSD(8,JJ)=ICE(4,L) + JSD(5,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) + JSD(6,JJ)=L + JSD(8,JJ)=ICE(4,L) !! No cells over Antarctic land so there is no S Polar cell. - ENDIF - IF(nn .eq. 0) THEN + ENDIF + IF(nn .eq. 0) THEN !! Full boundary cell for north side - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L) - JSD(2,JJ)=ICE(2,L)+ICE(4,L) - JSD(3,JJ)=ICE(3,L) - JSD(5,JJ)=L + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L) + JSD(2,JJ)=ICE(2,L)+ICE(4,L) + JSD(3,JJ)=ICE(3,L) + JSD(5,JJ)=L !! North polar cell takes the whole last 4 rows above JSD=ICE(2,NC). !! Note ICE(2,L) represents lower-side of the cell. Polar cell is the last cell NC. - IF( ICE(2,L)+ICE(4,L) .eq. ICE(2,NC) ) THEN - JSD(6,JJ)=NC - WRITE(6,*) "Set north pole v face for cell L", L - ELSE + IF( ICE(2,L)+ICE(4,L) .eq. ICE(2,NC) ) THEN + JSD(6,JJ)=NC + WRITE(6,*) "Set north pole v face for cell L", L + ELSE !! Updated for any 2**n sizes JSD(6,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) - ENDIF - JSD(8,JJ)=ICE(4,L) - ENDIF + ENDIF + JSD(8,JJ)=ICE(4,L) + ENDIF !! Half cell size south boundary faces - IF(ij .gt. 0 .and. ij .lt. ICE(3,L) ) THEN - IF( i .eq. 0 ) THEN + IF(ij .gt. 0 .and. ij .lt. ICE(3,L) ) THEN + IF( i .eq. 0 ) THEN !! left half cell face - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L) - JSD(2,JJ)=ICE(2,L) - JSD(3,JJ)=ICE(3,L)/2 + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L) + JSD(2,JJ)=ICE(2,L) + JSD(3,JJ)=ICE(3,L)/2 !! New boundary cells proportional to cell sizes !! Updated for any 2**n sizes - JSD(5,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) - JSD(6,JJ)=L - JSD(8,JJ)=ICE(4,L) - ENDIF - IF( j .eq. 0 ) THEN + JSD(5,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) + JSD(6,JJ)=L + JSD(8,JJ)=ICE(4,L) + ENDIF + IF( j .eq. 0 ) THEN !! right half cell face - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L)+ICE(3,L)/2 - JSD(2,JJ)=ICE(2,L) - JSD(3,JJ)=ICE(3,L)/2 + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L)+ICE(3,L)/2 + JSD(2,JJ)=ICE(2,L) + JSD(3,JJ)=ICE(3,L)/2 !! New boundary cells proportional to cell sizes !! Updated for any 2**n sizes - JSD(5,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) - JSD(6,JJ)=L - JSD(8,JJ)=ICE(4,L) - ENDIF - ENDIF + JSD(5,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) + JSD(6,JJ)=L + JSD(8,JJ)=ICE(4,L) + ENDIF + ENDIF !! Half cell size north boundary faces - IF(nn .gt. 0 .and. nn .lt. ICE(3,L) ) THEN - IF( k .eq. 0 ) THEN + IF(nn .gt. 0 .and. nn .lt. ICE(3,L) ) THEN + IF( k .eq. 0 ) THEN !! left half north cell face - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L) - JSD(2,JJ)=ICE(2,L)+ICE(4,L) - JSD(3,JJ)=ICE(3,L)/2 - JSD(5,JJ)=L + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L) + JSD(2,JJ)=ICE(2,L)+ICE(4,L) + JSD(3,JJ)=ICE(3,L)/2 + JSD(5,JJ)=L !! New boundary cells proportional to cell sizes !! Updated for any 2**n sizes - JSD(6,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) - JSD(8,JJ)=ICE(4,L) - ENDIF - IF( n .eq. 0 ) THEN + JSD(6,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) + JSD(8,JJ)=ICE(4,L) + ENDIF + IF( n .eq. 0 ) THEN !! right half north cell face - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L)+ICE(3,L)/2 - JSD(2,JJ)=ICE(2,L)+ICE(4,L) - JSD(3,JJ)=ICE(3,L)/2 - JSD(5,JJ)=L + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L)+ICE(3,L)/2 + JSD(2,JJ)=ICE(2,L)+ICE(4,L) + JSD(3,JJ)=ICE(3,L)/2 + JSD(5,JJ)=L !! New boundary cells proportional to cell sizes !! Updated for any 2**n sizes - JSD(6,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) - JSD(8,JJ)=ICE(4,L) - ENDIF - ENDIF - - 222 CONTINUE + JSD(6,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) + JSD(8,JJ)=ICE(4,L) + ENDIF + ENDIF + ENDDO ! Store top level U V side numbers in NU NV NU=II @@ -633,9 +630,9 @@ SUBROUTINE CellSide PRINT*, ' I J-Sides output done ' - 999 PRINT*, ' Sub CellSide ended.' + PRINT*, ' Sub CellSide ended.' - RETURN + RETURN END SUBROUTINE CellSide diff --git a/smc_docs/SMCG_TKs/G50SGlSide.f90 b/smc_docs/SMCG_TKs/G50SGlSide.f90 index 175b408b0f..f4a7783234 100644 --- a/smc_docs/SMCG_TKs/G50SGlSide.f90 +++ b/smc_docs/SMCG_TKs/G50SGlSide.f90 @@ -105,7 +105,7 @@ PROGRAM AdapGrid ! Close all files CLOSE(16) - 9999 PRINT*, ' AdapGrid completed ' + PRINT*, ' AdapGrid completed ' END PROGRAM AdapGrid ! End of main program @@ -189,9 +189,9 @@ SUBROUTINE CellSide WRITE(6,*) " Start creating u boundary face II JJ=", II, JJ !! Exclude last cell, the North Polar cell. -! DO 111 L=1, NC-1 +! DO L=1, NC-1 !! Loop over all cells. - DO 111 L=1, NC + DO L=1, NC i=0 j=0 ij=0 @@ -234,94 +234,92 @@ SUBROUTINE CellSide END DO IF(kk+ij .gt. 2*ICE(4,L) ) WRITE(6,*) "Over done i-side for cell L,ij,kk=", L, ij, kk - IF(kk+ij .ge. 2*ICE(4,L) ) GOTO 111 + IF(kk+ij .ge. 2*ICE(4,L) ) CYCLE - IF(ij .eq. 0) THEN + IF(ij .eq. 0) THEN !! Full boundary cell for west side - II=II+1 - ISD(1,II)=ICE(1,L) - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L) + II=II+1 + ISD(1,II)=ICE(1,L) + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L) !! New full U-boundary cells proportional to cell x-sizes. JGLi01Apr2011 !! Updated for any 2**n sizes -!! ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ISD(5,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) - ISD(6,II)=L - ENDIF - IF(kk .eq. 0) THEN +!! ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(5,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) + ISD(6,II)=L + ENDIF + IF(kk .eq. 0) THEN !! Full boundary cell for east side - II=II+1 - ISD(1,II)=LM - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L) - ISD(5,II)=L + II=II+1 + ISD(1,II)=LM + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L) + ISD(5,II)=L !! New full U-boundary cells proportional to cell x-sizes. JGLi01Apr2011 !! Updated for any 2**n sizes -! ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ISD(6,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) - ENDIF +! ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(6,II)=-INT( LOG(FLOAT(ICE(3, L)))/LOG(2.) + 0.01 ) + ENDIF !! Half cell size west boundary faces - IF(ij .gt. 0 .and. ij .lt. ICE(4,L) ) THEN - IF( i .eq. 0 ) THEN + IF(ij .gt. 0 .and. ij .lt. ICE(4,L) ) THEN + IF( i .eq. 0 ) THEN !! lower half west cell face - II=II+1 - ISD(1,II)=ICE(1,L) - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=ICE(1,L) + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L)/2 !! Updated for any 2**n sizes - ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) !! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2 - ISD(6,II)=L - ENDIF - IF( j .eq. 0 ) THEN + ISD(6,II)=L + ENDIF + IF( j .eq. 0 ) THEN !! Upper half west cell face - II=II+1 - ISD(1,II)=ICE(1,L) - ISD(2,II)=ICE(2,L)+ICE(4,L)/2 - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=ICE(1,L) + ISD(2,II)=ICE(2,L)+ICE(4,L)/2 + ISD(3,II)=ICE(4,L)/2 !! Updated for any 2**n sizes - ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ISD(6,II)=L - ENDIF - ENDIF + ISD(5,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ISD(6,II)=L + ENDIF + ENDIF !! Half cell size east boundary faces - IF(kk .gt. 0 .and. kk .lt. ICE(4,L) ) THEN - IF( k .eq. 0 ) THEN + IF(kk .gt. 0 .and. kk .lt. ICE(4,L) ) THEN + IF( k .eq. 0 ) THEN !! lower half east cell face - II=II+1 - ISD(1,II)=LM - ISD(2,II)=ICE(2,L) - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=LM + ISD(2,II)=ICE(2,L) + ISD(3,II)=ICE(4,L)/2 !! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2 - ISD(5,II)=L + ISD(5,II)=L !! Updated for any 2**n sizes - ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ENDIF - IF( n .eq. 0 ) THEN + ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ENDIF + IF( n .eq. 0 ) THEN !! Upper half west cell face - II=II+1 - ISD(1,II)=LM - ISD(2,II)=ICE(2,L)+ICE(4,L)/2 - ISD(3,II)=ICE(4,L)/2 + II=II+1 + ISD(1,II)=LM + ISD(2,II)=ICE(2,L)+ICE(4,L)/2 + ISD(3,II)=ICE(4,L)/2 !! Size 1 for cell 0, size 2 uses cell -1 and size 4 uses cell -2 - ISD(5,II)=L + ISD(5,II)=L !! Updated for any 2**n sizes - ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) - ENDIF - ENDIF - - 111 CONTINUE - + ISD(6,II)=-INT( LOG(FLOAT(ISD(3,II)))/LOG(2.) + 0.01 ) + ENDIF + ENDIF + ENDDO ! Set boundary v faces WRITE(6,*) " Start creating v boundary face II JJ=", II, JJ !! Exclude the last polar cell -! DO 222 L=1, NC-1 +! DO L=1, NC-1 !! Loop over all cells - DO 222 L=1, NC + DO L=1, NC i=0 j=0 ij=0 @@ -359,28 +357,28 @@ SUBROUTINE CellSide END DO IF(nn+ij .gt. 2*ICE(3,L) ) WRITE(6,*) "Over done j-side for L, ij, nn=", L, ij, nn - IF(nn+ij .ge. 2*ICE(3,L) ) GOTO 222 + IF(nn+ij .ge. 2*ICE(3,L) ) CYCLE - IF(ij .eq. 0) THEN + IF(ij .eq. 0) THEN !! Full boundary cell for south side - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L) - JSD(2,JJ)=ICE(2,L) - JSD(3,JJ)=ICE(3,L) + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L) + JSD(2,JJ)=ICE(2,L) + JSD(3,JJ)=ICE(3,L) !! New boundary cells proportional to cell sizes !! Updated for any 2**n sizes - JSD(5,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) - JSD(6,JJ)=L - JSD(8,JJ)=ICE(4,L) + JSD(5,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) + JSD(6,JJ)=L + JSD(8,JJ)=ICE(4,L) !! No cells over Antarctic land so there is no S Polar cell. - ENDIF - IF(nn .eq. 0) THEN + ENDIF + IF(nn .eq. 0) THEN !! Full boundary cell for north side - JJ=JJ+1 - JSD(1,JJ)=ICE(1,L) - JSD(2,JJ)=ICE(2,L)+ICE(4,L) - JSD(3,JJ)=ICE(3,L) - JSD(5,JJ)=L + JJ=JJ+1 + JSD(1,JJ)=ICE(1,L) + JSD(2,JJ)=ICE(2,L)+ICE(4,L) + JSD(3,JJ)=ICE(3,L) + JSD(5,JJ)=L !! North polar cell takes the whole last 4 rows above JSD=ICE(2,NC). !! Note ICE(2,L) represents lower-side of the cell. Polar cell is the last cell NC. ! IF( ICE(2,L)+ICE(4,L) .eq. ICE(2,NC) ) THEN @@ -388,14 +386,14 @@ SUBROUTINE CellSide ! WRITE(6,*) "Set north pole v face for cell L", L ! ELSE !! Updated for any 2**n sizes - JSD(6,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) + JSD(6,JJ)=-INT( LOG(FLOAT(ICE(3,L)))/LOG(2.) + 0.01 ) ! ENDIF - JSD(8,JJ)=ICE(4,L) - ENDIF + JSD(8,JJ)=ICE(4,L) + ENDIF !! Half cell size south boundary faces - IF(ij .gt. 0 .and. ij .lt. ICE(3,L) ) THEN - IF( i .eq. 0 ) THEN + IF(ij .gt. 0 .and. ij .lt. ICE(3,L) ) THEN + IF( i .eq. 0 ) THEN !! left half cell face JJ=JJ+1 JSD(1,JJ)=ICE(1,L) @@ -406,8 +404,8 @@ SUBROUTINE CellSide JSD(5,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) JSD(6,JJ)=L JSD(8,JJ)=ICE(4,L) - ENDIF - IF( j .eq. 0 ) THEN + ENDIF + IF( j .eq. 0 ) THEN !! right half cell face JJ=JJ+1 JSD(1,JJ)=ICE(1,L)+ICE(3,L)/2 @@ -418,12 +416,12 @@ SUBROUTINE CellSide JSD(5,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) JSD(6,JJ)=L JSD(8,JJ)=ICE(4,L) - ENDIF - ENDIF + ENDIF + ENDIF !! Half cell size north boundary faces - IF(nn .gt. 0 .and. nn .lt. ICE(3,L) ) THEN - IF( k .eq. 0 ) THEN + IF(nn .gt. 0 .and. nn .lt. ICE(3,L) ) THEN + IF( k .eq. 0 ) THEN !! left half north cell face JJ=JJ+1 JSD(1,JJ)=ICE(1,L) @@ -434,8 +432,8 @@ SUBROUTINE CellSide !! Updated for any 2**n sizes JSD(6,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) JSD(8,JJ)=ICE(4,L) - ENDIF - IF( n .eq. 0 ) THEN + ENDIF + IF( n .eq. 0 ) THEN !! right half north cell face JJ=JJ+1 JSD(1,JJ)=ICE(1,L)+ICE(3,L)/2 @@ -446,10 +444,9 @@ SUBROUTINE CellSide !! Updated for any 2**n sizes JSD(6,JJ)=-INT( LOG(FLOAT(JSD(3,JJ)))/LOG(2.) + 0.01 ) JSD(8,JJ)=ICE(4,L) - ENDIF - ENDIF - - 222 CONTINUE + ENDIF + ENDIF + ENDDO ! Store top level U V side numbers in NU NV NU=II @@ -632,9 +629,9 @@ SUBROUTINE CellSide PRINT*, ' I J-Sides output done ' - 999 PRINT*, ' Sub CellSide ended.' + PRINT*, ' Sub CellSide ended.' - RETURN + RETURN END SUBROUTINE CellSide diff --git a/smc_docs/SMCG_TKs/g50smcswhglb.pro b/smc_docs/SMCG_TKs/g50smcswhglb.pro index fc51d85027..8fcec3fefc 100644 --- a/smc_docs/SMCG_TKs/g50smcswhglb.pro +++ b/smc_docs/SMCG_TKs/g50smcswhglb.pro @@ -323,7 +323,5 @@ status=dc_read_free(Wrkdir+'fdate',fdate) endfor endfor -;GOTO, FileAgain - END diff --git a/smc_docs/SMCG_TKs/g50smstrspb.pro b/smc_docs/SMCG_TKs/g50smstrspb.pro index c75ea71c11..1a27c95511 100644 --- a/smc_docs/SMCG_TKs/g50smstrspb.pro +++ b/smc_docs/SMCG_TKs/g50smstrspb.pro @@ -314,7 +314,5 @@ endfor -;GOTO, FileAgain - END diff --git a/smc_docs/SMCG_TKs/smc625swhGlb.pro b/smc_docs/SMCG_TKs/smc625swhGlb.pro index 47fc05abac..adf79c6d94 100644 --- a/smc_docs/SMCG_TKs/smc625swhGlb.pro +++ b/smc_docs/SMCG_TKs/smc625swhGlb.pro @@ -276,7 +276,5 @@ status=dc_read_free(Wrkdir+'fdate',fdate) endfor endfor -;GOTO, FileAgain - END From 6642299e178fb61600f8ea470715ebc53f3523f5 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 30 Sep 2025 14:53:09 -0400 Subject: [PATCH 101/136] temporarily disable CI testing until we have time to fix (#1499) --- .github/workflows/{gnu.yml => gnu.yml.tempdisable} | 0 .github/workflows/{intel.yml => intel.yml.tempdisable} | 0 .../workflows/{regtest_gnu.yml => regtest_gnu.yml.tempdisable} | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename .github/workflows/{gnu.yml => gnu.yml.tempdisable} (100%) rename .github/workflows/{intel.yml => intel.yml.tempdisable} (100%) rename .github/workflows/{regtest_gnu.yml => regtest_gnu.yml.tempdisable} (100%) diff --git a/.github/workflows/gnu.yml b/.github/workflows/gnu.yml.tempdisable similarity index 100% rename from .github/workflows/gnu.yml rename to .github/workflows/gnu.yml.tempdisable diff --git a/.github/workflows/intel.yml b/.github/workflows/intel.yml.tempdisable similarity index 100% rename from .github/workflows/intel.yml rename to .github/workflows/intel.yml.tempdisable diff --git a/.github/workflows/regtest_gnu.yml b/.github/workflows/regtest_gnu.yml.tempdisable similarity index 100% rename from .github/workflows/regtest_gnu.yml rename to .github/workflows/regtest_gnu.yml.tempdisable From e3b1f1c8aac30d6d11d94443de7a8111a2e06420 Mon Sep 17 00:00:00 2001 From: Saeideh Banihashemi <91982033+sbanihash@users.noreply.github.com> Date: Wed, 1 Oct 2025 05:47:13 -0700 Subject: [PATCH 102/136] Update grib2 outputs to have complex packing (#1496) --- model/src/ww3_grib.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/model/src/ww3_grib.F90 b/model/src/ww3_grib.F90 index 81a5208e0a..12b4391250 100644 --- a/model/src/ww3_grib.F90 +++ b/model/src/ww3_grib.F90 @@ -734,10 +734,11 @@ PROGRAM W3GRIB ! ... Set GRIB2 Data Representation Template Number (Code Table 5.0) ! #ifdef W3_NCEP2 - IDRSNUM = 40 !jpeg2000 *** SEGFAULTS in some linux + IDRSNUM = 2 !Complex Packing #endif ! clusters with Intel compiler *** #ifdef W3_NCEP2 + !IDRSNUM = 40 !jpeg2000 *** SEGFAULTS in some linux !IDRSNUM = 0 !simple packing !IDRSNUM = 41 !png packing !IDRSNUM = 2 !Complex Packing (Grid Point Data) From 91c6fcc4721c439d5d25dcabdfce3e8c067e2403 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Tue, 7 Oct 2025 15:59:06 -0400 Subject: [PATCH 103/136] fix warnings when building in debug mode and debug errors for ww3_grib, ww3_gint and ww3_outp (#1504) --- model/src/PDLIB/yowfunction.F90 | 1 + model/src/PDLIB/yowpdlibmain.F90 | 2 +- model/src/w3arrymd.F90 | 8 ++++---- model/src/w3profsmd.F90 | 6 ++++++ model/src/w3strkmd.F90 | 2 ++ model/src/ww3_bounc.F90 | 1 + model/src/ww3_gint.F90 | 4 ++++ model/src/ww3_grib.F90 | 5 ++++- model/src/ww3_outp.F90 | 4 ++-- model/src/ww3_prnc.F90 | 2 ++ model/src/ww3_systrk.F90 | 1 + 11 files changed, 28 insertions(+), 8 deletions(-) diff --git a/model/src/PDLIB/yowfunction.F90 b/model/src/PDLIB/yowfunction.F90 index 46971c5557..5ac608a53c 100644 --- a/model/src/PDLIB/yowfunction.F90 +++ b/model/src/PDLIB/yowfunction.F90 @@ -46,6 +46,7 @@ module yowfunction !********************************************************************** SUBROUTINE PDLIB_ABORT(istat) IMPLICIT NONE + external :: ABORT integer, intent(in) :: istat Print *, 'Error with istat=', istat CALL ABORT diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index 7bc9293524..6c9ea9c974 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -438,7 +438,7 @@ subroutine runParmetis(MNP) integer :: IP_glob, itmp integer :: ref logical :: lexist = .false. - + external :: SCOTCH_PARMETIS_V3_PARTGEOMKWAY ! Node to domain mapping. ! np_global long. give the domain number for die global node number integer, allocatable :: node2domain(:) diff --git a/model/src/w3arrymd.F90 b/model/src/w3arrymd.F90 index 7c810ed08e..b6a983db5c 100644 --- a/model/src/w3arrymd.F90 +++ b/model/src/w3arrymd.F90 @@ -1173,7 +1173,7 @@ SUBROUTINE PRTBLK (NDS, NX, NY, MX, F, MAP, MAP0, FSC, & #endif REAL :: FMAX, RR LOGICAL :: FLSCLE - CHARACTER :: PNUM*5, STRA*5, PNUM2*2, STRA3*3 + CHARACTER :: PNUM*5, STRA*5, PNUM2*2, STRA3*9 DIMENSION :: PNUM(25), PNUM2(61) !/ !/ ------------------------------------------------------------------- / @@ -1285,10 +1285,10 @@ SUBROUTINE PRTBLK (NDS, NX, NY, MX, F, MAP, MAP0, FSC, & JM = 0 DO IY = IY2, IY1, IY3*(-1) IF (JM.EQ.0) THEN - WRITE (STRA3, FMT='(I3)') IY + WRITE (STRA3, FMT='(I9)') IY JM = 2 ELSE - STRA3 = ' ' + STRA3 = ' ' JM = JM-1 END IF ! @@ -1309,7 +1309,7 @@ SUBROUTINE PRTBLK (NDS, NX, NY, MX, F, MAP, MAP0, FSC, & WRITE (NDS,920) STRA3, ' |', (PNUM(I), I=1, LX), ' | ' END DO ! - STRA3 = ' ' + STRA3 = ' ' PNUM(1) = '-----' WRITE (NDS,920) STRA3, ' +', (PNUM(1), I=1, LX), '-+ ' WRITE (NDS,922) (IX,IX=IX1,IX2,IX3) diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 17350959ab..c778c1f08f 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -1106,6 +1106,7 @@ SUBROUTINE W3XYPFSNIMP ( ISP, C, LCALC, RD10, RD20, DT, AC) REAL*8 :: INIU(NX) external bcgstab + external :: ILU0, RUNRC POS_TRICK(1,1) = 2 POS_TRICK(1,2) = 3 @@ -2088,6 +2089,7 @@ subroutine bcgstab(n, rhs, sol, ipar, fpar, w) real*8 ddot logical stopbis, brkdn external ddot, stopbis, brkdn + external :: bisinit, tidycg ! real*8 one parameter(one=1.0D0) @@ -3786,6 +3788,7 @@ subroutine runrc(n,rhs,sol,ipar,fpar,wk,guess,a,ja,ia,au,jau,ju,solver) integer n,ipar(16),ia(n+1),ja(*),ju(*),jau(*) real*8 fpar(16),rhs(n),sol(n),guess(n),wk(*),a(*),au(*) external solver + external :: amux, atmux, lusol, lutsol !----------------------------------------------------------------------- ! the actual tester. It starts the iterative linear system solvers ! with a initial guess suppied by the user. @@ -3869,6 +3872,7 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) integer n real*8 a(*),alu(*),w(n+1),droptol integer ja(*),ia(n+1),jlu(*),ju(n),jw(2*n),lfil,iwk,ierr + external :: qsplit !----------------------------------------------------------------------* ! *** ILUT preconditioner *** * ! incomplete LU factorization with dual truncation mechanism * @@ -4293,6 +4297,8 @@ subroutine pgmres(n, im, rhs, sol, eps, maxits, aspar, nnz, ia, ja, alu, jlu, ju real*8 :: hh(im+1,im), c(im), s(im), rs(im+1) real*8 :: iw(n) + external :: amux, lusol, daxpy + logical :: lblas = .false. ! use sparskit matvec and external blas libs (true), don't use them (false) logical :: lilu = .true. ! use simple ilu preconditioner diff --git a/model/src/w3strkmd.F90 b/model/src/w3strkmd.F90 index e4a887e4cc..e866d40230 100644 --- a/model/src/w3strkmd.F90 +++ b/model/src/w3strkmd.F90 @@ -5742,6 +5742,7 @@ RECURSIVE SUBROUTINE QSORT(ARRAY,IDX,LO,HI) !/ ! Local variables ! ---------------------------------------------------------------- + EXTERNAL :: ABORT LOGICAL :: LOOP INTEGER :: TOP, BOT REAL :: VAL, TMP @@ -5867,6 +5868,7 @@ RECURSIVE SUBROUTINE QSORT_DESC(ARRAY,IDX,LO,HI) !/ ! Local variables ! ---------------------------------------------------------------- + EXTERNAL :: ABORT INTEGER :: TOP, BOT, I REAL :: VAL, TMP LOGICAL :: LOOP diff --git a/model/src/ww3_bounc.F90 b/model/src/ww3_bounc.F90 index a916a908c7..5791f074b9 100644 --- a/model/src/ww3_bounc.F90 +++ b/model/src/ww3_bounc.F90 @@ -165,6 +165,7 @@ PROGRAM W3BOUNC !/ ------------------------------------------------------------------- / !/ Local parameters !/ + EXTERNAL :: CHECK_ERR TYPE(NML_BOUND_T) :: NML_BOUND ! diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index bf4d9f743b..6eeda59bf2 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -1299,6 +1299,10 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & MAPLND = 0 ACTIVE = .TRUE. MAPSTA(IY,IX) = ABS ( MAPSTA(IY,IX) ) + MAPICET = 0 + MAPDRYT = 0 + MAPLNDT = 0 + MAPMSKT = 0 SUMGRD = 0 DO IG = 1,GR_INTS(ISEA)%NGRDS IGRID = GR_INTS(ISEA)%GDID(IG) diff --git a/model/src/ww3_grib.F90 b/model/src/ww3_grib.F90 index 12b4391250..71f342b990 100644 --- a/model/src/ww3_grib.F90 +++ b/model/src/ww3_grib.F90 @@ -163,6 +163,9 @@ PROGRAM W3GRIB !/ ------------------------------------------------------------------- / !/ Local variables !/ + EXTERNAL :: BAOPENW + EXTERNAL :: GRIBCREATE, ADDGRID, ADDFIELD, GRIBEND, WRYTE + EXTERNAL :: BAOPEN, PUTGB INTEGER :: NDSI, NDSM, NDSOG, NDSDAT, NDSTRC, & NTRACE, IERR, IOTEST, I,J,K, IFI,IFJ,& ISEA, IX, IY, TOUT(2), NOUT, TDUM(2),& @@ -221,6 +224,7 @@ PROGRAM W3GRIB ! NDSTRC = 6 NTRACE = 10 + WORDS = '' ! #ifdef W3_NCO ! @@ -278,7 +282,6 @@ PROGRAM W3GRIB READ (NDSI,'(A)') LINEIN WRITE(NDSO,*)' LINEIN: ',LINEIN READ(LINEIN,*,iostat=ierr) WORDS - WRITE (NDSO,*) WORDS READ(WORDS( 1 ), * ) TOUT(1) READ(WORDS( 2 ), * ) TOUT(2) READ(WORDS( 3 ), * ) DTREQ diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index db51ed48bc..d4397a2cd0 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -1044,7 +1044,7 @@ PROGRAM W3OUTP 948 FORMAT ( ' Data for ',A) 949 FORMAT (/' End of file reached '/) ! -950 FORMAT (/' Requested output for',I3,' points : '/ & +950 FORMAT (/' Requested output for',I9,' points : '/ & ' --------------------------------------------------') 951 FORMAT ( ' ',A,2F10.2) 953 FORMAT ( ' ',A,2(F8.1,'E3')) @@ -2996,7 +2996,7 @@ SUBROUTINE W3EXPO 9000 FORMAT (' TEST W3EXPO : FLAGS :',40L2) 9001 FORMAT (' TEST W3EXPO : ITPYE :',I4/ & ' OTPYE :',I4/ & - ' NREQ :',I4/ & + ' NREQ :',I9/ & ' SCALE1 :',E10.3/ & ' SCALE2 :',E10.3/ & ' FLSRCE :',7L2) diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index 922e6a1e54..9a8d9a9948 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -237,6 +237,8 @@ PROGRAM W3PRNC !/ ------------------------------------------------------------------- / !/ Local parameters !/ + EXTERNAL :: CHECK_ERROR + EXTERNAL :: INTERP TYPE(NML_FORCING_T) :: NML_FORCING TYPE(NML_FILE_T) :: NML_FILE TYPE(T_GSU) :: GSI diff --git a/model/src/ww3_systrk.F90 b/model/src/ww3_systrk.F90 index cb25a1e721..2766b67262 100644 --- a/model/src/ww3_systrk.F90 +++ b/model/src/ww3_systrk.F90 @@ -78,6 +78,7 @@ PROGRAM WW3_SYSTRK ! ! 3. Parameters : ! + EXTERNAL :: ABORT LOGICAL :: testout PARAMETER (testout = .FALSE.) CHARACTER :: filename*80, paramFile*32 From 937ececb2ad2c3137d3833de0bd54d34f27f9644 Mon Sep 17 00:00:00 2001 From: Alain Coat <97431609+alcoat@users.noreply.github.com> Date: Thu, 9 Oct 2025 20:53:53 +0200 Subject: [PATCH 104/136] Fix missing comma (#1503) --- model/src/w3gridmd.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 30eb951f0a..ed8929a8c2 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -6342,7 +6342,7 @@ SUBROUTINE W3GRID() 2922 FORMAT ( ' &SNL1 LAMBDA =',F7.3,', NLPROP =',E10.3, & ', KDCONV =',F7.3,', KDMIN =',F7.3,','/ & ' SNLCS1 =',F7.3,', SNLCS2 =',F7.3, & - ', SNLCS3 = ',F7.3','/ & + ', SNLCS3 = ',F7.3,','/ & ' IQTYPE =',I2,', TAILNL =',F5.1,','/ & ' GQMNF1 =',I2,', GQMNT1 =',I2,',', & ' GQMNQ_OM2 =',I2,', GQMTHRSAT =',E11.4,', GQMTHRCOU =',F4.3,','/ & From 238cd4103a88b0900a66ac44d6087937119a343d Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Thu, 16 Oct 2025 09:57:59 -0400 Subject: [PATCH 105/136] Update include mpif.h to use mpif08 (#1498) Co-authored-by: Nick Szapiro Co-authored-by: mingchen-NOAA --- model/src/PDLIB/yowdatapool.F90 | 11 +- model/src/PDLIB/yowerr.F90 | 6 +- model/src/PDLIB/yowexchangeModule.F90 | 70 +++++++----- model/src/PDLIB/yowfunction.F90 | 4 +- model/src/PDLIB/yowpdlibmain.F90 | 28 +++-- model/src/PDLIB/yowrankModule.F90 | 6 +- model/src/SCRIP/scrip_remap_conservative.F | 4 +- model/src/pdlib_field_vec.F90 | 6 +- model/src/w3adatmd.F90 | 20 ++-- model/src/w3agcmmd.F90 | 6 +- model/src/w3fldsmd.F90 | 3 +- model/src/w3gsrumd.F90 | 2 +- model/src/w3igcmmd.F90 | 6 +- model/src/w3initmd.F90 | 25 +++-- model/src/w3iogrmd.F90 | 2 +- model/src/w3iopomd.F90 | 22 ++-- model/src/w3iorsmd.F90 | 22 ++-- model/src/w3iosfmd.F90 | 10 +- model/src/w3iotrmd.F90 | 14 +-- model/src/w3nmlmultimd.F90 | 24 +++- model/src/w3nmlshelmd.F90 | 12 +- model/src/w3oacpmd.F90 | 16 ++- model/src/w3odatmd.F90 | 27 +++-- model/src/w3ogcmmd.F90 | 6 +- model/src/w3parall.F90 | 16 +-- model/src/w3profsmd_pdlib.F90 | 24 ++-- model/src/w3psmcmd.F90 | 39 ++++--- model/src/w3servmd.F90 | 6 +- model/src/w3strkmd.F90 | 60 +++++----- model/src/w3wavemd.F90 | 49 ++++----- model/src/w3wavset.F90 | 4 +- model/src/w3wdasmd.F90 | 6 +- model/src/wmesmfmd.F90 | 6 +- model/src/wmfinlmd.F90 | 6 +- model/src/wmgridmd.F90 | 26 +++-- model/src/wminiomd.F90 | 122 +++++++++++---------- model/src/wminitmd.F90 | 60 ++++++---- model/src/wmiopomd.F90 | 18 +-- model/src/wmmdatmd.F90 | 29 ++--- model/src/wmwavemd.F90 | 30 ++--- model/src/ww3_bounc.F90 | 7 +- model/src/ww3_bound.F90 | 6 +- model/src/ww3_multi.F90 | 31 +++--- model/src/ww3_ounp.F90 | 6 +- model/src/ww3_prnc.F90 | 7 +- model/src/ww3_prtide.F90 | 6 +- model/src/ww3_sbs1.F90 | 24 ++-- model/src/ww3_shel.F90 | 119 +++++++++----------- model/src/ww3_strt.F90 | 6 +- model/src/ww3_systrk.F90 | 5 +- 50 files changed, 577 insertions(+), 493 deletions(-) diff --git a/model/src/PDLIB/yowdatapool.F90 b/model/src/PDLIB/yowdatapool.F90 index 24ae181621..f1ec36698b 100644 --- a/model/src/PDLIB/yowdatapool.F90 +++ b/model/src/PDLIB/yowdatapool.F90 @@ -37,7 +37,8 @@ ! !> Has fancy data module yowDatapool - use MPI, only: MPI_COMM_WORLD, MPI_INTEGER, MPI_REAL4, MPI_REAL8, MPI_STATUS_SIZE + use mpi_f08, only: MPI_COMM_WORLD, MPI_INTEGER, MPI_REAL4, MPI_REAL8, & + MPI_COMM, MPI_STATUS, MPI_Datatype implicit none !#ifdef USE_SINGLE ! !> single precision. Enable with compiler flag -DUSE_SINGLE @@ -63,17 +64,17 @@ module yowDatapool !> MPI Communicator. !> Should be MPI_COMM_WORLD. If pdlib is run into a existing MPI enviroment, comm is set to a new communicator - integer,public,save :: comm + type(MPI_COMM),public,save :: comm !> MPI Integer Type. !> Should be MPI_INTEGER - integer,save :: itype = MPI_INTEGER + type(MPI_Datatype),save :: itype = MPI_INTEGER !> MPI Real Type !> Shpuld be MPI_REAL8 - integer :: istatus(MPI_STATUS_SIZE) + type(MPI_STATUS) :: istatus !#ifdef USE_SINGLE - integer, save :: rtype = MPI_REAL4 + type(MPI_Datatype), save :: rtype = MPI_REAL4 !#else ! integer, save :: rtype = MPI_REAL8 !#endif diff --git a/model/src/PDLIB/yowerr.F90 b/model/src/PDLIB/yowerr.F90 index 57e5c06759..c4c3376fd8 100644 --- a/model/src/PDLIB/yowerr.F90 +++ b/model/src/PDLIB/yowerr.F90 @@ -41,7 +41,7 @@ module yowerr contains subroutine parallel_abort(string, error) use yowDatapool, only: comm - use MPI + use mpi_f08 implicit none character(*),optional,intent(in) :: string !string to print @@ -91,7 +91,7 @@ end subroutine parallel_abort !> \param[in] errno The MPI error number which is translated into an error string subroutine abort(string, line, file, errno) use yowDatapool, only: comm - use MPI + use mpi_f08 implicit none ! Errorstring to print character(*), optional, intent(in) :: string @@ -167,7 +167,7 @@ end subroutine abort !> \param[in] file Filename subroutine warn(string, line, file) use yowDatapool, only: comm - use MPI + use mpi_f08 implicit none ! Errorstring to print character(*), optional, intent(in) :: string diff --git a/model/src/PDLIB/yowexchangeModule.F90 b/model/src/PDLIB/yowexchangeModule.F90 index 64a37bd541..630270d155 100644 --- a/model/src/PDLIB/yowexchangeModule.F90 +++ b/model/src/PDLIB/yowexchangeModule.F90 @@ -38,7 +38,7 @@ !> Has only the ghost nodes assign to a neighbor domain module yowExchangeModule use yowDatapool, only: rkind - use MPI, only: MPI_DATATYPE_NULL + use mpi_f08, only: MPI_INTEGER, MPI_Datatype, MPI_DATATYPE_NULL implicit none private public :: initNbrDomains, createMPITypes, setDimSize @@ -72,22 +72,22 @@ module yowExchangeModule ! MPI datatypes for size(U) == npa+1 U(0:npa) !> MPI datatypes for 1D exchange - integer :: p1DRsendType_zero = MPI_DATATYPE_NULL - integer :: p1DRrecvType_zero = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p1DRsendType_zero = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p1DRrecvType_zero = MPI_DATATYPE_NULL !> MPI datatypes for 2D exchange - integer :: p2DRsendType_zero = MPI_DATATYPE_NULL - integer :: p2DRrecvType_zero = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p2DRsendType_zero = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p2DRrecvType_zero = MPI_DATATYPE_NULL ! MPI datatypes for size(U) == npa U(1:npa) !> MPI datatypes for 1D exchange - integer :: p1DRsendType = MPI_DATATYPE_NULL - integer :: p1DRrecvType = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p1DRsendType = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p1DRrecvType = MPI_DATATYPE_NULL !> MPI datatypes for 2D exchange - integer :: p2DRsendType1 = MPI_DATATYPE_NULL - integer :: p2DRrecvType1 = MPI_DATATYPE_NULL - integer :: p2DRsendType2 = MPI_DATATYPE_NULL - integer :: p2DRrecvType2 = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p2DRsendType1 = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p2DRrecvType1 = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p2DRsendType2 = MPI_DATATYPE_NULL + type(MPI_Datatype) :: p2DRrecvType2 = MPI_DATATYPE_NULL contains ! procedure :: exchangeGhostIds @@ -116,7 +116,7 @@ module yowExchangeModule subroutine finalize(this) use yowerr - use MPI + use mpi_f08 implicit none class(t_neighborDomain), intent(inout) :: this integer :: ierr @@ -149,7 +149,7 @@ end subroutine finalize ! create MPI indexed datatype for this neighborDomain subroutine createMPIType(this) use yowerr - use MPI + use mpi_f08 use yowNodepool, only: ghostgl, np, ipgl use yowDatapool, only: rtype, itype implicit none @@ -251,13 +251,13 @@ subroutine PDLIB_exchange1Dreal(U) use yowDatapool, only: comm, myrank, rkind use yowNodepool, only: t_Node, nodes_global, np, ng, ghosts, npa use yowerr - use MPI + use mpi_f08 implicit none - real(kind=rkind), intent(inout) :: U(:) + real(kind=rkind), intent(inout) :: U(npa) integer :: i, ierr, tag - integer :: sendRqst(nConnDomains), recvRqst(nConnDomains) - integer :: recvStat(MPI_STATUS_SIZE, nConnDomains), sendStat(MPI_STATUS_SIZE, nConnDomains) + type(MPI_REQUEST) :: sendRqst(nConnDomains), recvRqst(nConnDomains) + type(MPI_STATUS) :: recvStat(nConnDomains), sendStat(nConnDomains) character(len=140) :: errmsg if(size(U) /= npa) then @@ -292,6 +292,7 @@ subroutine PDLIB_exchange1Dreal(U) if(ierr/=MPI_SUCCESS) CALL PARALLEL_ABORT("waitall", ierr) call mpi_waitall(nConnDomains, sendRqst, sendStat,ierr) if(ierr/=MPI_SUCCESS) CALL PARALLEL_ABORT("waitall", ierr) + end subroutine PDLIB_exchange1Dreal @@ -303,14 +304,16 @@ subroutine PDLIB_exchange2Dreal(U) use yowDatapool, only: comm, myrank, rkind use yowNodepool, only: t_Node, nodes_global, np, ng, ghosts, npa use yowerr - use MPI + use mpi_f08 USE W3ODATMD, only : IAPROC implicit none real(kind=rkind), intent(inout) :: U(:,:) - integer :: i, ierr, tag - integer :: sendRqst(nConnDomains), recvRqst(nConnDomains) - integer :: recvStat(MPI_STATUS_SIZE, nConnDomains), sendStat(MPI_STATUS_SIZE, nConnDomains) + real(kind=rkind), allocatable :: Ub_send(:,:), Ub_recv(:,:) + + integer :: i, ierr, tag, istat + type(MPI_REQUEST) :: sendRqst(nConnDomains), recvRqst(nConnDomains) + type(MPI_STATUS) :: recvStat(nConnDomains), sendStat(nConnDomains) #ifdef W3_DEBUGEXCH @@ -318,6 +321,11 @@ subroutine PDLIB_exchange2Dreal(U) FLUSH(740+IAPROC) #endif + allocate(Ub_send(size(U,1), size(U,2))) + allocate(Ub_recv(size(U,1), size(U,2))) + Ub_send = U + Ub_recv = U + ! post receives #ifdef W3_DEBUGEXCH WRITE(740+IAPROC,*) 'PDLIB_exchange2Dreal, step 4' @@ -325,7 +333,7 @@ subroutine PDLIB_exchange2Dreal(U) #endif do i=1, nConnDomains tag = 30000 + myrank - call MPI_IRecv(U, 1, neighborDomains(i)%p2DRrecvType1, & + call MPI_IRecv(Ub_recv, 1, neighborDomains(i)%p2DRrecvType1, & neighborDomains(i)%domainID-1, tag, comm, & recvRqst(i), ierr) if(ierr/=MPI_SUCCESS) then @@ -340,7 +348,7 @@ subroutine PDLIB_exchange2Dreal(U) ! post sends do i=1, nConnDomains tag = 30000 + (neighborDomains(i)%domainID-1) - call MPI_ISend(U, 1, neighborDomains(i)%p2DRsendType1, & + call MPI_ISend(Ub_send, 1, neighborDomains(i)%p2DRsendType1, & neighborDomains(i)%domainID-1, tag, comm, & sendRqst(i), ierr) if(ierr/=MPI_SUCCESS) then @@ -365,6 +373,10 @@ subroutine PDLIB_exchange2Dreal(U) WRITE(740+IAPROC,*) 'PDLIB_exchange2Dreal, step 12' FLUSH(740+IAPROC) #endif + + U = Ub_recv + deallocate(Ub_send, Ub_recv, stat=istat) + end subroutine PDLIB_exchange2Dreal @@ -398,13 +410,13 @@ subroutine PDLIB_exchange1Dreal_zero(U) use yowDatapool, only: comm, myrank, rkind use yowNodepool, only: npa use yowErr - use Mpi + use mpi_f08 implicit none real(kind=rkind), intent(inout) :: U(0:npa) integer :: i, ierr, tag - integer :: sendRqst(nConnDomains), recvRqst(nConnDomains) - integer :: recvStat(MPI_STATUS_SIZE, nConnDomains), sendStat(MPI_STATUS_SIZE, nConnDomains) + type(MPI_REQUEST) :: sendRqst(nConnDomains), recvRqst(nConnDomains) + type(MPI_STATUS) :: recvStat(nConnDomains), sendStat(nConnDomains) character(len=200) errstr ! It is impossible to add these range checks because assumed shape array start vom 1:npa+1 even if you allocate it from 0:npa @@ -468,13 +480,13 @@ subroutine PDLIB_exchange2Dreal_zero(U) use yowDatapool, only: comm, myrank, rkind use yowNodepool, only: npa use yowErr - use Mpi + use mpi_f08 implicit none real(kind=rkind), intent(inout) :: U(n2ndDim,0:npa) integer :: i, ierr, tag - integer :: sendRqst(nConnDomains), recvRqst(nConnDomains) - integer :: recvStat(MPI_STATUS_SIZE, nConnDomains), sendStat(MPI_STATUS_SIZE, nConnDomains) + type(MPI_REQUEST) :: sendRqst(nConnDomains), recvRqst(nConnDomains) + type(MPI_STATUS) :: recvStat(nConnDomains), sendStat(nConnDomains) character(len=200) errstr ! It is impossible to add these range checks because assumed shape array start vom 1:npa+1 even if you allocate it from 0:npa diff --git a/model/src/PDLIB/yowfunction.F90 b/model/src/PDLIB/yowfunction.F90 index 5ac608a53c..5e30f776e4 100644 --- a/model/src/PDLIB/yowfunction.F90 +++ b/model/src/PDLIB/yowfunction.F90 @@ -60,8 +60,8 @@ SUBROUTINE ComputeListNP_ListNPA_ListIPLG_Kernel USE yowDatapool, only: rtype, istatus USE yowNodepool, only: npa, np, iplg USE yowNodepool, only: ListNP, ListNPA, ListIPLG + use mpi_f08 IMPLICIT NONE - INCLUDE "mpif.h" integer IPROC, idx, IP, len, istat, sumNP, ierr integer, allocatable :: iVect(:) ! @@ -198,8 +198,8 @@ SUBROUTINE ComputeListNP_ListNPA_ListIPLG USE yowDatapool, only: rtype, istatus USE yowNodepool, only: npa, np, iplg USE yowNodepool, only: ListNP, ListNPA, ListIPLG + use mpi_f08 IMPLICIT NONE - INCLUDE "mpif.h" INTEGER sumNP, iProc, ierr, istat #ifdef W3_DEBUGINIT WRITE(740+IAPROC,*) 'Before ComputeListNP_ListNPA_Kernel' diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index 6c9ea9c974..8deb109077 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -63,6 +63,7 @@ module yowpdlibMain !> @param[in] MPIComm MPI communicator to use with pdlib !> @overload initPD1 subroutine initFromGridDim(MNP, MNE, INE_global, secDim, MPIcomm) + use mpi_f08, only: MPI_COMM use yowDatapool, only: myrank, debugPrePartition, debugPostPartition use yowNodepool, only: np_global, np, np_perProcSum, ng, ipgl, iplg, npa use yowElementpool, only: ne_global,ne @@ -73,7 +74,7 @@ subroutine initFromGridDim(MNP, MNE, INE_global, secDim, MPIcomm) integer, intent(in) :: MNP, MNE integer, intent(in) :: INE_global(3,MNE) integer, intent(in) :: secDim - integer, intent(in) :: MPIcomm + type(MPI_COMM), intent(in) :: MPIcomm integer :: istat, memunit ! note: myrank=0 until after initMPI is called, so only rank=0 file @@ -176,11 +177,11 @@ end subroutine initFromGridDim SUBROUTINE REAL_MPI_BARRIER_PDLIB(TheComm, string) - INCLUDE "mpif.h" - integer, intent(in) :: TheComm + use mpi_f08 + type(MPI_COMM), intent(in) :: TheComm character(*), intent(in) :: string integer NbProc, eRank - integer :: istatus(MPI_STATUS_SIZE) + type(MPI_STATUS) :: istatus integer ierr, iField(1), iProc ! Print *, 'Start of REAL_MPI_BARRIER_PDLIB' CALL MPI_COMM_RANK(TheComm, eRank, ierr) @@ -210,9 +211,9 @@ END SUBROUTINE REAL_MPI_BARRIER_PDLIB subroutine initMPI(MPIcomm) use yowDatapool, only: comm, nTasks, myrank use yowerr - use MPI + use mpi_f08 - integer, intent(in) :: MPIcomm + type(MPI_COMM), intent(in) :: MPIcomm logical :: flag integer :: ierr #ifdef W3_DEBUGINIT @@ -425,7 +426,7 @@ subroutine runParmetis(MNP) use yowSidepool, only: ns use yowElementpool, only: ne, ne_global use w3gdatmd, only: xgrd, ygrd - use MPI + use mpi_f08 integer, intent(in) :: MNP @@ -447,6 +448,8 @@ subroutine runParmetis(MNP) integer :: i, j, stat, ierr type(t_Node), pointer :: node, nodeNeighbor + INTEGER :: np_toSend + ! CALL REAL_MPI_BARRIER_PDLIB(comm, "runParmetis, step 1") ! Create xadj and adjncy arrays. They holds the nodes neighbors in CSR Format ! Here, the adjacency structure of a graph is represented by two arrays, @@ -575,7 +578,8 @@ subroutine runParmetis(MNP) allocate(vtxdist(nTasks+1),stat=stat) if(stat/=0) call parallel_abort('partition: vtxdist allocation failure') - call mpi_allgather(np_perProcSum(myrank)+1, 1, itype, vtxdist, 1, itype, comm, ierr) + np_toSend = np_perProcSum(myrank)+1 + call mpi_allgather(np_toSend, 1, itype, vtxdist, 1, itype, comm, ierr) if(ierr/=MPI_SUCCESS) call parallel_abort('partition: mpi_allgather',ierr) vtxdist(nTasks+1)=np_global+1 ! CALL REAL_MPI_BARRIER_PDLIB(comm, "runParmetis, step 7") @@ -1063,7 +1067,7 @@ subroutine exchangeGhostIds use yowNodepool, only: np, t_node, nodes use yowDatapool, only: nTasks, myrank, comm use yowExchangeModule, only: neighborDomains, nConnDomains, createMPITypes - use MPI + use mpi_f08 integer :: i, j, k integer :: ierr @@ -1071,11 +1075,11 @@ subroutine exchangeGhostIds integer :: tag ! we use non-blocking send and recv subroutines ! store the send status - integer :: sendRequest(nConnDomains) + type(MPI_REQUEST) :: sendRequest(nConnDomains) ! store the revc status - integer :: recvRequest(nConnDomains) + type(MPI_REQUEST) :: recvRequest(nConnDomains) ! status to verify if one communication fails or not - integer :: status(MPI_STATUS_SIZE, nConnDomains); + type(MPI_STATUS) :: status(nConnDomains); type(t_node), pointer :: node diff --git a/model/src/PDLIB/yowrankModule.F90 b/model/src/PDLIB/yowrankModule.F90 index 62c2341f56..8674ae6e3b 100644 --- a/model/src/PDLIB/yowrankModule.F90 +++ b/model/src/PDLIB/yowrankModule.F90 @@ -90,11 +90,11 @@ end subroutine initRankModule subroutine exchangeIPLG() use yowNodepool, only: np, npa, iplg, np_global use yowDatapool, only: nTasks, myrank, comm, itype - use MPI + use mpi_f08 implicit none integer :: i, ierr, stat - integer :: sendRqst(nTasks), recvRqst(nTasks) - integer :: recvStat(MPI_STATUS_SIZE, nTasks), sendStat(MPI_STATUS_SIZE, nTasks) + type(MPI_REQUEST) :: sendRqst(nTasks), recvRqst(nTasks) + type(MPI_STATUS) :: recvStat(nTasks), sendStat(nTasks) integer IPglob, J, istat ! step1 exchange np diff --git a/model/src/SCRIP/scrip_remap_conservative.F b/model/src/SCRIP/scrip_remap_conservative.F index c45003ad91..72c4cfa439 100755 --- a/model/src/SCRIP/scrip_remap_conservative.F +++ b/model/src/SCRIP/scrip_remap_conservative.F @@ -255,7 +255,7 @@ subroutine remap_conserv(l_master, l_test) #ifdef W3_SCRIPMPI USE WMMDATMD, ONLY: MPI_COMM_GRD USE W3ODATMD, ONLY: IAPROC, NTPROC - INCLUDE "mpif.h" + use mpi_f08 #endif logical(SCRIP_Logical), intent(in) :: l_master ! Am I the master ! processor (do I/O)? @@ -271,7 +271,7 @@ subroutine remap_conserv(l_master, l_test) integer (SCRIP_i4) :: IERR_MPI, IPROC, ratio integer (SCRIP_i4) :: j, ij, add1, add2, got_weight integer (SCRIP_i4) :: nlink, min_link, max_link - integer (SCRIP_i4), dimension(MPI_STATUS_SIZE) :: status + type(MPI_STATUS) :: status integer (SCRIP_i4), dimension(:), allocatable :: Numlinks integer (SCRIP_i4), dimension(:), allocatable :: Asendi integer (SCRIP_i4), dimension(:), allocatable :: Arecv1 diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index d8fe242699..2450fcff69 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -454,8 +454,8 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) USE W3PARALL, ONLY: PRINT_MY_TIME #endif use yowNodepool, only: ListNP, ListNPA, ListIPLG + use mpi_f08 IMPLICIT NONE - INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -662,8 +662,8 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) USE W3PARALL, only : GET_JSEA_IBELONG USE W3WDATMD, ONLY : VA USE W3GDATMD, ONLY: NSEAL, NX, NY + use mpi_f08 IMPLICIT NONE - INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -845,10 +845,10 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC USE W3PARALL, ONLY: INIT_GET_ISEA use yowDatapool, only: istatus + use mpi_f08 !/ IMPLICIT NONE ! - INCLUDE "mpif.h" !/ !/ ------------------------------------------------------------------- / !/ Parameter list diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 2daee3609b..06576d1473 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -359,6 +359,9 @@ MODULE W3ADATMD !/ ------------------------------------------------------------------- / use w3servmd, only : print_memcheck +#ifdef W3_MPI + use mpi_f08, only : MPI_COMM, MPI_Request, MPI_Datatype +#endif ! module default implicit none @@ -545,9 +548,9 @@ MODULE W3ADATMD ! INTEGER, POINTER :: IAPPRO(:) #ifdef W3_MPI - INTEGER :: MPI_COMM_WAVE, MPI_COMM_WCMP, & - WW3_FIELD_VEC, WW3_SPEC_VEC, & - NRQSG1 = 0, NRQSG2, IBFLOC, ISPLOC, & + type(MPI_COMM) :: MPI_COMM_WAVE, MPI_COMM_WCMP + type(MPI_Datatype) :: WW3_FIELD_VEC, WW3_SPEC_VEC + INTEGER :: NRQSG1 = 0, NRQSG2, IBFLOC, ISPLOC, & NSPLOC #endif #ifdef W3_PDLIB @@ -555,7 +558,7 @@ MODULE W3ADATMD #endif #ifdef W3_MPI INTEGER :: BSTAT(MPIBUF), BISPL(MPIBUF) - INTEGER, POINTER :: IRQSG1(:,:), IRQSG2(:,:) + type(MPI_Request), POINTER :: IRQSG1(:,:), IRQSG2(:,:) REAL, POINTER :: GSTORE(:,:), SSTORE(:,:) #endif REAL, POINTER :: SPPNT(:,:,:) @@ -673,12 +676,11 @@ MODULE W3ADATMD ! INTEGER, POINTER :: IAPPRO(:) #ifdef W3_MPI - INTEGER, POINTER :: MPI_COMM_WAVE, MPI_COMM_WCMP, & - WW3_FIELD_VEC, WW3_SPEC_VEC, & - NRQSG1, NRQSG2, IBFLOC, ISPLOC, & - NSPLOC + type(MPI_COMM), POINTER :: MPI_COMM_WAVE, MPI_COMM_WCMP + type(MPI_Datatype), POINTER :: WW3_FIELD_VEC, WW3_SPEC_VEC + INTEGER, POINTER :: NRQSG1, NRQSG2, IBFLOC, ISPLOC, NSPLOC INTEGER, POINTER :: BSTAT(:), BISPL(:) - INTEGER, POINTER :: IRQSG1(:,:), IRQSG2(:,:) + type(MPI_Request), POINTER :: IRQSG1(:,:), IRQSG2(:,:) REAL, POINTER :: GSTORE(:,:), SSTORE(:,:) #endif REAL, POINTER :: SPPNT(:,:,:) diff --git a/model/src/w3agcmmd.F90 b/model/src/w3agcmmd.F90 index 60b144739b..bfcab3792c 100644 --- a/model/src/w3agcmmd.F90 +++ b/model/src/w3agcmmd.F90 @@ -67,9 +67,9 @@ MODULE W3AGCMMD ! !/ ------------------------------------------------------------------- / ! - IMPLICIT NONE + use mpi_f08 ! - INCLUDE "mpif.h" + IMPLICIT NONE ! PRIVATE ! @@ -293,7 +293,7 @@ SUBROUTINE RCV_FIELDS_FROM_ATMOS(ID_LCOMM, IDFLD, FXN, FYN, FAN) !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: ID_LCOMM + type(MPI_COMM), INTENT(IN) :: ID_LCOMM CHARACTER(LEN=3), INTENT(IN) :: IDFLD REAL, INTENT(INOUT) :: FXN(:,:), FYN(:,:), FAN(:,:) ! diff --git a/model/src/w3fldsmd.F90 b/model/src/w3fldsmd.F90 index 639bfa807f..99ff484c90 100644 --- a/model/src/w3fldsmd.F90 +++ b/model/src/w3fldsmd.F90 @@ -1060,6 +1060,7 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & #endif #ifdef W3_OASIS USE W3ODATMD, ONLY: DTOUT + use mpi_f08, ONLY: MPI_COMM #endif IMPLICIT NONE !/ @@ -1077,7 +1078,7 @@ SUBROUTINE W3FLDG (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, & CHARACTER(LEN=3), INTENT(IN) :: IDFLD LOGICAL, INTENT(INOUT), OPTIONAL :: FLAGSC #ifdef W3_OASIS - INTEGER, INTENT(IN), OPTIONAL :: COUPL_COMM + type(MPI_COMM), INTENT(IN), OPTIONAL :: COUPL_COMM #endif !/ diff --git a/model/src/w3gsrumd.F90 b/model/src/w3gsrumd.F90 index 9cd4beaf52..979d21e207 100644 --- a/model/src/w3gsrumd.F90 +++ b/model/src/w3gsrumd.F90 @@ -9623,7 +9623,7 @@ END SUBROUTINE GET_FDW3 !/ SUBROUTINE EXTCDE(IEXIT) #ifdef ENABLE_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif INTEGER, INTENT(IN) :: IEXIT #ifdef ENABLE_MPI diff --git a/model/src/w3igcmmd.F90 b/model/src/w3igcmmd.F90 index 14b9427604..56f81a7744 100644 --- a/model/src/w3igcmmd.F90 +++ b/model/src/w3igcmmd.F90 @@ -56,9 +56,9 @@ MODULE W3IGCMMD ! !/ ------------------------------------------------------------------- / ! - IMPLICIT NONE + use mpi_f08 ! - INCLUDE "mpif.h" + IMPLICIT NONE ! PRIVATE ! @@ -236,7 +236,7 @@ SUBROUTINE RCV_FIELDS_FROM_ICE(ID_LCOMM, IDFLD, FXN, FYN, FAN) !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: ID_LCOMM + type(MPI_COMM), INTENT(IN) :: ID_LCOMM CHARACTER(LEN=3), INTENT(IN) :: IDFLD REAL, INTENT(INOUT) :: FXN(:,:), FYN(:,:), FAN(:,:) ! diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index c72bd502d4..bdfa168132 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -155,13 +155,13 @@ MODULE W3INITMD !> @param[in] PNAMES Output point names. !> @param[in] IPRT Partitioning grid info. !> @param[inout] PRTFRM Partitioning format flag. - !> @param[in] MPI_COMM MPI communicator to be used for model. + !> @param[in] MPI_COMM_IN MPI communicator to be used for model. !> @param[in] FLAGSTIDEIN !> !> @author H. L. Tolman @date 03-Sep-2012 !> SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, & - FLG2, NPT, XPT, YPT, PNAMES, IPRT, PRTFRM, MPI_COMM, FLAGSTIDEIN) + FLG2, NPT, XPT, YPT, PNAMES, IPRT, PRTFRM, MPI_COMM_IN, FLAGSTIDEIN) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -452,15 +452,19 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #endif !/ #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, MDS(15), MTRACE(2), & - ODAT(40),NPT, IPRT(6),& - MPI_COMM + ODAT(40),NPT, IPRT(6) +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN) :: MPI_COMM_IN +#else + INTEGER, INTENT(IN) :: MPI_COMM_IN +#endif LOGICAL, INTENT(IN) :: IsMulti REAL, INTENT(INOUT) :: XPT(NPT), YPT(NPT) LOGICAL, INTENT(INOUT) :: FLGRD(NOGRP,NGRPP), FLGD(NOGRP),& @@ -483,7 +487,8 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, INTEGER :: ISTEP, ISP, IW #endif #ifdef W3_MPI - INTEGER :: IERR_MPI, BGROUP, LGROUP + INTEGER :: IERR_MPI + type(MPI_GROUP) :: BGROUP, LGROUP #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -564,7 +569,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #endif ! #ifdef W3_MPI - MPI_COMM_WAVE = MPI_COMM + MPI_COMM_WAVE = MPI_COMM_IN CALL MPI_COMM_SIZE ( MPI_COMM_WAVE, NTPROC, IERR_MPI ) NAPROC = NTPROC CALL MPI_COMM_RANK ( MPI_COMM_WAVE, IAPROC, IERR_MPI ) @@ -1782,7 +1787,7 @@ SUBROUTINE W3MPII ( IMOD ) USE W3ODATMD, ONLY: NDST, NAPROC, IAPROC !/ #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / @@ -2158,7 +2163,7 @@ SUBROUTINE W3MPIO ( IMOD ) USE CONSTANTS, ONLY: LPDLIB !/ #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / @@ -5451,7 +5456,7 @@ SUBROUTINE W3MPIP ( IMOD ) #endif !/ #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index e8302d1dd6..cd0b0d7b0a 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -314,7 +314,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & #endif ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index 110b27202b..be7bcbff16 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -364,15 +364,20 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) USE W3TRIAMD, ONLY: IS_IN_UNGRID USE W3GDATMD, ONLY: FILEXT ! - IMPLICIT NONE #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: NPT, IMOD, MPI_COMM_IOPP + INTEGER, INTENT(IN) :: NPT, IMOD +#ifdef W3_MPI + TYPE(MPI_COMM), INTENT(IN) :: MPI_COMM_IOPP +#else + INTEGER, INTENT(IN) :: MPI_COMM_IOPP +#endif REAL, INTENT(INOUT) :: XPT(NPT), YPT(NPT) CHARACTER(LEN=40),INTENT(IN) :: PNAMES(NPT) !/ @@ -985,11 +990,10 @@ SUBROUTINE W3IOPE ( A ) USE W3ARRYMD, ONLY: PRT2DS #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1003,7 +1007,7 @@ SUBROUTINE W3IOPE ( A ) IM(4), IK, ITH, ISP #ifdef W3_MPI INTEGER :: IOFF, IERR_MPI - INTEGER :: STAT(MPI_STATUS_SIZE,4*NOPTS) + type(MPI_STATUS) :: STAT(4*NOPTS) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -1215,8 +1219,8 @@ SUBROUTINE W3IOPE ( A ) ! #ifdef W3_MPI IOFF = 1 + 4*(I-1) - CALL MPI_STARTALL ( 4, IRQPO2(IOFF), IERR_MPI ) - CALL MPI_WAITALL ( 4, IRQPO2(IOFF), STAT, IERR_MPI ) + CALL MPI_STARTALL ( 4, IRQPO2(IOFF:IOFF+3), IERR_MPI ) + CALL MPI_WAITALL ( 4, IRQPO2(IOFF:IOFF+3), STAT(IOFF:IOFF+3), IERR_MPI ) #endif ! ! Interpolate spectrum diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 32652e0e94..37a6988a9b 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -294,6 +294,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: W3SETG, W3SETREF, RSTYPE, FETCH USE W3ODATMD, ONLY: W3SETO + USE W3WDATMD, only: W3SETW, W3DIMW USE W3ADATMD, ONLY: W3SETA, W3XETA, NSEALM USE W3ADATMD, ONLY: CX, CY, HS, WLM, T0M1, T01, FP0, THM, CHARN,& TAUWIX, TAUWIY, TWS, TAUOX, TAUOY, BHD, & @@ -304,7 +305,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, NSPEC, MAPSTA, MAPST2, & GNAME, FILEXT, GTYPE, UNGTYPE USE W3TRIAMD, ONLY: SET_UG_IOBP - USE W3WDATMD + USE W3WDATMD, only : DINIT, VA, TIME, TLEV, TICE, TRHO, ICE, UST + USE W3WDATMD, only : USTDIR, ASF, FPIS, ICEF, TIC1, TIC5, WLV #ifdef W3_WRST USE W3IDATMD, ONLY: WXN, WYN, W3SETI USE W3IDATMD, ONLY: WXNwrst, WYNwrst @@ -316,6 +318,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3ODATMD, ONLY: NRQRS, NBLKRS, RSBLKS, IRQRS, IRQRSS, & VAAUX USE W3ADATMD, ONLY: MPI_COMM_WCMP + USE mpi_f08 #endif !/ USE W3SERVMD, ONLY: EXTCDE, EXTIOF @@ -334,9 +337,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -367,7 +367,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) #endif INTEGER(KIND=8) :: RPOS #ifdef W3_MPI - INTEGER, ALLOCATABLE :: STAT1(:,:), STAT2(:,:) + type(MPI_STATUS), ALLOCATABLE :: STAT1(:), STAT2(:) REAL, ALLOCATABLE :: VGBUFF(:), VLBUFF(:) #endif REAL(KIND=LRB), ALLOCATABLE :: WRITEBUFF(:), TMP(:), TMP2(:) @@ -717,7 +717,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) NRQ = NAPROC END IF ! - ALLOCATE ( STAT1(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STAT1(NRQ) ) IF ( IAPROC .EQ. NAPRST ) CALL MPI_STARTALL & ( NRQ, IRQRSS, IERR_MPI ) ! @@ -729,11 +729,11 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! IH = 1 + NRQ * (IB-1) CALL MPI_WAITALL & - ( NRQ, IRQRSS(IH), STAT1, IERR_MPI ) + ( NRQ, IRQRSS(IH:IH+NRQ-1), STAT1, IERR_MPI ) IF ( IB .LT. NBLKRS ) THEN IH = 1 + NRQ * IB CALL MPI_STARTALL & - ( NRQ, IRQRSS(IH), IERR_MPI ) + ( NRQ, IRQRSS(IH:IH+NRQ-1), IERR_MPI ) END IF ! DO ISEA=ISEA0, ISEAN @@ -755,9 +755,9 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ELSE ! CALL MPI_STARTALL & - ( 1, IRQRSS(IB), IERR_MPI ) + ( 1, IRQRSS(IB:IB), IERR_MPI ) CALL MPI_WAITALL & - ( 1, IRQRSS(IB), STAT1, IERR_MPI ) + ( 1, IRQRSS(IB:IB), STAT1(1:1), IERR_MPI ) ! END IF END DO @@ -887,7 +887,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! #ifdef W3_MPI if (associated(irqrs)) then - ALLOCATE ( STAT2(MPI_STATUS_SIZE,NRQRS) ) + ALLOCATE ( STAT2(NRQRS) ) CALL MPI_WAITALL & ( NRQRS, IRQRS , STAT2, IERR_MPI ) DEALLOCATE ( STAT2 ) diff --git a/model/src/w3iosfmd.F90 b/model/src/w3iosfmd.F90 index 05339fe0fc..42f7cfa74d 100644 --- a/model/src/w3iosfmd.F90 +++ b/model/src/w3iosfmd.F90 @@ -452,11 +452,11 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) USE W3ODATMD, ONLY: NDST #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -469,8 +469,8 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) INTEGER :: I, J, IERR, ISEA, JSEA, JAPROC, & IX, IY, IP, IOFF, DTSIZ=0 #ifdef W3_MPI - INTEGER :: ICSIZ, IERR_MPI, IT, & - STATUS(MPI_STATUS_SIZE,1), JSLM + INTEGER :: ICSIZ, IERR_MPI, IT, JSLM + type(MPI_STATUS) :: STATUS #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 diff --git a/model/src/w3iotrmd.F90 b/model/src/w3iotrmd.F90 index f62bf065e3..c828d6f3dd 100644 --- a/model/src/w3iotrmd.F90 +++ b/model/src/w3iotrmd.F90 @@ -248,13 +248,13 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) USE w3SERVMD, ONLY : STRSPLIT #ifdef W3_S USE W3SERVMD, ONLY: STRACE +#endif +#ifdef W3_MPI + use mpi_f08 #endif ! IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -282,7 +282,7 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #endif #ifdef W3_MPI INTEGER :: IT, IROOT, IFROM, IERR_MPI - INTEGER, ALLOCATABLE :: STATUS(:,:) + type(MPI_STATUS), ALLOCATABLE :: STATUS(:) #endif REAL :: XN, YN, XT, YT, RD, X, Y, WX, WY, & SPEC(NK,NTH), FACTOR, ASPTRK(NTH,NK),& @@ -344,7 +344,7 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #ifdef W3_MPI IF ( NRQTR .NE. 0 ) THEN CALL MPI_STARTALL ( NRQTR, IRQTR, IERR_MPI ) - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQTR) ) + ALLOCATE ( STATUS(NRQTR) ) CALL MPI_WAITALL ( NRQTR, IRQTR , STATUS, IERR_MPI ) DEALLOCATE ( STATUS ) END IF @@ -721,7 +721,7 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #ifdef W3_MPI IT = IT0TRK IROOT = NAPTRK - 1 - ALLOCATE ( STATUS(MPI_STATUS_SIZE,1) ) + ALLOCATE ( STATUS(1) ) #endif ! DO IY=1, NY @@ -829,7 +829,7 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #ifdef W3_MPI CALL MPI_RECV (ASPTRK, NSPEC, MPI_REAL,& IFROM, IT, MPI_COMM_WAVE, & - STATUS, IERR_MPI ) + STATUS(1), IERR_MPI ) #endif ! DO IK=1, NK diff --git a/model/src/w3nmlmultimd.F90 b/model/src/w3nmlmultimd.F90 index e64b044296..a37b29f0a1 100644 --- a/model/src/w3nmlmultimd.F90 +++ b/model/src/w3nmlmultimd.F90 @@ -207,7 +207,7 @@ MODULE W3NMLMULTIMD CONTAINS !/ ------------------------------------------------------------------- / - SUBROUTINE W3NMLMULTIDEF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, IERR) + SUBROUTINE W3NMLMULTIDEF (MPICOMM, NDSI, INFILE, NML_DOMAIN, IERR) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -275,6 +275,7 @@ SUBROUTINE W3NMLMULTIDEF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, IERR) USE WMMDATMD, ONLY: MDSE, IMPROC, NMPLOG #ifdef W3_MPI USE WMMDATMD, ONLY: MPI_COMM_MWAVE + use mpi_f08, ONLY : MPI_COMM, MPI_COMM_RANK #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -282,7 +283,12 @@ SUBROUTINE W3NMLMULTIDEF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, IERR) IMPLICIT NONE - INTEGER, INTENT(IN) :: MPI_COMM, NDSI + INTEGER, INTENT(IN) :: NDSI +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN) :: MPICOMM +#else + INTEGER, INTENT(IN) :: MPICOMM +#endif CHARACTER*(*), INTENT(IN) :: INFILE TYPE(NML_DOMAIN_T), INTENT(OUT) :: NML_DOMAIN INTEGER, INTENT(OUT) :: IERR @@ -301,7 +307,7 @@ SUBROUTINE W3NMLMULTIDEF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, IERR) #endif #ifdef W3_MPI - MPI_COMM_MWAVE = MPI_COMM + MPI_COMM_MWAVE = MPICOMM CALL MPI_COMM_RANK ( MPI_COMM_MWAVE, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 #endif @@ -342,7 +348,7 @@ END SUBROUTINE W3NMLMULTIDEF !/ ------------------------------------------------------------------- / - SUBROUTINE W3NMLMULTICONF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & + SUBROUTINE W3NMLMULTICONF (MPICOMM, NDSI, INFILE, NML_DOMAIN, & NML_INPUT_GRID, NML_MODEL_GRID, & NML_OUTPUT_TYPE, NML_OUTPUT_DATE, & NML_HOMOG_COUNT, NML_HOMOG_INPUT, IERR) @@ -428,6 +434,7 @@ SUBROUTINE W3NMLMULTICONF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & USE WMMDATMD, ONLY: MDSE, IMPROC, NMPLOG #ifdef W3_MPI USE WMMDATMD, ONLY: MPI_COMM_MWAVE + use mpi_f08, ONLY : MPI_COMM, MPI_COMM_RANK #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -435,7 +442,12 @@ SUBROUTINE W3NMLMULTICONF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & IMPLICIT NONE - INTEGER, INTENT(IN) :: MPI_COMM, NDSI + INTEGER, INTENT(IN) :: NDSI +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN) :: MPICOMM +#else + INTEGER, INTENT(IN) :: MPICOMM +#endif CHARACTER*(*), INTENT(IN) :: INFILE TYPE(NML_DOMAIN_T), INTENT(INOUT) :: NML_DOMAIN TYPE(NML_INPUT_GRID_T), INTENT(INOUT) :: NML_INPUT_GRID(:) @@ -460,7 +472,7 @@ SUBROUTINE W3NMLMULTICONF (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & #endif #ifdef W3_MPI - MPI_COMM_MWAVE = MPI_COMM + MPI_COMM_MWAVE = MPICOMM CALL MPI_COMM_RANK ( MPI_COMM_MWAVE, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 #endif diff --git a/model/src/w3nmlshelmd.F90 b/model/src/w3nmlshelmd.F90 index 7715a2bd29..7e0f70dad8 100644 --- a/model/src/w3nmlshelmd.F90 +++ b/model/src/w3nmlshelmd.F90 @@ -174,7 +174,7 @@ MODULE W3NMLSHELMD CONTAINS !/ ------------------------------------------------------------------- / - SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & + SUBROUTINE W3NMLSHEL (MPICOMM, NDSI, INFILE, NML_DOMAIN, & NML_INPUT, NML_OUTPUT_TYPE, NML_OUTPUT_DATE, NML_OUTPUT_PATH, & NML_HOMOG_COUNT, NML_HOMOG_INPUT, IERR) !/ @@ -256,6 +256,7 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & USE WMMDATMD, ONLY: MDSE, IMPROC, NMPLOG #ifdef W3_MPI USE WMMDATMD, ONLY: MPI_COMM_MWAVE + use mpi_f08, ONLY : MPI_COMM, MPI_COMM_RANK #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -263,7 +264,12 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & IMPLICIT NONE - INTEGER, INTENT(IN) :: MPI_COMM, NDSI + INTEGER, INTENT(IN) :: NDSI +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN) :: MPICOMM +#else + INTEGER, INTENT(IN) :: MPICOMM +#endif CHARACTER*(*), INTENT(IN) :: INFILE TYPE(NML_DOMAIN_T), INTENT(INOUT) :: NML_DOMAIN TYPE(NML_INPUT_T), INTENT(INOUT) :: NML_INPUT @@ -288,7 +294,7 @@ SUBROUTINE W3NMLSHEL (MPI_COMM, NDSI, INFILE, NML_DOMAIN, & #endif #ifdef W3_MPI - MPI_COMM_MWAVE = MPI_COMM + MPI_COMM_MWAVE = MPICOMM CALL MPI_COMM_RANK ( MPI_COMM_MWAVE, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 #endif diff --git a/model/src/w3oacpmd.F90 b/model/src/w3oacpmd.F90 index e5f3dde148..41366cd2d4 100644 --- a/model/src/w3oacpmd.F90 +++ b/model/src/w3oacpmd.F90 @@ -130,8 +130,12 @@ SUBROUTINE CPL_OASIS_INIT(ID_LCOMM) ! !/ ------------------------------------------------------------------- / ! +#ifdef W3_MPI + use mpi_f08 +#endif ! * Argument - INTEGER, INTENT(OUT) :: ID_LCOMM ! Model local communicator + type(MPI_COMM), INTENT(OUT) :: ID_LCOMM ! Model local communicator + INTEGER :: ID_LCOMM_INT ! !---------------------------------------------------------------------- ! * Executable part @@ -143,7 +147,8 @@ SUBROUTINE CPL_OASIS_INIT(ID_LCOMM) ENDIF ! !! Get the value of a local MPI communicator to be used by WW3 for its internal parallelisation - CALL OASIS_GET_LOCALCOMM(ID_LCOMM, IL_ERR) + CALL OASIS_GET_LOCALCOMM(ID_LCOMM_INT, IL_ERR) + ID_LCOMM%mpi_val = ID_LCOMM_INT IF (IL_ERR /= 0) THEN CALL OASIS_ABORT(IL_COMPID, 'CPL_OASIS_INIT', 'Problem during oasis_get_localcomm') ENDIF @@ -206,14 +211,14 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) USE W3GDATMD, ONLY: NSEA, X0, Y0, MRFct, SX, SY, IJKCel #endif #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif ! !/ ------------------------------------------------------------------- / !/ Parameter list !/ LOGICAL, INTENT(IN) :: LD_MASTER ! MASTER process or not - INTEGER, INTENT(IN) :: ID_LCOMM ! Model local communicator + type(MPI_COMM), INTENT(IN) :: ID_LCOMM ! Model local communicator ! !/ ------------------------------------------------------------------- / !/ Local parameters @@ -226,6 +231,9 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) #ifdef W3_SMC REAL :: DLON, DLAT #endif +!#ifdef W3_MPI +! type(MPI_COMM) :: mpicomm +!#endif !/ ------------------------------------------------------------------- / ! IF (LD_MASTER) THEN diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 7ac39a6fc0..cd2e829f89 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -310,6 +310,13 @@ MODULE W3ODATMD ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY : UNDEF +#ifdef W3_MPI + use mpi_f08, ONLY : MPI_Request +#endif + + ! module default + IMPLICIT NONE + PUBLIC !/ !/ Module private variable for checking error returns @@ -346,7 +353,7 @@ MODULE W3ODATMD INTEGER :: IPASS1 #ifdef W3_MPI INTEGER :: NRQGO, NRQGO2 - INTEGER, POINTER :: IRQGO(:), IRQGO2(:) + type(MPI_Request), POINTER :: IRQGO(:), IRQGO2(:) #endif LOGICAL :: FLOGRD(NOGRP,NGRPP), FLOGD(NOGRP), & FLOGR2(NOGRP,NGRPP), FLOG2(NOGRP), & @@ -361,7 +368,7 @@ MODULE W3ODATMD #endif INTEGER, POINTER :: IPTINT(:,:,:), IL(:), IW(:), II(:) #ifdef W3_MPI - INTEGER, POINTER :: IRQPO1(:), IRQPO2(:) + type(MPI_Request), POINTER :: IRQPO1(:), IRQPO2(:) #endif REAL, POINTER :: PTLOC(:,:), PTIFAC(:,:), & DPO(:), WAO(:), WDO(:), ASO(:), & @@ -384,7 +391,7 @@ MODULE W3ODATMD INTEGER :: IPASS3 #ifdef W3_MPI INTEGER :: IT0PNT, IT0TRK, IT0PRT, NRQTR - INTEGER, POINTER :: IRQTR(:) + type(MPI_Request), POINTER :: IRQTR(:) #endif LOGICAL :: O3INIT, STOP LOGICAL, POINTER :: MASK1(:,:), MASK2(:,:) @@ -395,7 +402,7 @@ MODULE W3ODATMD INTEGER :: IFILE4 #ifdef W3_MPI INTEGER :: NRQRS, NBLKRS, RSBLKS - INTEGER, POINTER :: IRQRS(:), IRQRSS(:) + type(MPI_Request), POINTER :: IRQRS(:), IRQRSS(:) REAL, POINTER :: VAAUX(:,:,:) #endif END TYPE OTYPE4 @@ -409,7 +416,7 @@ MODULE W3ODATMD INTEGER, POINTER :: IPBPI(:,:), ISBPI(:), & IPBPO(:,:), ISBPO(:) #ifdef W3_MPI - INTEGER, POINTER :: IRQBP1(:), IRQBP2(:) + type(MPI_Request), POINTER :: IRQBP1(:), IRQBP2(:) #endif REAL :: XFRI, FR1I, TH1I REAL, POINTER :: XBPI(:), YBPI(:), RDBPI(:,:), & @@ -479,7 +486,7 @@ MODULE W3ODATMD INTEGER, POINTER :: IPASS1 #ifdef W3_MPI INTEGER, POINTER :: NRQGO, NRQGO2 - INTEGER, POINTER :: IRQGO(:), IRQGO2(:) + type(MPI_Request), POINTER :: IRQGO(:), IRQGO2(:) #endif LOGICAL, POINTER :: FLOGRD(:,:), FLOGR2(:,:), & FLOGRR(:,:),FLOGD(:), FLOG2(:), & @@ -493,7 +500,7 @@ MODULE W3ODATMD #endif INTEGER, POINTER :: IPTINT(:,:,:), IL(:), IW(:), II(:) #ifdef W3_MPI - INTEGER, POINTER :: IRQPO1(:), IRQPO2(:) + type(MPI_Request), POINTER :: IRQPO1(:), IRQPO2(:) #endif REAL, POINTER :: PTLOC(:,:), PTIFAC(:,:), & DPO(:), WAO(:), WDO(:), ASO(:), & @@ -516,7 +523,7 @@ MODULE W3ODATMD INTEGER, POINTER :: IPASS3 #ifdef W3_MPI INTEGER, POINTER :: IT0PNT, IT0TRK, IT0PRT, NRQTR - INTEGER, POINTER :: IRQTR(:) + type(MPI_Request), POINTER :: IRQTR(:) #endif LOGICAL, POINTER :: O3INIT, STOP LOGICAL, POINTER :: MASK1(:,:), MASK2(:,:) @@ -527,7 +534,7 @@ MODULE W3ODATMD INTEGER, POINTER :: IFILE4 #ifdef W3_MPI INTEGER, POINTER :: NRQRS, NBLKRS, RSBLKS - INTEGER, POINTER :: IRQRS(:), IRQRSS(:) + type(MPI_Request), POINTER :: IRQRS(:), IRQRSS(:) REAL, POINTER :: VAAUX(:,:,:) #endif !/ @@ -541,7 +548,7 @@ MODULE W3ODATMD INTEGER, POINTER :: IPBPI(:,:), ISBPI(:), & IPBPO(:,:), ISBPO(:) #ifdef W3_MPI - INTEGER, POINTER :: IRQBP1(:), IRQBP2(:) + type(MPI_Request), POINTER :: IRQBP1(:), IRQBP2(:) #endif REAL, POINTER :: XFRI, FR1I, TH1I REAL, POINTER :: XBPI(:), YBPI(:), RDBPI(:,:), & diff --git a/model/src/w3ogcmmd.F90 b/model/src/w3ogcmmd.F90 index 64b10bad4e..cca2ce9375 100644 --- a/model/src/w3ogcmmd.F90 +++ b/model/src/w3ogcmmd.F90 @@ -47,9 +47,9 @@ MODULE W3OGCMMD ! !/ ------------------------------------------------------------------- / ! - IMPLICIT NONE + use mpi_f08 ! - INCLUDE "mpif.h" + IMPLICIT NONE ! PRIVATE ! @@ -467,7 +467,7 @@ SUBROUTINE RCV_FIELDS_FROM_OCEAN(ID_LCOMM, IDFLD, FXN, FYN, FAN) !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: ID_LCOMM + type(MPI_COMM), INTENT(IN) :: ID_LCOMM CHARACTER(LEN=3), INTENT(IN) :: IDFLD REAL, INTENT(INOUT) :: FXN(:,:), FYN(:,:), FAN(:,:) ! diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index e2aba9b529..a4bf504f54 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -154,6 +154,9 @@ SUBROUTINE WAV_MY_WTIME(eTime) !/ ------------------------------------------------------------------- / #ifdef W3_S USE W3SERVMD, ONLY: STRACE +#endif +#ifdef W3_MPI + use mpi_f08, ONLY: mpi_wtime #endif !/ !/ ------------------------------------------------------------------- / @@ -168,9 +171,6 @@ SUBROUTINE WAV_MY_WTIME(eTime) #endif INTEGER mpimode REAL(8), intent(out) :: eTime -#ifdef W3_MPI - REAL(8) mpi_wtime -#endif mpimode=0 #ifdef W3_MPI mpimode=1 @@ -972,10 +972,10 @@ SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot USE WMMDATMD, ONLY: MDATAS #endif - IMPLICIT NONE #ifdef W3_PDLIB - INCLUDE "mpif.h" + use mpi_f08 #endif + IMPLICIT NONE INTEGER, intent(in) :: IMOD logical, intent(in) :: IsMulti #ifdef W3_S @@ -1577,6 +1577,9 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) USE yowNodepool, only: npa use yowNodepool, only: iplg use yowDatapool, only: rkind +#endif +#ifdef W3_MPI + use mpi_f08 #endif IMPLICIT NONE !/ ------------------------------------------------------------------- / @@ -1591,9 +1594,6 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) !/ !/ ------------------------------------------------------------------- / !/ -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif INTEGER ISEA, JSEA, Status(NX), rStatus(NX) INTEGER IPROC, I, ierr, IP, IX, IP_glob #ifdef W3_PDLIB diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 140fdc33bc..478baa9680 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -209,7 +209,7 @@ SUBROUTINE PDLIB_INIT(IMOD) USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FSSOURCE !/ - INCLUDE "mpif.h" + use mpi_f08 !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -223,7 +223,7 @@ SUBROUTINE PDLIB_INIT(IMOD) !/ !/ ------------------------------------------------------------------- / !/ - !! INCLUDE "mpif.h" + !! use mpi_f08 INTEGER :: istat INTEGER :: I, J, IBND_MAP, ISEA, IP, IX, JSEA, nb INTEGER :: IP_glob @@ -931,7 +931,7 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL USE W3ODATMD, only : IAPROC - USE MPI, only : MPI_MIN + use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, ZERO, THR USE yowRankModule, only : IPGL_npa @@ -1259,7 +1259,7 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL USE W3ODATMD, only : IAPROC - USE MPI, only : MPI_MIN + use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, ZERO, THR USE yowRankModule, only : IPGL_npa @@ -1555,7 +1555,7 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL USE W3ODATMD, only : IAPROC - USE MPI, only : MPI_MIN + use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, ZERO, THR USE yowRankModule, only : IPGL_npa @@ -1914,7 +1914,7 @@ SUBROUTINE TEST_MPI_STATUS(string) USE W3ODATMD, only : IAPROC, NAPROC, NTPROC use yowDatapool, only: rtype, istatus - INCLUDE "mpif.h" + use mpi_f08 CHARACTER(*), INTENT(in) :: string REAL VcollExp(1) REAL rVect(1) @@ -1997,7 +1997,7 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintF USE YOWNODEPOOL, only: npa, iplg USE W3PARALL, only: INIT_GET_ISEA - INCLUDE "mpif.h" + use mpi_f08 ! REAL*8, INTENT(in) :: V(NSEAL) CHARACTER(*), INTENT(in) :: string @@ -2501,7 +2501,7 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinI USE YOWNODEPOOL, only: npa, iplg USE W3PARALL, only: INIT_GET_ISEA - INCLUDE "mpif.h" + use mpi_f08 CHARACTER(*), INTENT(in) :: string INTEGER, INTENT(in) :: maxidx REAL, INTENT(in) :: TheARR(NSPEC, npa) @@ -3017,7 +3017,7 @@ SUBROUTINE WRITE_VAR_TO_TEXT_FILE(TheArr, eFile) USE YOWNODEPOOL, only: npa, iplg, np USE W3PARALL, only: INIT_GET_ISEA - INCLUDE "mpif.h" + use mpi_f08 CHARACTER(*), INTENT(in) :: eFile REAL, INTENT(in) :: TheARR(NSPEC, npa) ! @@ -5520,7 +5520,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL use yowDatapool, only: rtype use YOWNODEPOOL, only: npa, iplg use yowExchangeModule, only : PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal - USE MPI, only : MPI_SUM, MPI_INT + use mpi_f08, only : MPI_SUM, MPI_INT, MPI_ALLREDUCE USE W3ADATMD, only: MPI_COMM_WCMP USE W3GDATMD, only: NSEA, SIG, FACP, FLSOU USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC @@ -5548,6 +5548,8 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL #ifdef W3_REF1 USE W3GDATMD, only: REFPARS #endif + use mpi_f08 + implicit none LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD @@ -6402,7 +6404,7 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, RD10, RD20, DTG, VGX, VGY, LCA use yowDatapool, only: rtype use yowExchangeModule, only: PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal use yowRankModule, only: ipgl_npa - USE MPI, only : MPI_MIN + use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE #endif #ifdef W3_REF1 USE W3GDATMD, only: REFPARS diff --git a/model/src/w3psmcmd.F90 b/model/src/w3psmcmd.F90 index 537769986d..72d6a5bbb3 100644 --- a/model/src/w3psmcmd.F90 +++ b/model/src/w3psmcmd.F90 @@ -3276,12 +3276,12 @@ SUBROUTINE W3GATHSMC ( ISPEC, FIELD ) NSPLOC, NRQSG2, IRQSG2, GSTORE USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC #endif - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -3296,9 +3296,9 @@ SUBROUTINE W3GATHSMC ( ISPEC, FIELD ) INTEGER :: ISEA, IXY #endif #ifdef W3_MPI - INTEGER :: STATUS(MPI_STATUS_SIZE,NSPEC), & - IOFF, IERR_MPI, JSEA, ISEA, & - IXY, IS0, IB0, NPST, J + type(MPI_STATUS) :: STATUS(NSPEC) + INTEGER :: IOFF, IERR_MPI, JSEA, ISEA, & + IXY, IS0, IB0, NPST, J #endif #ifdef W3_S INTEGER, SAVE :: IENT @@ -3336,7 +3336,7 @@ SUBROUTINE W3GATHSMC ( ISPEC, FIELD ) IF ( BSTAT(IBFLOC) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IBFLOC)-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) CALL & - MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), & + MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), & STATUS, IERR_MPI ) BSTAT(IBFLOC) = 0 END IF @@ -3348,7 +3348,7 @@ SUBROUTINE W3GATHSMC ( ISPEC, FIELD ) BISPL(IBFLOC) = ISPLOC IOFF = 1 + (ISPLOC-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) CALL & - MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI ) + MPI_STARTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,1), IERR_MPI ) END IF ! ! 2.c Put local spectral densities in store @@ -3361,7 +3361,7 @@ SUBROUTINE W3GATHSMC ( ISPEC, FIELD ) ! IOFF = 1 + (BISPL(IBFLOC)-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) CALL & - MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,1), STATUS, IERR_MPI ) + MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,1), STATUS, IERR_MPI ) ! ! 2.e Convert storage array to field. ! @@ -3383,7 +3383,7 @@ SUBROUTINE W3GATHSMC ( ISPEC, FIELD ) BISPL(IB0) = IS0 IOFF = 1 + (IS0-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) CALL & - MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI ) + MPI_STARTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,1), IERR_MPI ) NPST = NPST + 1 END IF IF ( NPST .GE. 2 ) EXIT @@ -3507,12 +3507,12 @@ SUBROUTINE W3SCATSMC ( ISPEC, MAPSTA, FIELD ) USE W3ODATMD, ONLY: IAPROC, NAPROC #endif USE W3ODATMD, ONLY: NDST - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -3527,9 +3527,8 @@ SUBROUTINE W3SCATSMC ( ISPEC, MAPSTA, FIELD ) INTEGER :: ISEA, IXY #endif #ifdef W3_MPI - INTEGER :: ISEA, IXY, IOFF, IERR_MPI, J, & - STATUS(MPI_STATUS_SIZE,NSPEC), & - JSEA, IB0 + INTEGER :: ISEA, IXY, IOFF, IERR_MPI, J, JSEA, IB0 + type(MPI_STATUS) :: STATUS(NSPEC) #endif #ifdef W3_S INTEGER, SAVE :: IENT @@ -3570,7 +3569,7 @@ SUBROUTINE W3SCATSMC ( ISPEC, MAPSTA, FIELD ) ! IOFF = 1 + (ISPLOC-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) CALL & - MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,2), IERR_MPI ) + MPI_STARTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), IERR_MPI ) BSTAT(IBFLOC) = 2 ! ! 2.d Save locally stored results @@ -3590,13 +3589,13 @@ SUBROUTINE W3SCATSMC ( ISPEC, MAPSTA, FIELD ) IF ( BSTAT(IB0) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IB0)-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) THEN - CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF,2), DONE, & + CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), DONE, & STATUS, IERR_MPI ) ELSE DONE = .TRUE. END IF IF ( DONE .AND. NRQSG2.GT.0 ) CALL & - MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), & + MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), & STATUS, IERR_MPI ) IF ( DONE ) THEN BSTAT(IB0) = 0 @@ -3613,7 +3612,7 @@ SUBROUTINE W3SCATSMC ( ISPEC, MAPSTA, FIELD ) IF ( BSTAT(IB0) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IB0)-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) CALL & - MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), & + MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), & STATUS, IERR_MPI ) BSTAT(IB0) = 0 END IF diff --git a/model/src/w3servmd.F90 b/model/src/w3servmd.F90 index 67c52f1794..efe1702909 100644 --- a/model/src/w3servmd.F90 +++ b/model/src/w3servmd.F90 @@ -1119,7 +1119,7 @@ SUBROUTINE EXTCDE ( IEXIT, UNIT, MSG, FILE, LINE, COMM ) !/ ------------------------------------------------------------------- / ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / @@ -1130,7 +1130,11 @@ SUBROUTINE EXTCDE ( IEXIT, UNIT, MSG, FILE, LINE, COMM ) CHARACTER(*), INTENT(IN), OPTIONAL :: MSG CHARACTER(*), INTENT(IN), OPTIONAL :: FILE INTEGER, INTENT(IN), OPTIONAL :: LINE +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN), OPTIONAL :: COMM +#else INTEGER, INTENT(IN), OPTIONAL :: COMM +#endif !/ !/ ------------------------------------------------------------------- / !/ diff --git a/model/src/w3strkmd.F90 b/model/src/w3strkmd.F90 index e866d40230..58b637f3ab 100644 --- a/model/src/w3strkmd.F90 +++ b/model/src/w3strkmd.F90 @@ -316,12 +316,10 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & !/ No unauthorized use without permission. !/ USE W3SERVMD, ONLY: EXTIOF - - IMPLICIT NONE #ifdef W3_MPI - - INCLUDE "mpif.h" + use mpi_f08 #endif + IMPLICIT NONE ! ! 1. Purpose : ! @@ -438,7 +436,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & #ifdef W3_MPI INTEGER :: rank, irank, nproc, EXTENT, DOMSIZE, tag1, tag2 ! INTEGER :: MPI_INT_DOMARR, MPI_REAL_DOMARR - INTEGER :: MPI_STATUS(MPI_STATUS_SIZE) + type(MPI_STATUS) :: MPI_STAT INTEGER :: REQ(16) ! INTEGER :: ISTAT(MPI_STATUS_SIZE,16) REAL :: COMMARR1(44) @@ -1287,7 +1285,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(6,*) '<< Receiving: rank,irank,tag1=', & ! rank,irank,(tag1+1) CALL MPI_RECV(COMMARR1,44,MPI_REAL,0,(tag1+1), & - MPI_COMM_WORLD,MPI_STATUS,IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) wsdat(tsA)%par(i,j)%hs = COMMARR1(1:10) wsdat(tsA)%par(i,j)%tp = COMMARR1(11:20) wsdat(tsA)%par(i,j)%dir = COMMARR1(21:30) @@ -1306,7 +1304,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & IF (rank.EQ.irank) THEN CALL MPI_RECV(wsdat(tsA)%date,1, & MPI_DOUBLE_PRECISION,0,(tag1+2), & - MPI_COMM_WORLD,MPI_STATUS,IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF IF (rank.EQ.0) THEN @@ -1322,7 +1320,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! rank,irank,(tag1+3) CALL MPI_RECV(COMMARR2,11, & MPI_INTEGER,0,(tag1+3), & - MPI_COMM_WORLD,MPI_STATUS,IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) wsdat(tsA)%par(i,j)%ipart(:) = COMMARR2(1:10) wsdat(tsA)%par(i,j)%checked = COMMARR2(11) END IF @@ -1557,7 +1555,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tsA,tag1=',rank,tsA,tag1 CALL MPI_RECV(maxSys(tsA),1,MPI_INTEGER, & - irank,tag1,MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,tag1,MPI_COMM_WORLD,MPI_STAT,IERR) ! Allocate structure at this time level ALLOCATE( sysA(tsA)%sys(maxSys(tsA)) ) DO ic = 1,maxSys(tsA) @@ -1605,14 +1603,14 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '>> Sending: rank,irank,tag2=', & ! rank,irank,(tag2+1) CALL MPI_SEND(sysA(tsA)%sys(ic)%i(:),DOMSIZE, & - MPI_INTEGER,0,(tag2+1),MPI_COMM_WORLD,REQ(1),IERR) + MPI_INTEGER,0,(tag2+1),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+1) CALL MPI_RECV(sysA(tsA)%sys(ic)%i(:),DOMSIZE, & MPI_INTEGER,irank,(tag2+1), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) @@ -1620,92 +1618,92 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '>> Sending: rank,irank,tag2=', & ! rank,irank,(tag2+2) CALL MPI_SEND(sysA(tsA)%sys(ic)%j(:),DOMSIZE, & - MPI_INTEGER,0,(tag2+2),MPI_COMM_WORLD,REQ(1),IERR) + MPI_INTEGER,0,(tag2+2),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+2) CALL MPI_RECV(sysA(tsA)%sys(ic)%j(:),DOMSIZE, & MPI_INTEGER,irank,(tag2+2), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) IF (rank.EQ.irank) THEN ! WRITE(20,*) '>> Sending: rank,tag2=',rank,(tag2+3) CALL MPI_SEND(sysA(tsA)%sys(ic)%lon(:),DOMSIZE, & - MPI_REAL,0,(tag2+3),MPI_COMM_WORLD,REQ(1),IERR) + MPI_REAL,0,(tag2+3),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tag2=',rank,(tag2+3) CALL MPI_RECV(sysA(tsA)%sys(ic)%lon(:),DOMSIZE, & MPI_REAL,irank,(tag2+3), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) IF (rank.EQ.irank) THEN ! WRITE(20,*) '>> Sending: rank,tag2=',rank,(tag2+4) CALL MPI_SEND(sysA(tsA)%sys(ic)%lat(:),DOMSIZE, & - MPI_REAL,0,(tag2+4),MPI_COMM_WORLD,REQ(1),IERR) + MPI_REAL,0,(tag2+4),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tag2=',rank,(tag2+4) CALL MPI_RECV(sysA(tsA)%sys(ic)%lat(:),DOMSIZE, & MPI_REAL,irank,(tag2+4), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) IF (rank.EQ.irank) THEN ! WRITE(20,*) '>> Sending: rank,tag2=',rank,(tag2+5) CALL MPI_SEND(sysA(tsA)%sys(ic)%hs(:),DOMSIZE, & - MPI_REAL,0,(tag2+5),MPI_COMM_WORLD,REQ(1),IERR) + MPI_REAL,0,(tag2+5),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tag2=',rank,(tag2+5) CALL MPI_RECV(sysA(tsA)%sys(ic)%hs(:),DOMSIZE, & MPI_REAL,irank,(tag2+5), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) IF (rank.EQ.irank) THEN ! WRITE(20,*) '>> Sending: rank,tag2=',rank,(tag2+6) CALL MPI_SEND(sysA(tsA)%sys(ic)%tp(:),DOMSIZE, & - MPI_REAL,0,(tag2+6),MPI_COMM_WORLD,REQ(1),IERR) + MPI_REAL,0,(tag2+6),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tag2=',rank,(tag2+6) CALL MPI_RECV(sysA(tsA)%sys(ic)%tp(:),DOMSIZE, & MPI_REAL,irank,(tag2+6), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) IF (rank.EQ.irank) THEN ! WRITE(20,*) '>> Sending: rank,tag2=',rank,(tag2+7) CALL MPI_SEND(sysA(tsA)%sys(ic)%dir(:),DOMSIZE, & - MPI_REAL,0,(tag2+7),MPI_COMM_WORLD,REQ(1),IERR) + MPI_REAL,0,(tag2+7),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tag2=',rank,(tag2+7) CALL MPI_RECV(sysA(tsA)%sys(ic)%dir(:),DOMSIZE, & MPI_REAL,irank,(tag2+7), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) IF (rank.EQ.irank) THEN ! WRITE(20,*) '>> Sending: rank,tag2=',rank,(tag2+8) CALL MPI_SEND(sysA(tsA)%sys(ic)%dspr(:),DOMSIZE, & - MPI_REAL,0,(tag2+8),MPI_COMM_WORLD,REQ(1),IERR) + MPI_REAL,0,(tag2+8),MPI_COMM_WORLD,IERR) END IF IF (rank.EQ.0) THEN ! WRITE(20,*) '<< Receiving: rank,tag2=',rank,(tag2+8) CALL MPI_RECV(sysA(tsA)%sys(ic)%dspr(:),DOMSIZE, & MPI_REAL,irank,(tag2+8), & - MPI_COMM_WORLD,MPI_STATUS,REQ(2),IERR) + MPI_COMM_WORLD,MPI_STAT,IERR) END IF ! CALL MPI_WAITALL(2,REQ,ISTAT,IERR) @@ -1719,7 +1717,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+9) CALL MPI_RECV(sysA(tsA)%sys(ic)%hsMean,1,MPI_REAL, & - irank,(tag2+9),MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,(tag2+9),MPI_COMM_WORLD,MPI_STAT,IERR) END IF IF (rank.EQ.irank) THEN @@ -1732,7 +1730,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+10) CALL MPI_RECV(sysA(tsA)%sys(ic)%tpMean,1,MPI_REAL, & - irank,(tag2+10),MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,(tag2+10),MPI_COMM_WORLD,MPI_STAT,IERR) END IF IF (rank.EQ.irank) THEN @@ -1745,7 +1743,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+11) CALL MPI_RECV(sysA(tsA)%sys(ic)%dirMean,1,MPI_REAL, & - irank,(tag2+11),MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,(tag2+11),MPI_COMM_WORLD,MPI_STAT,IERR) END IF IF (rank.EQ.irank) THEN @@ -1758,7 +1756,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+12) CALL MPI_RECV(sysA(tsA)%sys(ic)%sysInd,1,MPI_INTEGER,& - irank,(tag2+12),MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,(tag2+12),MPI_COMM_WORLD,MPI_STAT,IERR) END IF IF (rank.EQ.irank) THEN @@ -1771,7 +1769,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+13) CALL MPI_RECV(sysA(tsA)%sys(ic)%nPoints,1,MPI_INTEGER,& - irank,(tag2+13),MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,(tag2+13),MPI_COMM_WORLD,MPI_STAT,IERR) END IF IF (rank.EQ.irank) THEN @@ -1784,7 +1782,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & ! WRITE(20,*) '<< Receiving: rank,irank,tag2=', & ! rank,irank,(tag2+14) CALL MPI_RECV(sysA(tsA)%sys(ic)%grp,1,MPI_INTEGER,& - irank,(tag2+14),MPI_COMM_WORLD,MPI_STATUS,IERR) + irank,(tag2+14),MPI_COMM_WORLD,MPI_STAT,IERR) END IF END DO END IF diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index a6fefb036e..fd24f3d913 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -493,8 +493,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USE W3PARALL, only : PRINT_MY_TIME #endif ! -#ifdef W3_MPI - INCLUDE "mpif.h" +#ifdef W3_MPI + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / @@ -503,7 +503,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & INTEGER, INTENT(IN) :: IMOD, TEND(2),ODAT(35) LOGICAL, INTENT(IN), OPTIONAL :: STAMP, NO_OUT #ifdef W3_OASIS - INTEGER, INTENT(IN), OPTIONAL :: ID_LCOMM + type(MPI_COMM), INTENT(IN), OPTIONAL :: ID_LCOMM INTEGER, INTENT(IN), OPTIONAL :: TIMEN(2) #endif !/ @@ -536,7 +536,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif #ifdef W3_MPI INTEGER :: IERR_MPI, NRQMAX - INTEGER, ALLOCATABLE :: STATCO(:,:), STATIO(:,:) + type(MPI_STATUS), ALLOCATABLE :: STATCO(:), STATIO(:) #endif INTEGER :: IXrel REAL :: DTTST, DTTST1, DTTST2, DTTST3, & @@ -1847,8 +1847,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! #ifdef W3_MPI IF ( NRQSG1 .GT. 0 ) THEN - CALL MPI_STARTALL (NRQSG1, IRQSG1(1,1), IERR_MPI) - CALL MPI_STARTALL (NRQSG1, IRQSG1(1,2), IERR_MPI) + CALL MPI_STARTALL (NRQSG1, IRQSG1(1:NRQSG1,1), IERR_MPI) + CALL MPI_STARTALL (NRQSG1, IRQSG1(1:NRQSG1,2), IERR_MPI) END IF #endif ! @@ -1923,9 +1923,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! #ifdef W3_MPI IF ( NRQSG1 .GT. 0 ) THEN - ALLOCATE ( STATCO(MPI_STATUS_SIZE,NRQSG1) ) - CALL MPI_WAITALL (NRQSG1, IRQSG1(1,1), STATCO, IERR_MPI) - CALL MPI_WAITALL (NRQSG1, IRQSG1(1,2), STATCO, IERR_MPI) + ALLOCATE ( STATCO(NRQSG1) ) + CALL MPI_WAITALL (NRQSG1, IRQSG1(1:NRQSG1,1), STATCO, IERR_MPI) + CALL MPI_WAITALL (NRQSG1, IRQSG1(1:NRQSG1,2), STATCO, IERR_MPI) DEALLOCATE ( STATCO ) END IF #endif @@ -2531,7 +2531,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif ! #ifdef W3_MPI - IF ( NRQMAX .NE. 0 ) ALLOCATE ( STATIO(MPI_STATUS_SIZE,NRQMAX) ) + IF ( NRQMAX .NE. 0 ) ALLOCATE ( STATIO(NRQMAX) ) #endif call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE AFTER TIME LOOP 2') ! @@ -3034,7 +3034,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) !/ ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / @@ -3050,8 +3050,8 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) INTEGER :: ISEA, IXY #endif #ifdef W3_MPI - INTEGER :: STATUS(MPI_STATUS_SIZE,NSPEC), & - IOFF, IERR_MPI, JSEA, ISEA, & + type(MPI_STATUS) :: STATUS(NSPEC) + INTEGER :: IOFF, IERR_MPI, JSEA, ISEA, & IXY, IS0, IB0, NPST, J #endif #ifdef W3_S @@ -3107,7 +3107,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) #ifdef W3_MPI IF ( BSTAT(IBFLOC) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IBFLOC)-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), STATUS, IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), STATUS, IERR_MPI ) BSTAT(IBFLOC) = 0 #endif #ifdef W3_MPIT @@ -3124,7 +3124,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) BSTAT(IBFLOC) = 1 BISPL(IBFLOC) = ISPLOC IOFF = 1 + (ISPLOC-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,1), IERR_MPI ) #endif #ifdef W3_MPIT STRT(10:10) = 'g' @@ -3146,7 +3146,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) ! #ifdef W3_MPI IOFF = 1 + (BISPL(IBFLOC)-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,1), STATUS, IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,1), STATUS, IERR_MPI ) #endif ! #ifdef W3_MPIT @@ -3181,7 +3181,7 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) BSTAT(IB0) = 1 BISPL(IB0) = IS0 IOFF = 1 + (IS0-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,1), IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,1), IERR_MPI ) NPST = NPST + 1 #endif #ifdef W3_MPIT @@ -3350,7 +3350,7 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) !/ ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif !/ !/ ------------------------------------------------------------------- / @@ -3366,9 +3366,8 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) INTEGER :: ISEA, IXY #endif #ifdef W3_MPI - INTEGER :: ISEA, IXY, IOFF, IERR_MPI, J, & - STATUS(MPI_STATUS_SIZE,NSPEC), & - JSEA, IB0 + INTEGER :: ISEA, IXY, IOFF, IERR_MPI, J, JSEA, IB0 + type(MPI_STATUS) :: STATUS(NSPEC) #endif #ifdef W3_S INTEGER, SAVE :: IENT @@ -3426,7 +3425,7 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) ! #ifdef W3_MPI IOFF = 1 + (ISPLOC-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF,2), IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_STARTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), IERR_MPI ) BSTAT(IBFLOC) = 2 #endif #ifdef W3_MPIT @@ -3457,12 +3456,12 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) IF ( BSTAT(IB0) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IB0)-1)*NRQSG2 IF ( NRQSG2 .GT. 0 ) THEN - CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF,2), DONE, STATUS, IERR_MPI ) + CALL MPI_TESTALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), DONE, STATUS, IERR_MPI ) ELSE DONE = .TRUE. END IF IF ( DONE .AND. NRQSG2.GT.0 ) THEN - CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), STATUS, IERR_MPI ) + CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), STATUS, IERR_MPI ) END IF IF ( DONE ) THEN BSTAT(IB0) = 0 @@ -3489,7 +3488,7 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) DO IB0=1, MPIBUF IF ( BSTAT(IB0) .EQ. 2 ) THEN IOFF = 1 + (BISPL(IB0)-1)*NRQSG2 - IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF,2), STATUS, IERR_MPI ) + IF ( NRQSG2 .GT. 0 ) CALL MPI_WAITALL ( NRQSG2, IRQSG2(IOFF:IOFF+NRQSG2-1,2), STATUS, IERR_MPI ) BSTAT(IB0) = 0 #endif #ifdef W3_MPIT diff --git a/model/src/w3wavset.F90 b/model/src/w3wavset.F90 index 2f77e8938f..f72d7836ee 100644 --- a/model/src/w3wavset.F90 +++ b/model/src/w3wavset.F90 @@ -1172,7 +1172,7 @@ SUBROUTINE TRIG_WAVE_SETUP_SCALAR_PROD(V1, V2, eScal) use yowNodepool, only: np, npa USE W3ODATMD, only : IAPROC, NAPROC, NTPROC USE W3GDATMD, ONLY: NSEAL - USE MPI, only : MPI_SUM + use mpi_f08, only : MPI_SUM IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / @@ -1432,7 +1432,7 @@ SUBROUTINE TRIG_SET_MEANVALUE_TO_ZERO(TheVar) USE W3ODATMD, only : IAPROC, NAPROC, NTPROC use yowDatapool, only: rtype, istatus use yowNodepool, only: np, npa - USE MPI, only : MPI_SUM + use mpi_f08, only : MPI_SUM IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / diff --git a/model/src/w3wdasmd.F90 b/model/src/w3wdasmd.F90 index 4acf37c79a..e313f8087d 100644 --- a/model/src/w3wdasmd.F90 +++ b/model/src/w3wdasmd.F90 @@ -200,11 +200,11 @@ SUBROUTINE W3WDAS ( DASFLAG, RECL, NDAT, DATA0, DATA1, DATA2 ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list diff --git a/model/src/wmesmfmd.F90 b/model/src/wmesmfmd.F90 index fbeb84a9ad..f3206485f7 100644 --- a/model/src/wmesmfmd.F90 +++ b/model/src/wmesmfmd.F90 @@ -199,13 +199,13 @@ module WMESMFMD !/ !/ Specify default data typing !/ - implicit none - !/ !/ Include MPI definitions !/ #ifdef W3_MPI - include "mpif.h" + use mpi_f08 #endif + !/ + implicit none !/ !/ Specify default accessibility !/ diff --git a/model/src/wmfinlmd.F90 b/model/src/wmfinlmd.F90 index 7217bdb2f5..8e7874b970 100644 --- a/model/src/wmfinlmd.F90 +++ b/model/src/wmfinlmd.F90 @@ -154,12 +154,12 @@ SUBROUTINE WMFINL #ifdef W3_MPRF USE W3TIMEMD, ONLY: PRTIME #endif - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list diff --git a/model/src/wmgridmd.F90 b/model/src/wmgridmd.F90 index 9c5c00cd78..2c5175cc24 100644 --- a/model/src/wmgridmd.F90 +++ b/model/src/wmgridmd.F90 @@ -244,11 +244,11 @@ SUBROUTINE WMGLOW ( FLRBPI ) USE WMMDATMD USE W3PARALL, ONLY : INIT_GET_JSEA_ISPROC ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1243,12 +1243,12 @@ SUBROUTINE WMGHGH USE WMSCRPMD USE SCRIP_INTERFACE #endif - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE ! !/ !/ ------------------------------------------------------------------- / @@ -1292,7 +1292,9 @@ SUBROUTINE WMGHGH INFLND(:,:) INTEGER, ALLOCATABLE :: NX_BEG(:), NX_END(:) #ifdef W3_MPIBDI - INTEGER, ALLOCATABLE :: NX_SIZE(:), IRQ(:), MSTAT(:,:) + INTEGER, ALLOCATABLE :: NX_SIZE(:) + type(MPI_REQUEST), ALLOCATABLE :: IRQ(:) + type(MPI_STATUS), ALLOCATABLE :: MSTAT(:) #endif #ifdef W3_MPI INTEGER :: IM, NX_REM, TAG, NRQ @@ -1445,7 +1447,7 @@ SUBROUTINE WMGHGH CHECK_ALLOC_STATUS ( ISTAT ) #ifdef W3_MPIBDI ALLOCATE ( NX_SIZE(NMPROC), IRQ(2*NMPROC), & - MSTAT(MPI_STATUS_SIZE,2*NMPROC), STAT=ISTAT ) + MSTAT(2*NMPROC), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) #endif ! @@ -5364,11 +5366,11 @@ SUBROUTINE WMSMCEQL USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -5382,7 +5384,7 @@ SUBROUTINE WMSMCEQL IP, NP, ICROOT, JCROOT, IEER #ifdef W3_MPI - INTEGER, Dimension(MPI_STATUS_SIZE):: MPIState + type(MPI_STATUS) :: MPIState #endif #ifdef W3_S diff --git a/model/src/wminiomd.F90 b/model/src/wminiomd.F90 index dba1be9ccf..8f9191b2e6 100644 --- a/model/src/wminiomd.F90 +++ b/model/src/wminiomd.F90 @@ -194,11 +194,11 @@ SUBROUTINE WMIOBS ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -214,7 +214,8 @@ SUBROUTINE WMIOBS ( IMOD ) #endif #ifdef W3_MPI INTEGER :: IP, IT0, ITAG, IERR_MPI - INTEGER, POINTER :: NRQ, IRQ(:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -305,7 +306,7 @@ SUBROUTINE WMIOBS ( IMOD ) ! #ifdef W3_MPI NRQ = 0 - IRQ = 0 + IRQ = MPI_REQUEST_NULL #endif ! ! -------------------------------------------------------------------- / @@ -596,11 +597,11 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -624,8 +625,9 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) #endif INTEGER, POINTER :: VTIME(:) #ifdef W3_MPI - INTEGER, POINTER :: NRQ, IRQ(:) - INTEGER, ALLOCATABLE :: STATUS(:,:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) + type(MPI_STATUS), ALLOCATABLE :: STATUS(:) #endif REAL :: DTTST, DT1, DT2, W1, W2 REAL, POINTER :: SBPI(:,:) @@ -738,7 +740,7 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) NRQ = NRGRD + SUM(NBI2G(IMOD,:)) ALLOCATE ( MDATAS(IMOD)%IRQBPG(NRQ) ) IRQ => MDATAS(IMOD)%IRQBPG - IRQ = 0 + IRQ = MPI_REQUEST_NULL NRQ = 0 #endif ! @@ -920,7 +922,7 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) #ifdef W3_MPI NRQ => MDATAS(IMOD)%NRQBPG IRQ => MDATAS(IMOD)%IRQBPG - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STATUS(NRQ) ) #endif ! ! ..... Test communication if DONE is present, wait otherwise @@ -937,7 +939,7 @@ SUBROUTINE WMIOBG ( IMOD, DONE ) #ifdef W3_MPIT ICOUNT = 0 DO I=1, NRQ - CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1,1), & + CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1), & IERR_MPI ) FLAGOK = FLAGOK .AND. FLAG IF ( FLAG ) ICOUNT = ICOUNT + 1 @@ -1283,11 +1285,12 @@ SUBROUTINE WMIOBF ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE + ! !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1300,8 +1303,9 @@ SUBROUTINE WMIOBF ( IMOD ) INTEGER :: J #ifdef W3_MPI INTEGER :: IERR_MPI - INTEGER, POINTER :: NRQ, IRQ(:) - INTEGER, ALLOCATABLE :: STATUS(:,:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) + type(MPI_STATUS), ALLOCATABLE :: STATUS(:) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -1337,7 +1341,7 @@ SUBROUTINE WMIOBF ( IMOD ) ! 1.b Wait for communication to end ! #ifdef W3_MPI - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STATUS(NRQ) ) CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) DEALLOCATE ( STATUS ) #endif @@ -1465,11 +1469,11 @@ SUBROUTINE WMIOHS ( IMOD ) USE W3TIMEMD, ONLY: DSEC21 USE W3PARALL, ONLY: INIT_GET_ISEA ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1488,7 +1492,8 @@ SUBROUTINE WMIOHS ( IMOD ) INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_MPI - INTEGER, POINTER :: NRQ, IRQ(:), NRQOUT, OUTDAT(:,:) + INTEGER, POINTER :: NRQ, NRQOUT, OUTDAT(:,:) + type(MPI_REQUEST), POINTER :: IRQ(:) #endif REAL :: DTOUTP #ifdef W3_SHRD @@ -1584,7 +1589,7 @@ SUBROUTINE WMIOHS ( IMOD ) OUTDAT => HGSTGE(J,IMOD)%OUTDAT NRQ = 0 NRQOUT = 0 - IRQ = 0 + IRQ = MPI_REQUEST_NULL #endif ! ! -------------------------------------------------------------------- / @@ -1813,11 +1818,11 @@ SUBROUTINE WMIOHG ( IMOD, DONE ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1839,7 +1844,9 @@ SUBROUTINE WMIOHG ( IMOD, DONE ) #endif INTEGER, POINTER :: VTIME(:) #ifdef W3_MPI - INTEGER, POINTER :: NRQ, IRQ(:), STATUS(:,:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) + type(MPI_STATUS), POINTER ::STATUS(:) #endif REAL :: DTTST, WGTH REAL, POINTER :: SPEC1(:,:), SPEC2(:,:), SPEC(:,:) @@ -1969,7 +1976,7 @@ SUBROUTINE WMIOHG ( IMOD, DONE ) END DO NRQ = MAX(1,NRQ) ALLOCATE ( IRQ(NRQ) ) - IRQ = 0 + IRQ = MPI_REQUEST_NULL NRQ = 0 #endif ! @@ -2098,7 +2105,7 @@ SUBROUTINE WMIOHG ( IMOD, DONE ) #ifdef W3_MPI NRQ => MDATAS(IMOD)%NRQHGG IRQ => MDATAS(IMOD)%IRQHGG - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STATUS(NRQ) ) #endif ! ! ..... Test communication if DONE is present, wait otherwise @@ -2115,7 +2122,7 @@ SUBROUTINE WMIOHG ( IMOD, DONE ) #ifdef W3_MPIT ICOUNT = 0 DO I=1, NRQ - CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1,1), & + CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1), & IERR_MPI ) FLAGOK = FLAGOK .AND. FLAG IF ( FLAG ) ICOUNT = ICOUNT + 1 @@ -2391,11 +2398,11 @@ SUBROUTINE WMIOHF ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2408,8 +2415,9 @@ SUBROUTINE WMIOHF ( IMOD ) INTEGER :: J #ifdef W3_MPI INTEGER :: IERR_MPI - INTEGER, POINTER :: NRQ, IRQ(:) - INTEGER, ALLOCATABLE :: STATUS(:,:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) + type(MPI_STATUS), ALLOCATABLE :: STATUS(:) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -2445,7 +2453,7 @@ SUBROUTINE WMIOHF ( IMOD ) ! 1.b Wait for communication to end ! #ifdef W3_MPI - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STATUS(NRQ) ) CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) DEALLOCATE ( STATUS ) #endif @@ -2574,11 +2582,11 @@ SUBROUTINE WMIOES ( IMOD ) #endif USE W3TIMEMD, ONLY: DSEC21 ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2596,7 +2604,8 @@ SUBROUTINE WMIOES ( IMOD ) INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_MPI - INTEGER, POINTER :: NRQ, IRQ(:), NRQOUT, OUTDAT(:,:) + INTEGER, POINTER :: NRQ, NRQOUT, OUTDAT(:,:) + type(MPI_REQUEST), POINTER :: IRQ(:) #endif #ifdef W3_SHRD REAL, POINTER :: SEQL(:,:,:) @@ -2667,7 +2676,7 @@ SUBROUTINE WMIOES ( IMOD ) OUTDAT => EQSTGE(J,IMOD)%OUTDAT NRQ = 0 NRQOUT = 0 - IRQ = 0 + IRQ = MPI_REQUEST_NULL #endif ! ! -------------------------------------------------------------------- / @@ -2909,11 +2918,11 @@ SUBROUTINE WMIOEG ( IMOD, DONE ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2937,7 +2946,9 @@ SUBROUTINE WMIOEG ( IMOD, DONE ) #endif INTEGER, POINTER :: VTIME(:) #ifdef W3_MPI - INTEGER, POINTER :: NRQ, IRQ(:), STATUS(:,:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) + type(MPI_STATUS), POINTER :: STATUS(:) #endif REAL :: DTTST, WGHT REAL, POINTER :: SPEC1(:,:), SPEC2(:,:), SPEC(:,:) @@ -3026,7 +3037,7 @@ SUBROUTINE WMIOEG ( IMOD, DONE ) EQSTGE(IMOD,J)%NAVMAX END DO ALLOCATE ( IRQ(NRQ) ) - IRQ = 0 + IRQ = MPI_REQUEST_NULL NRQ = 0 #endif ! @@ -3149,7 +3160,7 @@ SUBROUTINE WMIOEG ( IMOD, DONE ) #ifdef W3_MPI NRQ => MDATAS(IMOD)%NRQEQG IRQ => MDATAS(IMOD)%IRQEQG - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STATUS(NRQ) ) #endif ! ! ..... Test communication if DONE is present, wait otherwise @@ -3166,7 +3177,7 @@ SUBROUTINE WMIOEG ( IMOD, DONE ) #ifdef W3_MPIT ICOUNT = 0 DO I=1, NRQ - CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1,1), & + CALL MPI_TEST ( IRQ(I), FLAG, STATUS(1), & IERR_MPI ) FLAGOK = FLAGOK .AND. FLAG IF ( FLAG ) ICOUNT = ICOUNT + 1 @@ -3465,11 +3476,11 @@ SUBROUTINE WMIOEF ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -3482,8 +3493,9 @@ SUBROUTINE WMIOEF ( IMOD ) INTEGER :: J #ifdef W3_MPI INTEGER :: IERR_MPI - INTEGER, POINTER :: NRQ, IRQ(:) - INTEGER, ALLOCATABLE :: STATUS(:,:) + INTEGER, POINTER :: NRQ + type(MPI_REQUEST), POINTER :: IRQ(:) + type(MPI_STATUS), ALLOCATABLE :: STATUS(:) #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -3519,7 +3531,7 @@ SUBROUTINE WMIOEF ( IMOD ) ! 1.b Wait for communication to end ! #ifdef W3_MPI - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQ) ) + ALLOCATE ( STATUS(NRQ) ) CALL MPI_WAITALL ( NRQ, IRQ, STATUS, IERR_MPI ) DEALLOCATE ( STATUS ) #endif diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 521717818d..7d39b94d94 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -128,7 +128,7 @@ MODULE WMINITMD !> @author H. L. Tolman @date 22-Mar-2021 !> SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & - MPI_COMM, PREAMB ) + MPI_COMM_IN, PREAMB ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -437,18 +437,22 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & USE W3INITMD, ONLY: WWVER USE W3ODATMD, ONLY: OFILES ! +#ifdef W3_MPI + use mpi_f08 +#endif !/ IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: IDSI, IDSO, IDSS, IDST, IDSE, & - MPI_COMM + INTEGER, INTENT(IN) :: IDSI, IDSO, IDSS, IDST, IDSE +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN) :: MPI_COMM_IN +#else + INTEGER, INTENT(IN) :: MPI_COMM_IN +#endif CHARACTER*(*), INTENT(IN) :: IFNAME CHARACTER*(*), INTENT(IN), OPTIONAL :: PREAMB !/ @@ -459,13 +463,17 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ILOOP, MDSI2, SCRATCH, RNKMIN, & RNKMAX, RNKTMP, GRPMIN, GRPMAX, II, & NDSREC, NDSFND, NPTS, JJ, IP1, IPN, & - MPI_COMM_LOC, NMPSC2, JJJ, TOUT(2), & + NMPSC2, JJJ, TOUT(2), & TLST(2), NCPROC, NPOUTT, NAPLOC, & NAPRES, NAPADD, NAPBCT, IFI, IFJ, IW,& IFT INTEGER :: STMPT(2), ETMPT(2) #ifdef W3_MPI - INTEGER :: IERR_MPI, BGROUP, LGROUP, IROOT + type(MPI_COMM) :: MPI_COMM_LOC + INTEGER :: IERR_MPI, IROOT + type(MPI_GROUP) :: BGROUP, LGROUP +#else + INTEGER :: MPI_COMM_LOC #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -561,9 +569,9 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! CALL DATE_AND_TIME ( VALUES=CLKDT1 ) ! - MPI_COMM_LOC = MPI_COMM + MPI_COMM_LOC = MPI_COMM_IN #ifdef W3_MPI - MPI_COMM_MWAVE = MPI_COMM + MPI_COMM_MWAVE = MPI_COMM_IN CALL MPI_COMM_SIZE ( MPI_COMM_MWAVE, NMPROC, IERR_MPI ) CALL MPI_COMM_RANK ( MPI_COMM_MWAVE, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 @@ -3473,7 +3481,7 @@ END SUBROUTINE WMINIT !> @author H. L. Tolman @date 22-Mar-2021 !> SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & - MPI_COMM, PREAMB ) + MPI_COMM_IN, PREAMB ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -3781,18 +3789,22 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & #endif USE W3INITMD, ONLY: WWVER USE W3NMLMULTIMD +#ifdef W3_MPI + use mpi_f08 +#endif !/ IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: IDSI, IDSO, IDSS, IDST, IDSE, & - MPI_COMM + INTEGER, INTENT(IN) :: IDSI, IDSO, IDSS, IDST, IDSE +#ifdef W3_MPI + type(MPI_COMM), INTENT(IN) :: MPI_COMM_IN +#else + INTEGER, INTENT(IN) :: MPI_COMM_IN +#endif CHARACTER*(*), INTENT(IN) :: IFNAME CHARACTER*(*), INTENT(IN), OPTIONAL :: PREAMB !/ @@ -3818,7 +3830,7 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & INTEGER :: MDSE2, IERR, I,J,K, N_MOV, N_TOT, & SCRATCH, RNKMIN, RNKMAX, RNKTMP, & GRPMIN, GRPMAX, II, NDSREC, NDSFND, & - NPTS, JJ, IP1, IPN, MPI_COMM_LOC, & + NPTS, JJ, IP1, IPN, & NMPSC2, JJJ, NCPROC, NPOUTT, NAPLOC, & NAPRES, NAPADD, NAPBCT, IFI, IFJ, IW, & IFT, ILOOP @@ -3826,7 +3838,11 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & INTEGER :: TTIME(2), TOUT(2), STMPT(2), ETMPT(2),& TLST(2) #ifdef W3_MPI - INTEGER :: IERR_MPI, BGROUP, LGROUP, IROOT + INTEGER :: IERR_MPI, IROOT + type(MPI_GROUP) :: BGROUP, LGROUP + type(MPI_COMM) :: MPI_COMM_LOC +#else + INTEGER :: MPI_COMM_LOC #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -3923,9 +3939,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & ! CALL DATE_AND_TIME ( VALUES=CLKDT1 ) ! - MPI_COMM_LOC = MPI_COMM + MPI_COMM_LOC = MPI_COMM_IN #ifdef W3_MPI - MPI_COMM_MWAVE = MPI_COMM + MPI_COMM_MWAVE = MPI_COMM_IN CALL MPI_COMM_SIZE ( MPI_COMM_MWAVE, NMPROC, IERR_MPI ) CALL MPI_COMM_RANK ( MPI_COMM_MWAVE, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 @@ -3992,13 +4008,13 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & WRITE (MDSS,910) IFNAME, MDSI ! ! process ww3_multi namelist input - CALL W3NMLMULTIDEF (MPI_COMM, MDSI, TRIM(FNMPRE)//IFNAME, NML_DOMAIN, IERR) + CALL W3NMLMULTIDEF (MPI_COMM_IN, MDSI, TRIM(FNMPRE)//IFNAME, NML_DOMAIN, IERR) ALLOCATE(NML_INPUT_GRID(NML_DOMAIN%NRINP)) ALLOCATE(NML_MODEL_GRID(NML_DOMAIN%NRGRD)) ALLOCATE(NML_OUTPUT_TYPE(NML_DOMAIN%NRGRD)) ALLOCATE(NML_OUTPUT_DATE(NML_DOMAIN%NRGRD)) ! - CALL W3NMLMULTICONF (MPI_COMM, MDSI, TRIM(FNMPRE)//IFNAME, & + CALL W3NMLMULTICONF (MPI_COMM_IN, MDSI, TRIM(FNMPRE)//IFNAME, & NML_DOMAIN, NML_INPUT_GRID, NML_MODEL_GRID, NML_OUTPUT_TYPE, & NML_OUTPUT_DATE, NML_HOMOG_COUNT, NML_HOMOG_INPUT, IERR) IF (IERR.NE.0) THEN diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index 1737e04bbf..5d2c5fff1f 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -233,11 +233,11 @@ SUBROUTINE WMIOPP ( NPT, XPT, YPT, PNAMES ) USE WMMDATMD, ONLY: MPI_COMM_GRD, MPI_COMM_MWAVE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -731,13 +731,13 @@ SUBROUTINE WMIOPO ( TOUT ) #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE +#endif +#ifdef W3_MPI + use mpi_f08 #endif ! IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -754,7 +754,7 @@ SUBROUTINE WMIOPO ( TOUT ) #endif #ifdef W3_MPI INTEGER :: IERR_MPI, NMPPNT - INTEGER, ALLOCATABLE :: STATUS(:,:) + type(MPI_STATUS) :: STATUS #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -1026,7 +1026,7 @@ SUBROUTINE WMIOPO ( TOUT ) IT0 = MTAG0 - 7*NRGRD - 1 IT = IT0 + (J-1)*7 IFROM = NMPPNT - 1 - ALLOCATE ( SPCR(NSPEC,NOPTS), STATUS(MPI_STATUS_SIZE,1), & + ALLOCATE ( SPCR(NSPEC,NOPTS), & DPR(NOPTS), WAR(NOPTS), WDR(NOPTS), ASR(NOPTS),& CAR(NOPTS), CDR(NOPTS), ICRO(NOPTS), & ICRFO(NOPTS), ICRHO(NOPTS) ) @@ -1153,7 +1153,7 @@ SUBROUTINE WMIOPO ( TOUT ) ! #ifdef W3_MPI IF ( RESPEC(0,J) ) DEALLOCATE ( SPEC ) - DEALLOCATE ( SPCR, DPR, WAR, WDR, ASR, CAR, CDR, STATUS ) + DEALLOCATE ( SPCR, DPR, WAR, WDR, ASR, CAR, CDR) #endif ! !JDM add deallocates here and check the itag stuff.. really not ! sure aabout that diff --git a/model/src/wmmdatmd.F90 b/model/src/wmmdatmd.F90 index 94aa7a7a97..8800fbe8fc 100644 --- a/model/src/wmmdatmd.F90 +++ b/model/src/wmmdatmd.F90 @@ -297,6 +297,9 @@ MODULE WMMDATMD ! !/ ------------------------------------------------------------------- / !/ +#ifdef W3_MPI + use mpi_f08, only: MPI_COMM, MPI_REQUEST +#endif !/ Specify default accessibility !/ PUBLIC @@ -341,7 +344,7 @@ MODULE WMMDATMD INTEGER :: MDSP !< MDSP #endif #ifdef W3_MPI - INTEGER :: MPI_COMM_MWAVE !< MPI_COMM_MWAVE + type(MPI_COMM) :: MPI_COMM_MWAVE !< MPI_COMM_MWAVE INTEGER, PARAMETER :: MTAGB = 0 !< MTAGB INTEGER, PARAMETER :: MTAG0 = 1000 !< MTAG0 INTEGER, PARAMETER :: MTAG1 = 40000 !< MTAG1 @@ -394,8 +397,8 @@ MODULE WMMDATMD INTEGER :: NRUPTS !< NRUPTS #ifdef W3_MPI - INTEGER :: MPI_COMM_GRD !< MPI_COMM_GRD - INTEGER :: MPI_COMM_BCT !< MPI_COMM_BCT + type(MPI_COMM) :: MPI_COMM_GRD !< MPI_COMM_GRD + type(MPI_COMM) :: MPI_COMM_BCT !< MPI_COMM_BCT INTEGER :: CROOT !< CROOT INTEGER :: NRQBPG !< NRQBPG INTEGER :: NRQHGG !< NRQHGG @@ -407,9 +410,9 @@ MODULE WMMDATMD INTEGER, POINTER :: UPTMAP(:) !< UPTMAP #ifdef W3_MPI - INTEGER, POINTER :: IRQBPG(:) !< IRQBPG - INTEGER, POINTER :: IRQHGG(:) !< IRQHGG - INTEGER, POINTER :: IRQEQG(:) !< IRQEQG + type(MPI_REQUEST), POINTER :: IRQBPG(:) !< IRQBPG + type(MPI_REQUEST), POINTER :: IRQHGG(:) !< IRQHGG + type(MPI_REQUEST), POINTER :: IRQEQG(:) !< IRQEQG #endif REAL, POINTER :: DATA0(:,:) !< DATA0 REAL, POINTER :: DATA1(:,:) !< DATA1 @@ -446,7 +449,7 @@ MODULE WMMDATMD #endif INTEGER :: VTIME(2) !< VTIME #ifdef W3_MPI - INTEGER, POINTER :: IRQBPS(:) !< IRQBPS + type(MPI_REQUEST), POINTER :: IRQBPS(:) !< IRQBPS #endif REAL, POINTER :: SBPI(:,:) !< SBPI #ifdef W3_MPI @@ -475,7 +478,7 @@ MODULE WMMDATMD INTEGER, POINTER :: ITAG(:,:) !< ITAG INTEGER, POINTER :: ISEND(:,:) !< ISEND #ifdef W3_MPI - INTEGER, POINTER :: IRQHGS(:) !< IRQHGS + type(MPI_REQUEST), POINTER :: IRQHGS(:) !< IRQHGS INTEGER, POINTER :: OUTDAT(:,:) !< OUTDAT #endif REAL, POINTER :: WGTH(:,:) !< WGTH @@ -511,7 +514,7 @@ MODULE WMMDATMD INTEGER, POINTER :: STG(:) !< STG #ifdef W3_MPI - INTEGER, POINTER :: IRQEQS(:) !< IRQEQS + type(MPI_REQUEST), POINTER :: IRQEQS(:) !< IRQEQS INTEGER, POINTER :: OUTDAT(:,:) !< OUTDAT #endif REAL, POINTER :: SEQL(:,:,:) !< SEQL @@ -540,8 +543,8 @@ MODULE WMMDATMD INTEGER, POINTER :: MAPMSK(:,:) !< MAPMSK INTEGER, POINTER :: UPTMAP(:) !< UPTMAP #ifdef W3_MPI - INTEGER, POINTER :: MPI_COMM_GRD !< MPI_COMM_GRD - INTEGER, POINTER :: MPI_COMM_BCT !< MPI_COMM_BCT + type(MPI_COMM), POINTER :: MPI_COMM_GRD !< MPI_COMM_GRD + type(MPI_COMM), POINTER :: MPI_COMM_BCT !< MPI_COMM_BCT INTEGER, POINTER :: CROOT !< CROOT #endif REAL, POINTER :: DATA0(:,:) !< DATA0 @@ -707,8 +710,8 @@ SUBROUTINE WMNDAT ( NDSE, NDST ) MDATAS(I)%FLDAT1 = .FALSE. MDATAS(I)%FLDAT2 = .FALSE. #ifdef W3_MPI - MDATAS(I)%MPI_COMM_GRD = -99 - MDATAS(I)%MPI_COMM_BCT = -99 + MDATAS(I)%MPI_COMM_GRD%mpi_val = -99 + MDATAS(I)%MPI_COMM_BCT%mpi_val = -99 #endif DO J=1, NGRIDS BPSTGE(I,J)%VTIME(1) = -1 diff --git a/model/src/wmwavemd.F90 b/model/src/wmwavemd.F90 index 7bab3259f4..eefc411efb 100644 --- a/model/src/wmwavemd.F90 +++ b/model/src/wmwavemd.F90 @@ -252,12 +252,12 @@ SUBROUTINE WMWAVE ( TEND ) #ifdef W3_MPRF USE WMMDATMD, ONLY: MDSP #endif - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -278,7 +278,7 @@ SUBROUTINE WMWAVE ( TEND ) #endif #ifdef W3_MPI INTEGER :: IERR_MPI, NMPSCS - INTEGER, ALLOCATABLE :: STATUS(:,:) + type(MPI_STATUS), ALLOCATABLE :: STATUS(:) #endif REAL :: DTTST, DTMAXI #ifdef W3_MPRF @@ -1368,7 +1368,7 @@ SUBROUTINE WMWAVE ( TEND ) ! #ifdef W3_MPI IF ( NRQPO .NE. 0 ) THEN - ALLOCATE ( STATUS(MPI_STATUS_SIZE,NRQPO) ) + ALLOCATE ( STATUS(NRQPO) ) CALL MPI_WAITALL & ( NRQPO, IRQPO1, STATUS, IERR_MPI ) DEALLOCATE ( STATUS ) @@ -2013,11 +2013,11 @@ SUBROUTINE WMBCST ( DATA, NR, IMOD, NMOD, ID ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2029,8 +2029,8 @@ SUBROUTINE WMBCST ( DATA, NR, IMOD, NMOD, ID ) !/ Local parameters !/ #ifdef W3_MPI - INTEGER :: ITAG, IP, IERR_MPI, & - STATUS(MPI_STATUS_SIZE) + INTEGER :: ITAG, IP, IERR_MPI + type(MPI_STATUS) :: STATUS #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -2200,11 +2200,11 @@ SUBROUTINE WMWOUT ( IMOD, NMOD, ID ) USE W3SERVMD, ONLY: STRACE #endif ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list @@ -2215,8 +2215,8 @@ SUBROUTINE WMWOUT ( IMOD, NMOD, ID ) !/ Local parameters !/ #ifdef W3_MPI - INTEGER :: ITAG, IP, IERR_MPI, & - STATUS(MPI_STATUS_SIZE) + INTEGER :: ITAG, IP, IERR_MPI + type(MPI_STATUS) :: STATUS #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 diff --git a/model/src/ww3_bounc.F90 b/model/src/ww3_bounc.F90 index 5791f074b9..6dfadaac27 100644 --- a/model/src/ww3_bounc.F90 +++ b/model/src/ww3_bounc.F90 @@ -154,13 +154,12 @@ PROGRAM W3BOUNC #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif - +#ifdef W3_MPI + use mpi_f08 +#endif !/ IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters diff --git a/model/src/ww3_bound.F90 b/model/src/ww3_bound.F90 index 96df088a88..2670b83513 100644 --- a/model/src/ww3_bound.F90 +++ b/model/src/ww3_bound.F90 @@ -133,12 +133,12 @@ PROGRAM W3BOUND #ifdef W3_S USE W3SERVMD, ONLY : STRACE #endif - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters diff --git a/model/src/ww3_multi.F90 b/model/src/ww3_multi.F90 index e3101b7c2a..388ea362b0 100644 --- a/model/src/ww3_multi.F90 +++ b/model/src/ww3_multi.F90 @@ -95,21 +95,24 @@ PROGRAM W3MLTI USE OMP_LIB #endif !/ - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: I, MPI_COMM = -99 + INTEGER :: I INTEGER, ALLOCATABLE :: TEND(:,:) LOGICAL :: FLGNML #ifdef W3_MPI + type(MPI_COMM) :: MPICOMM INTEGER :: IERR_MPI LOGICAL :: FLHYBR = .FALSE. +#else + INTEGER :: MPICOMM #endif #ifdef W3_OMPH INTEGER :: THRLEV @@ -135,10 +138,12 @@ PROGRAM W3MLTI ENDIF #endif #ifdef W3_MPI - MPI_COMM = MPI_COMM_WORLD - CALL MPI_COMM_SIZE ( MPI_COMM, NMPROC, IERR_MPI ) - CALL MPI_COMM_RANK ( MPI_COMM, IMPROC, IERR_MPI ) + MPICOMM = MPI_COMM_WORLD + CALL MPI_COMM_SIZE ( MPICOMM, NMPROC, IERR_MPI ) + CALL MPI_COMM_RANK ( MPICOMM, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 +#else + MPICOMM=0 #endif ! ! 0.c Identifying output to "screen" unit @@ -161,24 +166,24 @@ PROGRAM W3MLTI ! ! ... Log and screen output, no separate test output file ! - ! CALL WMINIT ( MDSI, MDSO, MDSS, MDST, MDSE, 'ww3_multi.inp', MPI_COMM ) + ! CALL WMINIT ( MDSI, MDSO, MDSS, MDST, MDSE, 'ww3_multi.inp', MPICOMM ) ! ! ... Screen output disabled ! - ! CALL WMINIT ( MDSI, MDSO, MDSO, MDST, MDSE, 'ww3_multi.inp', MPI_COMM ) + ! CALL WMINIT ( MDSI, MDSO, MDSO, MDST, MDSE, 'ww3_multi.inp', MPICOMM ) ! ! ... Separate test output file and file preamble defined ! - ! CALL WMINIT ( MDSI, MDSO, MDSS, 10, MDSE, 'ww3_multi.inp', MPI_COMM, & + ! CALL WMINIT ( MDSI, MDSO, MDSS, 10, MDSE, 'ww3_multi.inp', MPICOMM, & ! './data/' ) ! ! ... Separate test output file ! INQUIRE(FILE="ww3_multi.nml", EXIST=FLGNML) IF (FLGNML) THEN - CALL WMINITNML ( MDSI, MDSO, MDSS, 10, MDSE, 'ww3_multi.nml', MPI_COMM ) + CALL WMINITNML ( MDSI, MDSO, MDSS, 10, MDSE, 'ww3_multi.nml', MPICOMM ) ELSE - CALL WMINIT ( MDSI, MDSO, MDSS, 10, MDSE, 'ww3_multi.inp', MPI_COMM ) + CALL WMINIT ( MDSI, MDSO, MDSS, 10, MDSE, 'ww3_multi.inp', MPICOMM ) END IF ! @@ -207,7 +212,7 @@ PROGRAM W3MLTI IF ( IMPROC .EQ. NMPSCR ) WRITE (*,999) ! #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( MPICOMM, IERR_MPI ) CALL MPI_FINALIZE ( IERR_MPI ) #endif ! diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index be255f76f2..8e35c78348 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -216,11 +216,11 @@ PROGRAM W3OUNP USE W3NMLOUNPMD USE NETCDF ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index 9a8d9a9948..960409d220 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -227,12 +227,11 @@ PROGRAM W3PRNC USE W3TIMEMD USE W3NMLPRNCMD USE NETCDF - ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters diff --git a/model/src/ww3_prtide.F90 b/model/src/ww3_prtide.F90 index 230a30b764..daa4bb9e19 100644 --- a/model/src/ww3_prtide.F90 +++ b/model/src/ww3_prtide.F90 @@ -141,11 +141,11 @@ PROGRAM W3PRTIDE USE W3TIDEMD USE W3IDATMD ! - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters diff --git a/model/src/ww3_sbs1.F90 b/model/src/ww3_sbs1.F90 index 23ae621e3f..f5ddd5db95 100644 --- a/model/src/ww3_sbs1.F90 +++ b/model/src/ww3_sbs1.F90 @@ -178,21 +178,21 @@ PROGRAM W3SBS1 !/ USE WMMDATMD, ONLY: MDSE, MDST, MDSS, NMPROC, IMPROC, NMPSCR, & NRGRD, STIME, ETIME - !/ - IMPLICIT NONE ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + !/ + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: MPI_COMM = -99, IERR, NDST1, NDST2 = -1,& - NXW = -1, NYW = -1, TNEXT(2), TOLD(2), & - I + INTEGER :: IERR, NDST1, NDST2 = -1,& + NXW = -1, NYW = -1, TNEXT(2), TOLD(2), I #ifdef W3_MPI INTEGER :: IERR_MPI + type(MPI_COMM) :: mpicomm #endif INTEGER, PARAMETER :: SLEEP1 = 10 , SLEEP2 = 10 INTEGER, ALLOCATABLE :: TEND(:,:) @@ -209,9 +209,9 @@ PROGRAM W3SBS1 ! #ifdef W3_MPI CALL MPI_INIT ( IERR_MPI ) - MPI_COMM = MPI_COMM_WORLD - CALL MPI_COMM_SIZE ( MPI_COMM, NMPROC, IERR_MPI ) - CALL MPI_COMM_RANK ( MPI_COMM, IMPROC, IERR_MPI ) + mpicomm = MPI_COMM_WORLD + CALL MPI_COMM_SIZE ( mpicomm, NMPROC, IERR_MPI ) + CALL MPI_COMM_RANK ( mpicomm, IMPROC, IERR_MPI ) IMPROC = IMPROC + 1 #endif ! @@ -238,7 +238,7 @@ PROGRAM W3SBS1 ! ! ... Separate test output file ! - CALL WMINIT ( 8, 9, 6, 10, 6, 'ww3_multi.inp', MPI_COMM ) + CALL WMINIT ( 8, 9, 6, 10, 6, 'ww3_multi.inp', mpicomm ) ! !/ ------------------------------------------------------------------- / ! 2. Setting up test files @@ -326,7 +326,7 @@ PROGRAM W3SBS1 END DO ! #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( mpicomm, IERR_MPI ) #endif CALL WMWAVE ( TEND ) ! @@ -348,7 +348,7 @@ PROGRAM W3SBS1 IF ( IMPROC .EQ. NMPSCR ) WRITE (*,999) ! #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( mpicomm, IERR_MPI ) CALL MPI_FINALIZE ( IERR_MPI ) #endif ! diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index 2065913752..a49e8c1b24 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -308,11 +308,11 @@ PROGRAM W3SHEL #ifdef W3_OMPG USE OMP_LIB #endif - IMPLICIT NONE - ! #ifdef W3_MPI - INCLUDE "mpif.h" + use mpi_f08 #endif + ! + IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Local PARAMETER statements @@ -332,8 +332,7 @@ PROGRAM W3SHEL ! INTEGER :: NDSI, NDSI2, NDSS, NDSO, NDSE, NDST, NDSL,& NDSEN, IERR, J, I, ILOOP, IPTS, NPTS, & - NDTNEW, MPI_COMM = -99, & - FLAGTIDE, COUPL_COMM, IH, N_TOT + NDTNEW, FLAGTIDE, IH, N_TOT INTEGER :: NDSF(-7:9), NDS(15), NTRACE(2), NDT(7:9), & TIME0(2), TIMEN(2), TTIME(2), TTT(2), & NH(-7:10), THO(2,-7:10,NHMAX), RCLD(7:9), & @@ -395,7 +394,11 @@ PROGRAM W3SHEL #endif character(len=10) :: jchar integer :: memunit - +#ifdef W3_MPI + type(MPI_COMM) :: MPICOMM +#else + INTEGER :: MPICOMM = -99 +#endif ! !/ !/ ------------------------------------------------------------------- / @@ -465,7 +468,7 @@ PROGRAM W3SHEL #ifdef W3_OASIS IF (OASISED.EQ.1) THEN - CALL CPL_OASIS_INIT(MPI_COMM) + CALL CPL_OASIS_INIT(MPICOMM) ELSE #endif #ifdef W3_OMPH @@ -482,7 +485,7 @@ PROGRAM W3SHEL #endif #ifdef W3_MPI - MPI_COMM = MPI_COMM_WORLD + MPICOMM = MPI_COMM_WORLD #endif #ifdef W3_OASIS END IF @@ -490,8 +493,8 @@ PROGRAM W3SHEL ! ! #ifdef W3_MPI - CALL MPI_COMM_SIZE ( MPI_COMM, NAPROC, IERR_MPI ) - CALL MPI_COMM_RANK ( MPI_COMM, IAPROC, IERR_MPI ) + CALL MPI_COMM_SIZE ( MPICOMM, NAPROC, IERR_MPI ) + CALL MPI_COMM_RANK ( MPICOMM, IAPROC, IERR_MPI ) IAPROC = IAPROC + 1 #endif memunit = 740+IAPROC @@ -689,7 +692,7 @@ PROGRAM W3SHEL INQUIRE(FILE=TRIM(FNMPRE)//"ww3_shel.nml", EXIST=FLGNML) IF (FLGNML) THEN ! Read namelist - CALL W3NMLSHEL (MPI_COMM, NDSI, TRIM(FNMPRE)//'ww3_shel.nml', & + CALL W3NMLSHEL (MPICOMM, NDSI, TRIM(FNMPRE)//'ww3_shel.nml', & NML_DOMAIN, NML_INPUT, NML_OUTPUT_TYPE, & NML_OUTPUT_DATE, NML_OUTPUT_PATH, NML_HOMOG_COUNT, & NML_HOMOG_INPUT, IERR) @@ -950,7 +953,7 @@ PROGRAM W3SHEL CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDOUT, FLGD, & FLGRD, IAPROC, NAPOUT, IERR ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! Type 2: point output ELSE IF ( J .EQ. 2 ) THEN @@ -1060,7 +1063,7 @@ PROGRAM W3SHEL CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDOUT, FLG2, & FLGR2, IAPROC, NAPOUT, IERR ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) FLDIN = NML_OUTPUT_TYPE%COUPLING%RECEIVED CPLT0 = NML_OUTPUT_TYPE%COUPLING%COUPLET0 #endif @@ -1074,7 +1077,7 @@ PROGRAM W3SHEL CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDRST, FLOGR, & FLOGRR, IAPROC, NAPOUT, IERR ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! force minimal allocation to avoid memory seg fault IF ( .NOT.ALLOCATED(X) .AND. NPTS.EQ.0 ) ALLOCATE ( X(1), Y(1), PNAMES(1) ) @@ -1387,7 +1390,7 @@ PROGRAM W3SHEL CALL W3FLGRDFLAG ( NDSO, NDSO, NDSE, FLDRST, FLOGR, & FLOGRR, IAPROC, NAPOUT, IERR ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ELSE ! !INLINE NEW VARIABLE TO READ IF PRESENT OFILES(J), IF NOT ==0 @@ -1459,7 +1462,7 @@ PROGRAM W3SHEL CALL W3READFLGRD ( NDSI, NDSO, 9, NDSEN, COMSTR, FLGD, & FLGRD, IAPROC, NAPOUT, IERR ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! Type 2: point output ELSE IF ( J .EQ. 2 ) THEN @@ -1471,7 +1474,7 @@ PROGRAM W3SHEL ELSE NDSI2 = NDSS #ifdef W3_MPI - CALL MPI_BARRIER (MPI_COMM,IERR_MPI) + CALL MPI_BARRIER (MPICOMM,IERR_MPI) #endif OPEN (NDSS,FILE=TRIM(FNMPRE)//'ww3_shel.scratch') REWIND (NDSS) @@ -1529,13 +1532,13 @@ PROGRAM W3SHEL WRITE (NDSO,2947) IF ( IAPROC .EQ. 1 ) THEN #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( mpicomm, IERR_MPI ) #endif CLOSE (NDSS,STATUS='DELETE') ELSE CLOSE (NDSS) #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( MPICOMM, IERR_MPI ) #endif END IF ! @@ -1574,7 +1577,7 @@ PROGRAM W3SHEL CALL W3READFLGRD ( NDSI, NDSO, NDSS, NDSEN, COMSTR, FLG2, & FLGR2, IAPROC, NAPOUT, IERR ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) CALL NEXTLN ( COMSTR , NDSI , NDSEN ) READ (NDSI,'(A)',IOSTAT=IERR) FLDIN IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3SHEL','INPUT',1001) @@ -1730,7 +1733,7 @@ PROGRAM W3SHEL NDSEN, NX, NY, GTYPE, & IERR, FPRE=TRIM(FNMPRE), TIDEFLAGIN=FLAGTIDE ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) #ifdef W3_TIDE IF (FLAGTIDE.GT.0.AND.J.EQ.1) FLAGSTIDE(1)=.TRUE. IF (FLAGTIDE.GT.0.AND.J.EQ.2) FLAGSTIDE(2)=.TRUE. @@ -1748,7 +1751,7 @@ PROGRAM W3SHEL RCLD(J), NY, NODATA(J), & IERR, FPRE=TRIM(FNMPRE) ) IF ( IERR .NE. 0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,956) IDFLDS(J),& RCLD(J), NODATA(J) ELSE @@ -1941,7 +1944,7 @@ PROGRAM W3SHEL OARST = ANY(FLOGR) ! CALL W3INIT ( 1, .FALSE., 'ww3', NDS, NTRACE, ODAT, FLGRD, FLGR2, FLGD, & - FLG2, NPTS, X, Y, PNAMES, IPRT, PRTFRM, MPI_COMM, & + FLG2, NPTS, X, Y, PNAMES, IPRT, PRTFRM, MPICOMM, & FLAGSTIDEIN=FLAGSTIDE ) ! ! IF (MINVAL(VA) .LT. 0.) THEN @@ -1966,7 +1969,7 @@ PROGRAM W3SHEL ALLOCATE ( XXX(NX,NY) ) ! #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( MPICOMM, IERR_MPI ) #endif ! IF ( IAPROC .EQ. NAPOUT ) THEN @@ -1983,7 +1986,7 @@ PROGRAM W3SHEL ENDIF ! Estimate the weights for the spatial interpolation IF (DTOUT(7).NE.0) THEN - CALL CPL_OASIS_GRID(L_MASTER,MPI_COMM) + CALL CPL_OASIS_GRID(L_MASTER,MPICOMM) CALL CPL_OASIS_DEFINE(NDSO, FLDIN, FLDOUT) END IF #endif @@ -2008,11 +2011,11 @@ PROGRAM W3SHEL IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,960) CALL W3WAVE ( 1, ODAT, TIMEN & #ifdef W3_OASIS - , .TRUE., .FALSE., MPI_COMM, TIMEN & + , .TRUE., .FALSE., MPICOMM, TIMEN & #endif ) ! - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! END IF !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2132,9 +2135,6 @@ PROGRAM W3SHEL TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& TTT, XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, IERR) ELSE -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASICM IF (FLAGSC(J)) FLAGSCI = .TRUE. IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 @@ -2144,7 +2144,7 @@ PROGRAM W3SHEL TTT, XXX, XXX, XXX, TI1, XXX, XXX, ICEP1, & IERR, FLAGSC(J) & #ifdef W3_OASICM - , COUPL_COMM & + , MPICOMM & #endif ) END IF @@ -2199,9 +2199,6 @@ PROGRAM W3SHEL TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& TTT, XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, IERR) ELSE -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASICM IF (FLAGSC(J)) FLAGSCI = .TRUE. IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 @@ -2211,7 +2208,7 @@ PROGRAM W3SHEL TTT, XXX, XXX, XXX, TI5, XXX, XXX, ICEP5, & IERR, FLAGSC(J) & #ifdef W3_OASICM - , COUPL_COMM & + , MPICOMM & #endif ) END IF @@ -2276,9 +2273,6 @@ PROGRAM W3SHEL END IF ELSE #endif -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASOCM IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif @@ -2287,7 +2281,7 @@ PROGRAM W3SHEL TTT, XXX, XXX, XXX, TLN, XXX, XXX, WLEV, & IERR, FLAGSC(J) & #ifdef W3_OASOCM - , COUPL_COMM & + , MPICOMM & #endif ) #ifdef W3_TIDE @@ -2324,9 +2318,6 @@ PROGRAM W3SHEL CALL TICK21 ( TCN, TIDE_DT ) ELSE #endif -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASOCM IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif @@ -2335,7 +2326,7 @@ PROGRAM W3SHEL TC0, CX0, CY0, XXX, TCN, CXN, CYN, XXX, & IERR, FLAGSC(J) & #ifdef W3_OASOCM - , COUPL_COMM & + , MPICOMM & #endif ) #ifdef W3_TIDE @@ -2360,9 +2351,6 @@ PROGRAM W3SHEL !!Li #endif ELSE -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASACM IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif @@ -2371,7 +2359,7 @@ PROGRAM W3SHEL TW0, WX0, WY0, DT0, TWN, WXN, WYN, DTN, & IERR, FLAGSC(J) & #ifdef W3_OASACM - , COUPL_COMM & + , MPICOMM & #endif ) END IF @@ -2383,9 +2371,6 @@ PROGRAM W3SHEL TIME0, TIMEN, NH(J), NHMAX, THO, HA, HD, HS,& TTT, XXX, XXX, XXX, TIN, XXX, BERGI, ICEI, IERR) ELSE -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASICM IF (FLAGSC(J)) FLAGSCI = .TRUE. IF (.NOT.FLAGSCI) ID_OASIS_TIME = -1 @@ -2395,7 +2380,7 @@ PROGRAM W3SHEL TTT, XXX, XXX, XXX, TIN, XXX, BERGI, ICEI, & IERR, FLAGSC(J) & #ifdef W3_OASICM - , COUPL_COMM & + , MPICOMM & #endif ) IF ( IERR .LT. 0 ) FLLSTI = .TRUE. @@ -2419,9 +2404,6 @@ PROGRAM W3SHEL !!Li #endif ELSE -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASACM IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif @@ -2430,7 +2412,7 @@ PROGRAM W3SHEL TU0, UX0, UY0, XXX, TUN, UXN, UYN, XXX, & IERR, FLAGSC(J) & #ifdef W3_OASACM - , COUPL_COMM & + , MPICOMM & #endif ) END IF @@ -2451,9 +2433,6 @@ PROGRAM W3SHEL !!Li #endif ELSE -#ifdef W3_OASIS - COUPL_COMM = MPI_COMM -#endif #ifdef W3_OASACM IF (.NOT.FLAGSC(J)) ID_OASIS_TIME = -1 #endif @@ -2462,7 +2441,7 @@ PROGRAM W3SHEL TR0, XXX, XXX, RH0, TRN, XXX, XXX, RHN, & IERR, FLAGSC(J) & #ifdef W3_OASACM - , COUPL_COMM & + , MPICOMM & #endif ) IF ( IERR .LT. 0 ) FLLSTR = .TRUE. @@ -2527,7 +2506,7 @@ PROGRAM W3SHEL END IF ! IF ( IERR.GT.0 ) & - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) IF ( IERR.LT.0 .AND. IAPROC.EQ.NAPOUT ) WRITE (NDSO,973) IDFLDS(J) @@ -2604,7 +2583,7 @@ PROGRAM W3SHEL ! CALL W3WAVE ( 1, ODAT, TIME0 & #ifdef W3_OASIS - , .TRUE., .FALSE., MPI_COMM, TIMEN & + , .TRUE., .FALSE., MPICOMM, TIMEN & #endif ) call print_memcheck(memunit, 'memcheck_____:'//' WW3_SHEL SECTION 9') @@ -2647,7 +2626,7 @@ PROGRAM W3SHEL IF ( IAPROC .EQ. NAPOUT ) WRITE (NDSO,*) ' ' CALL W3WAVE ( 1, ODAT, TIME0 & #ifdef W3_OASIS - , .TRUE., .FALSE., MPI_COMM, TIMEN & + , .TRUE., .FALSE., MPICOMM, TIMEN & #endif ) END IF @@ -2663,7 +2642,7 @@ PROGRAM W3SHEL !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! End of shel ! - CALL FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) + CALL FINALISE(MPICOMM, IERR_MPI, NDSO, NDS(1), CLKDT1, CLKDT2) ! ! Formats ! @@ -2854,7 +2833,7 @@ PROGRAM W3SHEL !> !> @author J.M. Castillo !> @date 04-Jun-2025 - SUBROUTINE FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS, CLKDT1, CLKDT2) + SUBROUTINE FINALISE(MPICOMM_IN, IERR_MPI, NDSO, NDS, CLKDT1, CLKDT2) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -2877,7 +2856,7 @@ SUBROUTINE FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS, CLKDT1, CLKDT2) ! ! Parameter list ! ---------------------------------------------------------------- - ! MPI_COMM Int. I MPI communicator + ! MPICOMM_IN Int. I MPI communicator ! IERR_MPI Int. O MPI error code ! NDSO Int. I Output unit number ! NDS Int. I Dataset unit number @@ -2904,7 +2883,11 @@ SUBROUTINE FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS, CLKDT1, CLKDT2) IMPLICIT NONE ! Parameter list - INTEGER, INTENT(IN) :: MPI_COMM +#ifdef W3_MPI + type(MPI_COMM),INTENT(IN) :: MPICOMM_IN +#else + INTEGER, INTENT(IN) :: MPICOMM_IN +#endif INTEGER, INTENT(OUT) :: IERR_MPI INTEGER, INTENT(IN) :: NDSO INTEGER, INTENT(IN) :: NDS @@ -2915,7 +2898,9 @@ SUBROUTINE FINALISE(MPI_COMM, IERR_MPI, NDSO, NDS, CLKDT1, CLKDT2) INTEGER :: CLKDT3(8) #ifdef W3_MPI - CALL MPI_BARRIER ( MPI_COMM, IERR_MPI ) + CALL MPI_BARRIER ( MPICOMM_IN, IERR_MPI ) +#else + IERR_MPI=0 #endif ! IF ( IAPROC .EQ. NAPOUT ) THEN diff --git a/model/src/ww3_strt.F90 b/model/src/ww3_strt.F90 index 30ed53821b..63139d6513 100644 --- a/model/src/ww3_strt.F90 +++ b/model/src/ww3_strt.F90 @@ -242,13 +242,13 @@ PROGRAM W3STRT NAPOUT, NAPERR, FNMPRE #ifdef W3_WRST USE W3IDATMD, ONLY: W3NINP +#endif +#ifdef W3_MPI + use mpi_f08 #endif !/ IMPLICIT NONE ! -#ifdef W3_MPI - INCLUDE "mpif.h" -#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters diff --git a/model/src/ww3_systrk.F90 b/model/src/ww3_systrk.F90 index 2766b67262..6635f1e867 100644 --- a/model/src/ww3_systrk.F90 +++ b/model/src/ww3_systrk.F90 @@ -58,11 +58,10 @@ PROGRAM WW3_SYSTRK !/ USE W3STRKMD USE W3TIMEMD, ONLY: TDIFF - IMPLICIT NONE #ifdef W3_MPI - - INCLUDE "mpif.h" + use mpi_f08 #endif + IMPLICIT NONE ! ! 1. Purpose : ! From 50eeafba11c367026c6f0de5ae50f2bd3e6d6911 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Thu, 16 Oct 2025 14:39:25 -0400 Subject: [PATCH 106/136] resolve compiler remarks in w3bullmd.F90 w3cspcmd.F90 w3dispmd.F90 w3fld1md.F90 w3fld2md.F90 (#1506) --- model/src/w3bullmd.F90 | 8 +++----- model/src/w3cspcmd.F90 | 3 +-- model/src/w3dispmd.F90 | 6 ++---- model/src/w3fld1md.F90 | 16 +++++----------- model/src/w3fld2md.F90 | 22 +++++++++++----------- 5 files changed, 22 insertions(+), 33 deletions(-) diff --git a/model/src/w3bullmd.F90 b/model/src/w3bullmd.F90 index 9c0b385ca9..c9dd803cf2 100644 --- a/model/src/w3bullmd.F90 +++ b/model/src/w3bullmd.F90 @@ -197,10 +197,9 @@ SUBROUTINE W3BULL & UD, XPART(DIMP,0:DIMXP) INTEGER :: IPG1,IPI(NPMAX), ILEN(NPMAX), IP, & IPNOW, IFLD, INOTAB, IPNT, ITAB, & - DOUTP, FCSTI, NZERO - REAL :: AFR, AGE, DDMMAXR, DELDM, DELDMR, & - DELDW, DELHS, DELTP, DHSMAXR, & - DTPMAXR, HMAX, HSTOT, TP, UDIR, FACT + FCSTI, NZERO + REAL :: AFR, AGE, DELDM, & + DELDW, DELHS, DELTP, HMAX, HSTOT, TP, UDIR, FACT REAL :: HSP(NPMAX), TPP(NPMAX), & DMP(NPMAX), WNP(NPMAX), HSD(NPMAX), & TPD(NPMAX), WDD(NPMAX) @@ -214,7 +213,6 @@ SUBROUTINE W3BULL & CHARACTER(LEN=9) :: CPART #endif CHARACTER(LEN=664) :: BLANK2 !,CSVBLINE - CHARACTER :: STIME*8,FORM*20,FORM1*2 CHARACTER(LEN=16) :: PART2 !/ !/ ------------------------------------------------------------------- / diff --git a/model/src/w3cspcmd.F90 b/model/src/w3cspcmd.F90 index a8129242f2..6f885c004d 100644 --- a/model/src/w3cspcmd.F90 +++ b/model/src/w3cspcmd.F90 @@ -242,8 +242,7 @@ SUBROUTINE W3CSPC ( SP1, NFR1, NTH1, XF1, FR1, TH1, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: I, NRMAX, J, I1, L1, J1, I2, L2, J2, & - ISP + INTEGER :: I, NRMAX, J, I1, L1, J1, I2, L2, J2 #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif diff --git a/model/src/w3dispmd.F90 b/model/src/w3dispmd.F90 index 940b5bdfa8..56c16e3dd5 100644 --- a/model/src/w3dispmd.F90 +++ b/model/src/w3dispmd.F90 @@ -427,9 +427,8 @@ PURE SUBROUTINE WAVNU3 (SI,H,K,CG) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: I1, I2 !!/S INTEGER, SAVE :: IENT = 0 - REAL :: KH0, KH, TMP, TP, CP, L + REAL :: KH0, KH, TMP, TP REAL, PARAMETER :: BETA1 = 1.55 REAL, PARAMETER :: BETA2 = 1.3 REAL, PARAMETER :: BETA3 = 0.216 @@ -784,7 +783,7 @@ SUBROUTINE LIU_FORWARD_DISPERSION (H_ICE,VISC,H_WDEPTH,SIGMA & USE CONSTANTS, ONLY: TPI USE W3ODATMD, ONLY: NDSE USE W3SERVMD, ONLY: EXTCDE - USE W3GDATMD, ONLY: NK, IICEHDISP, IICEDDISP, IICEFDISP, IICEHMIN + USE W3GDATMD, ONLY: NK, IICEHDISP, IICEDDISP, IICEFDISP ! USE W3DISPMD, ONLY: WAVNU1 #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -1049,7 +1048,6 @@ SUBROUTINE LIU_REVERSE_DISPERSION (H_ICE,VISC,H_WDEPTH,KWN & ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: DWAT, TPI, GRAV - USE W3GDATMD, ONLY: NK #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 0fa18457b9..8da99ffe0e 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -174,7 +174,6 @@ SUBROUTINE W3FLD1( ASPC, FPI, WNDX,WNDY, ZWND, & !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: GRAV, DWAT, TPI, PI, KAPPA USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, XFR, TH - USE W3ODATMD, ONLY: NDSE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -199,9 +198,7 @@ SUBROUTINE W3FLD1( ASPC, FPI, WNDX,WNDY, ZWND, & REAL :: wnd_in_mag, wnd_in_dir !For Calculating Tail REAL :: KMAX, KTAILA, KTAILB, KTAILC - REAL :: SAT, z01, z02, u10 - LOGICAL :: ITERFLAG - INTEGER :: COUNT + REAL :: SAT, u10 !For Iterations REAL :: DTX, DTY, iter_thresh, & USTSM, Z0SM, Z1 @@ -222,10 +219,9 @@ SUBROUTINE W3FLD1( ASPC, FPI, WNDX,WNDY, ZWND, & APAR, CH,UITV, VITV,USTL,& CK !For adding stability to wind profile - REAL :: WND_TOP, ANG_TOP, WND_PA, WND_PE, & - WND_PEx, WND_PEy, WND_PAx, WND_PAy, & - CDM - INTEGER :: NKT, K, T, Z2, ITER, ZI, ZII, & + !REAL :: WND_TOP, ANG_TOP, WND_PE, WND_PEx, ND_PEy, WND_PAx, WND_PAy, CDM + REAL :: WND_PA + INTEGER :: NKT, K, T, Z2, ITER, ZI, & I, CTR, ITERATION, KA1, KA2, & KA3, KB ! For defining extended spectrum with appended tail. @@ -836,7 +832,6 @@ SUBROUTINE INFLD ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3ODATMD, ONLY: NDSE USE W3GDATMD, ONLY: TAIL_ID, TAIL_LEV, TAIL_TRAN1, TAIL_TRAN2 #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -936,7 +931,6 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: TPI, PI USE W3GDATMD, ONLY: NTH, TH, DTH - USE W3ODATMD, ONLY: NDSE #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -1200,7 +1194,7 @@ SUBROUTINE SIG2WN(SIG,DEPTH,WN) !/ real :: wn1,wn2 !,sig1,sig2,dsigdk real :: fk, fk_slp - integer :: i + !integer :: i logical :: SWITCH !/ ------------------------------------------------------------------- / wn1=sig**2/GRAV diff --git a/model/src/w3fld2md.F90 b/model/src/w3fld2md.F90 index 403cc191f8..87735fdc89 100644 --- a/model/src/w3fld2md.F90 +++ b/model/src/w3fld2md.F90 @@ -144,7 +144,7 @@ SUBROUTINE W3FLD2( ASPC,FPI, WNDX,WNDY, ZWND, & !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: DWAT, GRAV, TPI, PI, KAPPA USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, XFR, TH - USE W3ODATMD, ONLY: NDSE + !USE W3ODATMD, ONLY: NDSE USE W3FLD1MD, ONLY: APPENDTAIL,sig2wn,wnd2z0m,infld,tail_choice,& tail_level, tail_transition_ratio1, & tail_transition_ratio2 @@ -186,24 +186,24 @@ SUBROUTINE W3FLD2( ASPC,FPI, WNDX,WNDY, ZWND, & real :: wnd_z, wnd_z_mag, wnd_z_proj, wnd_effect ! Stress iteration REAL :: B1, B2 - REAL :: USTRI1, USTRF1, USTRI2, USTRF2 - REAL :: USTGRA, SLO LOGICAL :: UST_IT_FLG(2) !-Z0 iteration REAL :: z01,z02 !-Wind iteration real :: wnd_10_x, wnd_10_y, wnd_10_mag, wnd_10_dir - real :: u35_1, v35_1, u35_2, v35_2, u35_3, v35_3 - REAL :: DIFU10xx, DIFU10yx, DIFU10xy, DIFU10yy - REAL :: fd_a, fd_b, fd_c, fd_d - REAL :: DU, DV, UITV, VITV, CH - REAL :: APAR, DTX(3), DTY(3), DT - LOGICAL :: WIFLG, WND_IT_FLG + !real :: u35_1, v35_1, u35_2, v35_2, u35_3, v35_3 + !REAL :: DIFU10xx, DIFU10yx, DIFU10xy, DIFU10yy + !REAL :: fd_a, fd_b, fd_c, fd_d + !REAL :: DU, DV, UITV, VITV, CH + !REAL :: APAR + REAL :: DTX(3), DTY(3), DT + !LOGICAL :: WND_IT_FLG + LOGICAL :: WIFLG !-MO stability correction LOGICAL :: HEIGHTFLG integer :: wi_count, wi - real :: wnd_ref_al,wnd_ref_ax - real :: wndpa, wndpax, wndpay, wndpe,wndpex, wndpey + !real :: wnd_ref_al + !real :: wndpa, wndpax, wndpay, wndpe,wndpex, wndpey LOGICAL :: NO_ERR LOGICAL :: ITERFLAG INTEGER :: ITTOT From ffc08be588192da42a764f7d8475f49994371ebc Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Thu, 16 Oct 2025 16:19:06 -0400 Subject: [PATCH 107/136] resolve compiler remarks in w3fldsmd.F90 w3parall.F90 w3snl1md.F90 w3src4md.F90 w3wdatmd.F90 (#1508) --- model/src/w3fldsmd.F90 | 6 ++--- model/src/w3parall.F90 | 58 +++++++++++++++++------------------------- model/src/w3snl1md.F90 | 8 +++--- model/src/w3src4md.F90 | 54 +++++++++++++++++++-------------------- model/src/w3wdatmd.F90 | 4 +-- 5 files changed, 57 insertions(+), 73 deletions(-) diff --git a/model/src/w3fldsmd.F90 b/model/src/w3fldsmd.F90 index 99ff484c90..8f0e682bc0 100644 --- a/model/src/w3fldsmd.F90 +++ b/model/src/w3fldsmd.F90 @@ -201,7 +201,6 @@ SUBROUTINE W3FLDO ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, & USE W3SERVMD, ONLY: STRACE #endif ! - USE W3ODATMD, only : IAPROC USE CONSTANTS, ONLY: file_endian IMPLICIT NONE @@ -622,7 +621,6 @@ SUBROUTINE W3FLDTIDE1 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR ) INTEGER, SAVE :: IENT = 0 #endif LOGICAL :: WRITE - INTEGER :: I, IX ! !/ !/ ------------------------------------------------------------------- / @@ -1581,7 +1579,7 @@ SUBROUTINE W3FLDD (INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: ISTAT, NRT + INTEGER :: ISTAT #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -1918,7 +1916,7 @@ SUBROUTINE W3FLDP ( NDSM, NDST, NDSE, IERR, FLAGLL, & INTEGER, SAVE :: IENT = 0 #endif TYPE(T_GSU) :: GSU - INTEGER :: IX, IY, I, J, NNBR, II(4), JJ(4), & + INTEGER :: IX, IY, NNBR, II(4), JJ(4), & MSKC, IFOUND, IMASK, ICOR1 REAL :: RR(4), X, Y REAL, POINTER :: PLAT(:,:), PLON(:,:) diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index a4bf504f54..e7bc900721 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -330,16 +330,15 @@ SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & - EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & - CTMAX, DMIN, DTH, CTHG0S, MAPSF + USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, ECOS, ESIN, & + EC2, ESC, ES2, MAPWN, DMIN, DTH, CTHG0S, MAPSF + !USE W3GDATMD, ONLY: CTMAX USE W3ADATMD, ONLY: CG, WN, DCXDX, DCXDY, DCYDX, DCYDY, DDDX, & DDDY, DW #ifdef W3_REFRX USE W3ADATMD, ONLY: DCDX, DCDY #endif USE W3IDATMD, ONLY: FLCUR - USE W3ODATMD, only : IAPROC IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / @@ -360,7 +359,7 @@ SUBROUTINE PROP_REFRACTION_PR1(ISEA,DTG, CAD) REAL, intent(in) :: DTG INTEGER :: ISP, IK, ITH, IX, IY REAL :: FRK(NK), FRG(NK), DSDD(0:NK+1) - REAL :: FACTH, DCXY, DCYX, DCXXYY, DTTST + REAL :: FACTH, DCXY, DCYX, DCXXYY REAL :: eDCXDX, eDCXDY, eDCYDX, eDCYDY, eDDDX, eDDDY, eCTHG0 REAL :: VCFLT(NSPEC), DEPTH, FDG REAL :: FDDMAX @@ -493,14 +492,11 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE CONSTANTS, ONLY : LPDLIB - USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & - EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & - CTMAX, DMIN, DTH, CTHG0S, MAPSF, SIG + USE W3GDATMD, ONLY: NK, NSPEC, SIG, ECOS, ESIN, & + EC2, ESC, ES2, MAPWN, CTMAX, DMIN, DTH, CTHG0S, MAPSF, SIG USE W3ADATMD, ONLY: CG, WN, DCXDX, DCXDY, DCYDX, DCYDY, DDDX, & DDDY, DW USE W3IDATMD, ONLY: FLCUR - USE W3ODATMD, only : IAPROC IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / @@ -516,12 +512,12 @@ SUBROUTINE PROP_REFRACTION_PR3(IP, ISEA, DTG, CAD, DoLimiter) INTEGER, intent(in) :: ISEA, IP REAL, intent(in) :: DTG logical, intent(in) :: DoLimiter - INTEGER :: ISP, IK, ITH, IX, IY + INTEGER :: ISP, IK, IX, IY REAL :: FRK(NK), FRG(NK), DSDD(0:NK+1) - REAL :: FACTH, DCXY, DCYX, DCXXYY, DTTST + REAL :: FACTH, DCXY, DCYX, DCXXYY REAL :: eDCXDX, eDCXDY, eDCYDX, eDCYDY, eDDDX, eDDDY, eCTHG0 - REAL :: VCFLT(NSPEC), DEPTH, FDG, CG1(0:NK+1), WN1(0:NK+1) - REAL :: FDDMAX, CFLTHMAX, VELNOFILT, CTMAX_eff + REAL :: VCFLT(NSPEC), DEPTH, FDG + REAL :: VELNOFILT, CTMAX_eff #ifdef W3_S CALL STRACE (IENT, 'PROP_REFRACTION_PR3') #endif @@ -654,11 +650,9 @@ SUBROUTINE PROP_FREQ_SHIFT(IP, ISEA, CAS, DMM, DTG) USE W3SERVMD, ONLY: STRACE #endif USE CONSTANTS, ONLY : LPDLIB - USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & - EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & - CTMAX, DMIN, DTH, MAPSF + USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, & + EC2, ESC, ES2, DMIN, MAPSF USE W3ADATMD, ONLY: CG, WN, DCXDX, DCXDY, DCYDX, DCYDY, CX, CY, DDDX, DDDY, DW - USE W3ODATMD, only : IAPROC IMPLICIT NONE !/ Parameter list !/ @@ -807,11 +801,9 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) USE W3SERVMD, ONLY: STRACE #endif USE CONSTANTS, ONLY : LPDLIB - USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & - EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & - CTMAX, DMIN, DTH, MAPSF + USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DSIP, & + EC2, ESC, ES2, DMIN, MAPSF USE W3ADATMD, ONLY: CG, WN, DCXDX, DCXDY, DCYDX, DCYDY, CX, CY, DDDX, DDDY, DW - USE W3ODATMD, only : IAPROC IMPLICIT NONE @@ -833,8 +825,7 @@ SUBROUTINE PROP_FREQ_SHIFT_M2(IP, ISEA, CWNB_M2, DWNI_M2, DTG) REAL :: FKC(NTH), FKD0 REAL :: VCWN(1-NTH:NSPEC+NTH) REAL :: DSDD(0:NK+1) - REAL :: sumDiff, sumDiff1, sumDiff2, sumDiff3 - REAL :: sumDiff0, sumDiff4, sumDiff5 + REAL :: sumDiff INTEGER :: IK, ITH, ISP, IY, IX !/ ------------------------------------------------------------------- / @@ -1097,7 +1088,7 @@ SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) #endif USE CONSTANTS, ONLY : LPDLIB USE W3GDATMD, ONLY: NSEA - USE W3ODATMD, ONLY: NTPROC, NAPROC, IAPROC + USE W3ODATMD, ONLY: NAPROC, IAPROC IMPLICIT NONE INTEGER, intent(out) :: NSEALout, NSEALMout !/ Local parameters @@ -1209,8 +1200,8 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3ODATMD, ONLY: OUTPTS, IAPROC, NAPROC - USE W3GDATMD, ONLY: GTYPE, UNGTYPE, MAPSF + USE W3ODATMD, ONLY: IAPROC, NAPROC + USE W3GDATMD, ONLY: UNGTYPE, MAPSF USE CONSTANTS, ONLY : LPDLIB #ifdef W3_PDLIB USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot @@ -1317,7 +1308,7 @@ SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3ODATMD, ONLY: OUTPTS, IAPROC, NAPROC + USE W3ODATMD, ONLY: IAPROC, NAPROC USE W3GDATMD, ONLY: GTYPE, UNGTYPE, MAPSF USE CONSTANTS, ONLY : LPDLIB #ifdef W3_PDLIB @@ -1444,7 +1435,7 @@ SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3ODATMD, ONLY: OUTPTS, IAPROC, NAPROC + USE W3ODATMD, ONLY: IAPROC, NAPROC USE W3GDATMD, ONLY: GTYPE, UNGTYPE USE CONSTANTS, ONLY : LPDLIB #ifdef W3_PDLIB @@ -1463,9 +1454,6 @@ SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) !/ !/ ------------------------------------------------------------------- / ! - USE W3ODATMD, ONLY: OUTPTS, IAPROC, NAPROC - USE W3GDATMD, ONLY: GTYPE, UNGTYPE - USE CONSTANTS, ONLY : LPDLIB #ifdef W3_PDLIB USE YOWNODEPOOL, ONLY: iplg #endif @@ -1569,7 +1557,7 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) USE W3SERVMD, ONLY: STRACE #endif ! - USE W3GDATMD, ONLY: NSEAL, NSEA, NX + USE W3GDATMD, ONLY: NX #ifdef W3_PDLIB USE W3ODATMD, only : IAPROC, NAPROC, NTPROC USE W3ADATMD, ONLY: MPI_COMM_WCMP @@ -1594,8 +1582,8 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) !/ !/ ------------------------------------------------------------------- / !/ - INTEGER ISEA, JSEA, Status(NX), rStatus(NX) - INTEGER IPROC, I, ierr, IP, IX, IP_glob + INTEGER Status(NX), rStatus(NX) + INTEGER IPROC, I, ierr, IP, IP_glob #ifdef W3_PDLIB REAL(rkind), intent(inout) :: TheVar(NX) REAL(rkind) :: rVect(NX) diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index 1e1949367f..e7a39578cf 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -276,7 +276,7 @@ SUBROUTINE W3SNL1 (A, CG, KDMEAN, S, D) USE CONSTANTS USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, FACHFE, & KDCON, KDMN, SNLC1, SNLS1, SNLS2, SNLS3 - USE W3ADATMD, ONLY: NFR, NFRHGH, NFRCHG, NSPECX, NSPECY, & + USE W3ADATMD, ONLY: NFR, NFRHGH, NSPECX, NSPECY, & IP11, IP12, IP13, IP14, IM11, IM12, IM13, IM14, & IP21, IP22, IP23, IP24, IM21, IM22, IM23, IM24, & IC11, IC12, IC21, IC22, IC31, IC32, IC41, IC42, & @@ -854,8 +854,8 @@ SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) , CF3 , CP3 , Q2PD0 , Q2PD1 , Q2PD2P, Q2PD3M & , Q2MD0 , Q2MD1 , Q2MD2M, Q2MD3P ,AUX00 , AUX01 & , AUX02 , AUX03 , AUX04 , AUX05 , SEUIL & - , AUX06 , AUX07 , AUX08 , AUX09 , AUX10 , FSEUIL - + , AUX06 , AUX07 , AUX08 , AUX09 , AUX10 + !DOUBLE PRECISION FSEUIL NT = NTH NF = NK LBUF = 500 @@ -1572,7 +1572,7 @@ SUBROUTINE INSNLGQM DOUBLE PRECISION RK2 , XK2P , YK2P , XK2M , YK2M DOUBLE PRECISION RK3 , XK3P , YK3P , XK3M , YK3M DOUBLE PRECISION D01P , C_D01P, S_D01P, D0AP , C_D0AP, S_D0AP - DOUBLE PRECISION GA2P , C_GA2P, S_GA2P, GA3P , C_GA3P, S_GA3P, TWOPI, PI, SEUIL1 , SEUIL2 , SEUIL + DOUBLE PRECISION GA2P , C_GA2P, S_GA2P, GA3P , C_GA3P, S_GA3P, TWOPI, PI, SEUIL1 , SEUIL2 ! !.....Variables related to the Gaussian quadratures DOUBLE PRECISION W_CHE_TE1, W_CHE_OM2, C_LEG_OM2 diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index 4656a1678c..3d21d5895f 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -225,12 +225,11 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3ODATMD, ONLY: IAPROC + !USE W3ODATMD, ONLY: IAPROC USE CONSTANTS, ONLY: TPIINV, GRAV, nu_air - USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, DDEN, WWNMEANP, & - WWNMEANPTAIL, FTE, FTF, SSTXFTF, SSTXFTWN,& - SSTXFTFTAIL, SSWELLF, ESIN, ECOS, AAIRCMIN, & - AAIRGB, AALPHA, ZZWND, SSDSC + USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DDEN, WWNMEANP, & + WWNMEANPTAIL, FTE, FTF, SSTXFTWN,& + SSTXFTFTAIL, ESIN, ECOS, ZZWND, SSDSC #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -506,10 +505,11 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & RADE, & #endif DELAB,ABMIN - USE W3GDATMD, ONLY: NK, NTH, NSPEC, DDEN, SIG, SIG2, TH, & - ESIN, ECOS, EC2, ZZWND, AALPHA, BBETA, ZZALP,& + USE W3GDATMD, ONLY: NK, NTH, NSPEC, DDEN, SIG, SIG2, & + ESIN, ECOS, ZZWND, AALPHA, BBETA, ZZALP,& TTAUWSHELTER, SSWELLF, DDEN2, DTH, SSINTHP, & - ZZ0RAT, SSINBR, SINTAILPAR + ZZ0RAT, SINTAILPAR + !USE W3GDATMD, ONLY: SSINBR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -519,7 +519,7 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & #ifdef W3_T0 USE W3ODATMD, ONLY: NDST #endif - USE W3ODATMD, ONLY: IAPROC + !USE W3ODATMD, ONLY: IAPROC #ifdef W3_T0 USE W3ARRYMD, ONLY: PRT2DS #endif @@ -546,7 +546,7 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - REAL :: FACLN1, FACLN2, LAMBDA + REAL :: FACLN1, FACLN2 REAL :: COSU, SINU, TAUX, TAUY, USDIRP, USTP REAL :: TAUPX, TAUPY, UST2, TAUW, TAUWB REAL , PARAMETER :: EPS1 = 0.00001, EPS2 = 0.000001 @@ -554,7 +554,7 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & REAL :: USTARsigma !standard deviation of USTAR due to gustiness REAL :: CM,UCN,ZCN, & Z0VISC, Z0NOZ, EB, & - EBX, EBY, AORB, AORB1, FW, UORB, TH2, & + EBX, EBY, AORB, AORB1, FW, UORB, & RE, FU, FUD, SWELLCOEFV, SWELLCOEFT REAL :: PTURB, PVISC, SMOOTH REAL XI,DELI1,DELI2 @@ -572,8 +572,8 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & REAL , PARAMETER :: KM=363.,CMM=0.2325 ! K and C at phase speed minimum in rad/m REAL :: OMEGACC, OMEGA, ZZ0, ZX, ZBETA, USTR, TAUR, & CONST1, LEVTAIL0, X0, Y, DELY, YC, ZMU, & - LEVTAIL, CGTAIL, ALPHAM, FM, ALPHAT, FMEAN - + LEVTAIL, CGTAIL, ALPHAM, FM, ALPHAT + !REAL :: FMEAN REAL, ALLOCATABLE :: W(:) #ifdef W3_T0 REAL :: DOUT(NK,NTH) @@ -1064,10 +1064,10 @@ SUBROUTINE INSIN4(FLTABS) ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: TPIINV, RADE, GRAV - USE W3ODATMD, ONLY: NDSE + !USE W3ODATMD, ONLY: NDSE USE W3DISPMD, ONLY: WAVNU2 USE W3GDATMD, ONLY: SIG, DSIP, NK, NTH, TTAUWSHELTER, & - SSDSDTH, SSDSCOS, TH, DTH, XFR, ECOS, ESIN, & + SSDSDTH, SSDSCOS, TH, DTH, XFR, ECOS, & SSDSC, SSDSBRF1, SSDSBCK, SSDSBINT, SSDSPBK, & SSDSABK, SSDSHCK, IKTAB, DCKI, SATINDICES, & SATWEIGHTS, CUMULW, NKHS, NKD, NDTAB, QBI, & @@ -1480,7 +1480,8 @@ SUBROUTINE TABU_TAUHF(SIGMAX) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3GDATMD, ONLY: AALPHA, BBETA, ZZALP, FACHFE, ZZ0MAX + USE W3GDATMD, ONLY: AALPHA, BBETA, ZZALP, ZZ0MAX + !USE W3GDATMD, ONLY: FACHFE #ifdef W3_T USE W3ODATMD, ONLY: NDST #endif @@ -1651,8 +1652,8 @@ SUBROUTINE TABU_TAUHF2(SIGMAX) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3GDATMD, ONLY: AALPHA, BBETA, ZZALP, FACHFE, & - TTAUWSHELTER, ZZ0MAX + USE W3GDATMD, ONLY: AALPHA, BBETA, ZZALP + !USE W3GDATMD, ONLY: FACHFE USE W3ODATMD, ONLY: NDSE #ifdef W3_T USE W3ODATMD, ONLY: NDST @@ -2115,10 +2116,8 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & !/ ------------------------------------------------------------------- / USE CONSTANTS,ONLY: GRAV, DWAT, PI, TPI, RADE, DEBUG_NODE USE W3GDATMD, ONLY: NSPEC, NTH, NK, SSDSBR, SSDSBT, DDEN, & - SSDSC, EC2, ES2, ESC, & - SIG, SSDSP, ECOS, ESIN, DTH, AAIRGB, & - SSDSISO, SSDSDTH, SSDSBM, AAIRCMIN, & - SSDSBRFDF, SSDSBCK, IKTAB, DCKI, & + SSDSC, SIG, SSDSP, ECOS, ESIN, DTH, AAIRGB, & + SSDSDTH, SSDSBM, AAIRCMIN, IKTAB, DCKI, & SATINDICES, SATWEIGHTS, CUMULW, NKHS, NKD, & NDTAB, QBI, DSIP, SSDSBRF1,XFR #ifdef W3_IG1 @@ -2153,12 +2152,11 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IS, IS2, IS0, IKL, IKC, ID, NKL + INTEGER :: IS, IS2, IS0, IKL, ID, NKL #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - INTEGER :: IK, IK1, ITH, IK2, JTH, ITH2, & - IKHS, IKD, SDSNTH, IT, IKM, NKM + INTEGER :: IK, IK1, ITH, IK2, IKHS, IKD, IT INTEGER :: NSMOOTH(NK) REAL :: C, C2, CUMULWISO, COSWIND, ASUM, SDIAGISO REAL :: COEF1, COEF2, COEF4(NK), & @@ -2172,12 +2170,12 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & REAL :: DK(NK), HS(NK), KBAR(NK), DCK(NK) REAL :: EFDF(NK) ! Energy integrated over a spectral band INTEGER :: IKSUP(NK) - REAL :: FACSAT, DKHS, FACSTRAINB, FACSTRAINL + REAL :: FACSAT, DKHS, FACSTRAINL REAL :: BTH0(NK) !saturation spectrum REAL :: BTH(NSPEC) !saturation spectrum - REAL :: MSSSUM(NK,5), FACHF + REAL :: MSSSUM(NK,5) REAL :: MSSLONG - REAL :: MSSPCS, MSSPC2, MSSPS2, MSSP, MSSD, MSSTH + REAL :: MSSPCS, MSSPC2, MSSPS2, MSSP, MSSD REAL :: MICHE, X, KLOC #ifdef W3_T0 REAL :: DOUT(NK,NTH) diff --git a/model/src/w3wdatmd.F90 b/model/src/w3wdatmd.F90 index 848f3858fc..a560063152 100644 --- a/model/src/w3wdatmd.F90 +++ b/model/src/w3wdatmd.F90 @@ -413,9 +413,9 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) ! !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NGRIDS, IGRID, W3SETG, NSPEC, NSEA, NSEAL, GRIDS - USE W3ODATMD, ONLY: NAPROC, IAPROC + USE W3ODATMD, ONLY: NAPROC USE W3SERVMD, ONLY: EXTCDE - USE CONSTANTS, ONLY : LPDLIB, DAIR + USE CONSTANTS, ONLY : DAIR USE W3PARALL, ONLY: SET_UP_NSEAL_NSEALM, LSLOC #ifdef W3_NL5 USE W3GDATMD, ONLY: QI5NNZ From a0348b290269747b01d6ca860a28e89de41baff4 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 20 Oct 2025 13:56:19 -0400 Subject: [PATCH 108/136] Resolve GNU build issues and clean up EXTERNAL declarations (#1512) --- model/src/PDLIB/yowfunction.F90 | 4 ++-- model/src/PDLIB/yowpdlibmain.F90 | 1 - model/src/w3fld2md.F90 | 1 - model/src/w3oacpmd.F90 | 3 --- model/src/w3profsmd.F90 | 6 ------ model/src/w3strkmd.F90 | 22 ++++++++++++---------- model/src/ww3_bounc.F90 | 13 ++++++------- model/src/ww3_grib.F90 | 3 --- model/src/ww3_prnc.F90 | 12 ++++++------ model/src/ww3_systrk.F90 | 4 ++-- 10 files changed, 28 insertions(+), 41 deletions(-) diff --git a/model/src/PDLIB/yowfunction.F90 b/model/src/PDLIB/yowfunction.F90 index 5e30f776e4..29bdd78c06 100644 --- a/model/src/PDLIB/yowfunction.F90 +++ b/model/src/PDLIB/yowfunction.F90 @@ -45,11 +45,11 @@ module yowfunction !* * !********************************************************************** SUBROUTINE PDLIB_ABORT(istat) + use yowerr, only: abort IMPLICIT NONE - external :: ABORT integer, intent(in) :: istat Print *, 'Error with istat=', istat - CALL ABORT + call abort() END SUBROUTINE PDLIB_ABORT !********************************************************************** !* * diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index 8deb109077..e06ac3e65f 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -439,7 +439,6 @@ subroutine runParmetis(MNP) integer :: IP_glob, itmp integer :: ref logical :: lexist = .false. - external :: SCOTCH_PARMETIS_V3_PARTGEOMKWAY ! Node to domain mapping. ! np_global long. give the domain number for die global node number integer, allocatable :: node2domain(:) diff --git a/model/src/w3fld2md.F90 b/model/src/w3fld2md.F90 index 87735fdc89..091c2c962b 100644 --- a/model/src/w3fld2md.F90 +++ b/model/src/w3fld2md.F90 @@ -144,7 +144,6 @@ SUBROUTINE W3FLD2( ASPC,FPI, WNDX,WNDY, ZWND, & !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: DWAT, GRAV, TPI, PI, KAPPA USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, XFR, TH - !USE W3ODATMD, ONLY: NDSE USE W3FLD1MD, ONLY: APPENDTAIL,sig2wn,wnd2z0m,infld,tail_choice,& tail_level, tail_transition_ratio1, & tail_transition_ratio2 diff --git a/model/src/w3oacpmd.F90 b/model/src/w3oacpmd.F90 index 41366cd2d4..f66367ccb2 100644 --- a/model/src/w3oacpmd.F90 +++ b/model/src/w3oacpmd.F90 @@ -231,9 +231,6 @@ SUBROUTINE CPL_OASIS_GRID(LD_MASTER,ID_LCOMM) #ifdef W3_SMC REAL :: DLON, DLAT #endif -!#ifdef W3_MPI -! type(MPI_COMM) :: mpicomm -!#endif !/ ------------------------------------------------------------------- / ! IF (LD_MASTER) THEN diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index c778c1f08f..17350959ab 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -1106,7 +1106,6 @@ SUBROUTINE W3XYPFSNIMP ( ISP, C, LCALC, RD10, RD20, DT, AC) REAL*8 :: INIU(NX) external bcgstab - external :: ILU0, RUNRC POS_TRICK(1,1) = 2 POS_TRICK(1,2) = 3 @@ -2089,7 +2088,6 @@ subroutine bcgstab(n, rhs, sol, ipar, fpar, w) real*8 ddot logical stopbis, brkdn external ddot, stopbis, brkdn - external :: bisinit, tidycg ! real*8 one parameter(one=1.0D0) @@ -3788,7 +3786,6 @@ subroutine runrc(n,rhs,sol,ipar,fpar,wk,guess,a,ja,ia,au,jau,ju,solver) integer n,ipar(16),ia(n+1),ja(*),ju(*),jau(*) real*8 fpar(16),rhs(n),sol(n),guess(n),wk(*),a(*),au(*) external solver - external :: amux, atmux, lusol, lutsol !----------------------------------------------------------------------- ! the actual tester. It starts the iterative linear system solvers ! with a initial guess suppied by the user. @@ -3872,7 +3869,6 @@ subroutine ilut(n,a,ja,ia,lfil,droptol,alu,jlu,ju,iwk,w,jw,ierr) integer n real*8 a(*),alu(*),w(n+1),droptol integer ja(*),ia(n+1),jlu(*),ju(n),jw(2*n),lfil,iwk,ierr - external :: qsplit !----------------------------------------------------------------------* ! *** ILUT preconditioner *** * ! incomplete LU factorization with dual truncation mechanism * @@ -4297,8 +4293,6 @@ subroutine pgmres(n, im, rhs, sol, eps, maxits, aspar, nnz, ia, ja, alu, jlu, ju real*8 :: hh(im+1,im), c(im), s(im), rs(im+1) real*8 :: iw(n) - external :: amux, lusol, daxpy - logical :: lblas = .false. ! use sparskit matvec and external blas libs (true), don't use them (false) logical :: lilu = .true. ! use simple ilu preconditioner diff --git a/model/src/w3strkmd.F90 b/model/src/w3strkmd.F90 index 58b637f3ab..97796dfda1 100644 --- a/model/src/w3strkmd.F90 +++ b/model/src/w3strkmd.F90 @@ -5733,6 +5733,8 @@ RECURSIVE SUBROUTINE QSORT(ARRAY,IDX,LO,HI) ! LO INTEGER input First element ! HI INTEGER input Last element ! + USE W3SERVMD, ONLY: EXTCDE + !/ IMPLICIT NONE !/ INTEGER, INTENT(IN) :: LO,HI @@ -5740,7 +5742,6 @@ RECURSIVE SUBROUTINE QSORT(ARRAY,IDX,LO,HI) !/ ! Local variables ! ---------------------------------------------------------------- - EXTERNAL :: ABORT LOGICAL :: LOOP INTEGER :: TOP, BOT REAL :: VAL, TMP @@ -5767,16 +5768,16 @@ RECURSIVE SUBROUTINE QSORT(ARRAY,IDX,LO,HI) !/ --- Check array size and bounds. --- IF ( SIZE(ARRAY).EQ. 0 ) THEN WRITE(6,199) - CALL ABORT + CALL EXTCDE(1) ELSE IF ( SIZE(ARRAY).NE.SIZE(IDX) ) THEN WRITE(6,201) - CALL ABORT + CALL EXTCDE(2) ELSE IF ( LBOUND(ARRAY,1).GT.LO ) THEN WRITE(6,203) - CALL ABORT + CALL EXTCDE(3) ELSE IF ( UBOUND(ARRAY,1).LT.HI ) THEN WRITE(6,205) - CALL ABORT + CALL EXTCDE(4) END IF ! TOP = LO @@ -5859,6 +5860,8 @@ RECURSIVE SUBROUTINE QSORT_DESC(ARRAY,IDX,LO,HI) ! LO INTEGER input First element ! HI INTEGER input Last element ! + USE W3SERVMD, ONLY: EXTCDE + !/ IMPLICIT NONE !/ INTEGER, INTENT(IN) :: LO,HI @@ -5866,7 +5869,6 @@ RECURSIVE SUBROUTINE QSORT_DESC(ARRAY,IDX,LO,HI) !/ ! Local variables ! ---------------------------------------------------------------- - EXTERNAL :: ABORT INTEGER :: TOP, BOT, I REAL :: VAL, TMP LOGICAL :: LOOP @@ -5893,16 +5895,16 @@ RECURSIVE SUBROUTINE QSORT_DESC(ARRAY,IDX,LO,HI) !/ --- Check array size and bounds. --- IF ( SIZE(ARRAY).EQ. 0 ) THEN WRITE(6,199) - CALL ABORT + CALL EXTCDE(5) ELSE IF ( SIZE(ARRAY).NE.SIZE(IDX) ) THEN WRITE(6,201) - CALL ABORT + CALL EXTCDE(6) ELSE IF ( LBOUND(ARRAY,1).GT.LO ) THEN WRITE(6,203) - CALL ABORT + CALL EXTCDE(7) ELSE IF ( UBOUND(ARRAY,1).LT.HI ) THEN WRITE(6,205) - CALL ABORT + CALL EXTCDE(8) END IF ! TOP = LO diff --git a/model/src/ww3_bounc.F90 b/model/src/ww3_bounc.F90 index 6dfadaac27..4531c938d5 100644 --- a/model/src/ww3_bounc.F90 +++ b/model/src/ww3_bounc.F90 @@ -164,8 +164,6 @@ PROGRAM W3BOUNC !/ ------------------------------------------------------------------- / !/ Local parameters !/ - EXTERNAL :: CHECK_ERR - TYPE(NML_BOUND_T) :: NML_BOUND ! INTEGER :: IX, IY, ISEA, I,JJ,IP,IP1,J,IT, & @@ -842,12 +840,8 @@ PROGRAM W3BOUNC ' SPEC FILE DOES NOT EXIST : ',A/) ! ! - !/ - !/ End of W3BOUNC ---------------------------------------------------- / - !/ -END PROGRAM W3BOUNC -!/ ------------------------------------------------------------------- / +CONTAINS !============================================================================== !> @brief Check input return status for error value @@ -876,3 +870,8 @@ SUBROUTINE CHECK_ERR(IRET) END SUBROUTINE CHECK_ERR !============================================================================== + !/ + !/ End of W3BOUNC ---------------------------------------------------- / + !/ +END PROGRAM W3BOUNC +!/ ------------------------------------------------------------------- / diff --git a/model/src/ww3_grib.F90 b/model/src/ww3_grib.F90 index 71f342b990..393d3f5ee4 100644 --- a/model/src/ww3_grib.F90 +++ b/model/src/ww3_grib.F90 @@ -163,9 +163,6 @@ PROGRAM W3GRIB !/ ------------------------------------------------------------------- / !/ Local variables !/ - EXTERNAL :: BAOPENW - EXTERNAL :: GRIBCREATE, ADDGRID, ADDFIELD, GRIBEND, WRYTE - EXTERNAL :: BAOPEN, PUTGB INTEGER :: NDSI, NDSM, NDSOG, NDSDAT, NDSTRC, & NTRACE, IERR, IOTEST, I,J,K, IFI,IFJ,& ISEA, IX, IY, TOUT(2), NOUT, TDUM(2),& diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index 960409d220..2567274e30 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -236,8 +236,6 @@ PROGRAM W3PRNC !/ ------------------------------------------------------------------- / !/ Local parameters !/ - EXTERNAL :: CHECK_ERROR - EXTERNAL :: INTERP TYPE(NML_FORCING_T) :: NML_FORCING TYPE(NML_FILE_T) :: NML_FILE TYPE(T_GSU) :: GSI @@ -2491,11 +2489,8 @@ PROGRAM W3PRNC #ifdef W3_T3 9065 FORMAT (' TEST W3PRNC : OUTPUT FIELD(S) :'/) #endif - !/ - !/ End of W3PRNC ----------------------------------------------------- / - !/ -END PROGRAM W3PRNC +CONTAINS !============================================================================== !> @@ -2696,3 +2691,8 @@ SUBROUTINE CHECK_ERROR(IRET, ILINE) END SUBROUTINE CHECK_ERROR !============================================================================== + !/ + !/ End of W3PRNC ----------------------------------------------------- / + !/ + +END PROGRAM W3PRNC diff --git a/model/src/ww3_systrk.F90 b/model/src/ww3_systrk.F90 index 6635f1e867..b32f791f67 100644 --- a/model/src/ww3_systrk.F90 +++ b/model/src/ww3_systrk.F90 @@ -58,6 +58,7 @@ PROGRAM WW3_SYSTRK !/ USE W3STRKMD USE W3TIMEMD, ONLY: TDIFF + USE W3SERVMD, ONLY: EXTCDE #ifdef W3_MPI use mpi_f08 #endif @@ -77,7 +78,6 @@ PROGRAM WW3_SYSTRK ! ! 3. Parameters : ! - EXTERNAL :: ABORT LOGICAL :: testout PARAMETER (testout = .FALSE.) CHARACTER :: filename*80, paramFile*32 @@ -210,7 +210,7 @@ PROGRAM WW3_SYSTRK IF (.NOT.file_exists) THEN WRITE(20,2000) WRITE(6,2000) - CALL ABORT + CALL EXTCDE(1) END IF OPEN(unit=10,file='ww3_systrk.inp',status='old') From 44de856842373a4a5a90e9fcf53df574b30e1479 Mon Sep 17 00:00:00 2001 From: Jessica Meixner Date: Tue, 21 Oct 2025 13:54:54 -0400 Subject: [PATCH 109/136] Update regtest ww3_ufs1.1 (#1507) --- model/bin/switch_NCEP_rwps | 1 + regtests/ww3_ufs1.1/info | 12 +- .../ww3_ufs1.1/input_unstr/namelists_b.nml | 128 ++++---- .../ww3_ufs1.1/input_unstr/namelists_c.nml | 124 ++++---- regtests/ww3_ufs1.1/input_unstr/switch_PDLIB | 2 +- .../ww3_ufs1.1/input_unstr/ww3_grid_a.inp | 71 +---- .../ww3_ufs1.1/input_unstr/ww3_grid_b.inp | 247 +++------------ .../ww3_ufs1.1/input_unstr/ww3_grid_b.nml | 4 +- .../ww3_ufs1.1/input_unstr/ww3_grid_c.inp | 289 ++++-------------- .../ww3_ufs1.1/input_unstr/ww3_grid_c.nml | 5 +- regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp | 2 +- regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml | 2 - regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp | 2 +- regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml | 2 +- 14 files changed, 230 insertions(+), 661 deletions(-) create mode 100644 model/bin/switch_NCEP_rwps diff --git a/model/bin/switch_NCEP_rwps b/model/bin/switch_NCEP_rwps new file mode 100644 index 0000000000..2ce91c2aa7 --- /dev/null +++ b/model/bin/switch_NCEP_rwps @@ -0,0 +1 @@ +NCO PDLIB SCOTCH NOGRB BIN2NC DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM TR1 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 diff --git a/regtests/ww3_ufs1.1/info b/regtests/ww3_ufs1.1/info index 66250d12d9..a0550ce0c7 100644 --- a/regtests/ww3_ufs1.1/info +++ b/regtests/ww3_ufs1.1/info @@ -18,6 +18,8 @@ # # grid_a: Domain Decomposition (PDLIB) and Explicit solver # # # grid_b: Domain Decomposition (PDLIB) and Block Explicit solver # # # grid_c: Domain Decomposition (PDLIB) and Implicit solver # +# # grid_d: Domain Decomposition (PDLIB) and Block Explicit solver # +# # grid_e: Domain Decomposition (PDLIB) and Implicit solver # # --------------------------------------------------------------------------# # if "ufscoarse" option is selected in bin/matrix.base, a coarser grid with # # 5 deg. resolution is used for MODEL and INPUT grids. # @@ -34,11 +36,11 @@ # ww3_ounf and GRIB2 using ww3_grib programs. The grib2 files are with # # rectilinear projection(-o all option). # # # -# Model should be compiled with the switches : # +# Model is compiled with the switches : # # # -# NCO NOGRB DIST MPI SCRIP SCRIPNC WRST PR3 UQ FLX0 SEED ST4 STAB0 # -# NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 # -# O5 O6 O7 O14 O15 IC0 IS0 REF0. # +# NCO PDLIB SCOTCH NOGRB BIN2NC DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 # +# DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 # +# O14 O15 IC0 IS0 REF0 # # # # Remarks : # # # @@ -80,6 +82,6 @@ # --------------------------------------------------------------------------# # # # Ali Abdolali, April 2021 # -# Last Mod : Feb 2023 # +# Last Mod : Oct 2025 # # # ############################################################################# diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml index 8d1c72eda1..09fa434eac 100644 --- a/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_b.nml @@ -1,73 +1,57 @@ -&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / -&SIN4 ALPHA0=0.0095, -BETAMAX=1.33, -SINTHP=2.00, -Z0MAX=0.00, -ZALP=0.006, -ZWND=10.00, -TAUWSHELTER =1.00, -SWELLFPAR = 1, -SWELLF= 0.800, -SWELLF2=-0.018, -SWELLF3 =0.015, -SWELLF4 =100000.0, -SWELLF5 =1.200, -SWELLF6 =0.000, -SWELLF7 =230000.000, -Z0RAT =0.0400 / -&UNST UGOBCAUTO = F, -UGOBCDEPTH= -10., -UGBCCFL= F, -EXPFSN = F, -EXPFSPSI = F, -EXPFSFCT = F, -IMPFSN = F, -EXPTOTAL = T, -IMPTOTAL = F, -IMPREFRACTION = F, -IMPFREQSHIFT = F, -IMPSOURCE = F, -SETUP_APPLY_WLV = F, -SOLVERTHR_SETUP=1E-14, -CRIT_DEP_SETUP=0.1, -JGS_NLEVEL = 0, -JGS_USE_JACOBI = F, -JGS_BLOCK_GAUSS_SEIDEL = F, -JGS_TERMINATE_MAXITER = F, -JGS_MAXITER = 1000, -JGS_TERMINATE_NORM = F, -JGS_TERMINATE_DIFFERENCE = F, -JGS_DIFF_THR = 1.E-8, -JGS_PMIN = 3.0, -JGS_LIMITER = F, -JGS_NORM_THR = 1.E-6 / -&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, -SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / -&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, -SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, -WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, -SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, -SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, -SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, -SDSBRF1 = 0.50, SDSBRFDF = 0, -SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -WHITECAPWIDTH = 0.30/ -&SBT1 GAMMA = -0.6700E-01 / -&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / -&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / -&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, -US3D = 0, I1US3D = 1, I2US3D = 32, -E3D = 0, I1E3D = 1, I2E3D = 32, -TH1MF = 0, I1TH1M = 1, I2TH1M = 32, -STH1MF= 0, I1STH1M= 1, I2STH1M= 32, -TH2MF = 0, I1TH2M = 1, I2TH2M = 32, -STH2MF= 0, I1STH2M= 1, I2STH2M= 32, -E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / -&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&SIN4 BETAMAX = 1.33 / -&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, -XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 -IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. -NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, -FACBERG = 1.0, GSHIFT = 0.000E+00 / +&OUTS + USSP = 1, + IUSSP = 3, + STK_WN = 0.04, 0.110, 0.3305 / +&SIN4 + BETAMAX = 1.315, + TAUWSHELTER = 1.0, + SWELLF = 0.798, + SWELLF2 = -0.0127, + SWELLF3 = 0.0151, + SWELLF4 = 100025.0, + SWELLF5 = 1.1999, + SWELLF7 = 235500.0 / +&SNL1 + NLPROP = 2.502E7 / +&SDS4 + FXFM3 = 2.501, + SDSC2 = -2.1975e-05, + SDSCUM = -0.4032, + SDSC6 = 0.2978, + SDSBR = 0.0009035 / +&MISC + CICE0 = 0.75, + CICEN = 0.75 / +&SBT1 + GAMMA = -0.038 / +&PRO3 + WDTHCG=1.5, + WDTHTH=1.5 / +&UNST + UGOBCAUTO = F, + UGOBCDEPTH = -10., + UGBCCFL = F, + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = T, + IMPTOTAL = F, + IMPREFRACTION = F, + IMPFREQSHIFT = F, + IMPSOURCE = F, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP = 1E-14, + CRIT_DEP_SETUP = 0.1, + JGS_NLEVEL = 0, + JGS_USE_JACOBI = F, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = F, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = F, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / END OF NAMELISTS diff --git a/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml b/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml index 013ea40af0..d4a540c6af 100644 --- a/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml +++ b/regtests/ww3_ufs1.1/input_unstr/namelists_c.nml @@ -1,72 +1,56 @@ -&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / -&SIN4 ALPHA0=0.0095, -BETAMAX=1.33, -SINTHP=2.00, -Z0MAX=0.00, -ZALP=0.006, -ZWND=10.00, -TAUWSHELTER =1.00, -SWELLFPAR = 1, -SWELLF= 0.800, -SWELLF2=-0.018, -SWELLF3 =0.015, -SWELLF4 =100000.0, -SWELLF5 =1.200, -SWELLF6 =0.000, -SWELLF7 =230000.000, -Z0RAT =0.0400 / +&OUTS + USSP = 1, + IUSSP = 3, + STK_WN = 0.04, 0.110, 0.3305 / +&SIN4 + BETAMAX = 1.315, + TAUWSHELTER = 1.0, + SWELLF = 0.798, + SWELLF2 = -0.0127, + SWELLF3 = 0.0151, + SWELLF4 = 100025.0, + SWELLF5 = 1.1999, + SWELLF7 = 235500.0 / +&SNL1 + NLPROP = 2.502E7 / +&SDS4 + FXFM3 = 2.501, + SDSC2 = -2.1975e-05, + SDSCUM = -0.4032, + SDSC6 = 0.2978, + SDSBR = 0.0009035 / +&MISC + CICE0 = 0.75, + CICEN = 0.75 / +&SBT1 + GAMMA = -0.038 / +&PRO3 + WDTHCG=1.5, + WDTHTH=1.5 / &UNST -UGOBCAUTO = F -UGOBCDEPTH= -10. -EXPFSN = F, -EXPFSPSI = F, -EXPFSFCT = F, -IMPFSN = F, -EXPTOTAL = F, -IMPTOTAL = T, -IMPREFRACTION = T, -IMPFREQSHIFT = T, -IMPSOURCE = T, -SETUP_APPLY_WLV = F, -SOLVERTHR_SETUP=1E-14, -CRIT_DEP_SETUP=0.1, -JGS_USE_JACOBI = T, -JGS_BLOCK_GAUSS_SEIDEL = T, -JGS_TERMINATE_MAXITER = T, -JGS_MAXITER = 1000, -JGS_TERMINATE_NORM = F, -JGS_TERMINATE_DIFFERENCE = T, -JGS_DIFF_THR = 1.E-6, -JGS_PMIN = 3.0, -JGS_LIMITER = F, -JGS_NORM_THR = 1.E-6 / -&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, -SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / -&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, -SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, -WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, -SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, -SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, -SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, -SDSBRF1 = 0.50, SDSBRFDF = 0, -SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ -&SBT1 GAMMA = -0.6700E-01 / -&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / -&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / -&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, -US3D = 0, I1US3D = 1, I2US3D = 32, -E3D = 0, I1E3D = 1, I2E3D = 32, -TH1MF = 0, I1TH1M = 1, I2TH1M = 32, -STH1MF= 0, I1STH1M= 1, I2STH1M= 32, -TH2MF = 0, I1TH2M = 1, I2TH2M = 32, -STH2MF= 0, I1STH2M= 1, I2STH2M= 32, -E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / -&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&SIN4 BETAMAX = 1.33 / -&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, -XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 -IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. -NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, -FACBERG = 1.0, GSHIFT = 0.000E+00 / + UGOBCAUTO = F, + UGOBCDEPTH = -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_NLEVEL = 0, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-6, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / END OF NAMELISTS diff --git a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB index 90d19f1c3a..1a4dd99a6b 100644 --- a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB +++ b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB @@ -1 +1 @@ -NCO PDLIB SCOTCH NOGRB DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD1 TR0 BS0 WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 BIN2NC +NCO PDLIB SCOTCH NOGRB BIN2NC DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp index d2f508ac2f..6ae42b9081 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_a.inp @@ -66,60 +66,6 @@ $ Implicit with ww3ifr code version EXPFSFCT = F, IMPFSN = F / $ -$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - -$ JONSWAP : Namelist SBT1 -$ GAMMA : As it says. -$ &SBT1 GAMMA = 0.15 / -$ -$ Propagation schemes ------------------------------------------------ $ -$ First order : Namelist PRO1 -$ CFLTM : Maximum CFL number for refraction. -$ -$ UQ with diffusion : Namelist PRO2 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ DTIME : Swell age (s) in garden sprinkler -$ correction. If 0., all diffusion -$ switched off. If small non-zero -$ (DEFAULT !!!) only wave growth -$ diffusion. -$ LATMIN : Maximum latitude used in calc. of -$ strength of diffusion for prop. -$ -$ UQ with averaging : Namelist PRO3 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ WDTHCG : Tuning factor propag. direction. -$ WDTHTH : Tuning factor normal direction. -$ -$ UQ with divergence : Namelist PRO4 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ QTFAC : Tuning factor Eq. (3.41). -$ RSFAC : Tuning factor Eq. (3.42). -$ RNFAC : Tuning factor Eq. (3.43). -$ -$ Miscellaneous ------------------------------------------------------ $ -$ Misc. parameters : Namelist MISC -$ CICE0 : Ice concentration cut-off. -$ CICEN : Ice concentration cut-off. -$ XSEED : Xseed in seeding alg. (!/SEED). -$ FLAGTR : Indicating presence and type of -$ subgrid information : -$ 0 : No subgrid information. -$ 1 : Transparancies at cell boun- -$ daries between grid points. -$ 2 : Transp. at cell centers. -$ 3 : Like 1 with cont. ice. -$ 4 : Like 2 with cont. ice. -$ XP, XR, XFILT -$ Xp, Xr and Xf for the dynamic -$ integration scheme. -$ -$ In the 'Out of the box' test setup we run with sub-grid obstacles -$ and with continuous ice treatment. -$ -$ &SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / &SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, @@ -130,7 +76,7 @@ $ SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, SDSBRF1 = 0.50, SDSBRFDF = 0, SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ + WHITECAPWIDTH = 0.30/ &SBT1 GAMMA = -0.6700E-01 / &SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / &PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / @@ -143,27 +89,12 @@ $ STH2MF= 0, I1STH2M= 1, I2STH2M= 32, E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / $ -$ -$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / -$&REF1 REFCOAST=0.1 / -$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / &REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&SIN4 BETAMAX = 1.33 / &MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, FACBERG = 1.0, GSHIFT = 0.000E+00 / -$&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, -$ XSEED = 1.000, FLAGTR = 4, XP = 0.150, XR = 0.100, XFILT = 0.050 -$ IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. -$ NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, WCOR1 = 99.00, WCOR2 = 0.00, -$ FACBERG = 1.0, GSHIFT = 0.000E+00, STDX = -1.00, STDY = -1.00, -$ STDT = -1.00, ICEHMIN = 0.20, ICEHFAC = 1.00, -$ ICEHINIT = 0.50, ICEDISP = F, ICEHDISP = 0.60, -$ ICESLN = 1.00, ICEWIND = 1.00, ICESNL = 1.00, ICESDS = 1.00, -$ ICEDDISP = 80.00, ICEFDISP = 2.00, CALTYPE = standard , TRCKCMPR = T, -$ BTBET = 1.20 / $ $ Mandatory string to identify end of namelist input section. $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp index 3474c9a869..74b3cb0921 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.inp @@ -1,9 +1,8 @@ $ -------------------------------------------------------------------- $ $ WAVEWATCH III Grid preprocessor input file $ $ -------------------------------------------------------------------- $ -$ Grid name (C*30, in quotes) $ - 'GLOBAL' + 'Global Unstructured' $ $ Frequency increment factor and first frequency (Hz) ---------------- $ $ number of frequencies (wavenumbers) and directions, relative offset @@ -12,7 +11,9 @@ $ In versions 1.18 and 2.22 of the model this value was by definiton 0, $ it is added to mitigate the GSE for a first order scheme. Note that $ this factor is IGNORED in the print plots in ww3_outp. $ - 1.07 0.035 33 36 0. +$gfs: 1.07 0.035 50 36 0.5 +$gefs: 1.1 0.035 33 36 0.5 + 1.1 0.035 33 36 0.5 $ $ Set model flags ---------------------------------------------------- $ $ - FLDRY Dry run (input/output only, no calculation). @@ -28,40 +29,43 @@ $ maximum global time step, maximum CFL time step for x-y and $ k-theta, minimum source term time step (all in seconds). $ $ - 720. 360. 360. 30. + 720. 180. 360. 30. $ $ Start of namelist input section ------------------------------------ $ -$ Starting with WAVEWATCH III version 2.00, the tunable parameters -$ for source terms, propagation schemes, and numerics are read using -$ namelists. Any namelist found in the folowing sections up to the -$ end-of-section identifier string (see below) is temporarily written -$ to ww3_grid.scratch, and read from there if necessary. Namelists -$ not needed for the given switch settings will be skipped -$ automatically, and the order of the namelists is immaterial. $ -&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / -$ -&SIN4 ALPHA0=0.0095, - BETAMAX=1.33, - SINTHP=2.00, - Z0MAX=0.00, - ZALP=0.006, - ZWND=10.00, - TAUWSHELTER =1.00, - SWELLFPAR = 1, - SWELLF= 0.800, - SWELLF2=-0.018, - SWELLF3 =0.015, - SWELLF4 =100000.0, - SWELLF5 =1.200, - SWELLF6 =0.000, - SWELLF7 =230000.000, - Z0RAT =0.0400 / -$ -$ Implicit with ww3ifr code version -&UNST UGOBCAUTO = F, - UGOBCDEPTH= -10., - UGBCCFL= F, +&OUTS + USSP = 1, + IUSSP = 3, + STK_WN = 0.04, 0.110, 0.3305 / +&SIN4 + BETAMAX = 1.315, + TAUWSHELTER = 1.0, + SWELLF = 0.798, + SWELLF2 = -0.0127, + SWELLF3 = 0.0151, + SWELLF4 = 100025.0, + SWELLF5 = 1.1999, + SWELLF7 = 235500.0 / +&SNL1 + NLPROP = 2.502E7 / +&SDS4 + FXFM3 = 2.501, + SDSC2 = -2.1975e-05, + SDSCUM = -0.4032, + SDSC6 = 0.2978, + SDSBR = 0.0009035 / +&MISC + CICE0 = 0.75, + CICEN = 0.75 / +&SBT1 + GAMMA = -0.038 / +&PRO3 + WDTHCG=1.5, + WDTHTH=1.5 / +&UNST + UGOBCAUTO = F, + UGOBCDEPTH = -10., + UGBCCFL = F, EXPFSN = F, EXPFSPSI = F, EXPFSFCT = F, @@ -72,8 +76,8 @@ $ Implicit with ww3ifr code version IMPFREQSHIFT = F, IMPSOURCE = F, SETUP_APPLY_WLV = F, - SOLVERTHR_SETUP=1E-14, - CRIT_DEP_SETUP=0.1, + SOLVERTHR_SETUP = 1E-14, + CRIT_DEP_SETUP = 0.1, JGS_NLEVEL = 0, JGS_USE_JACOBI = F, JGS_BLOCK_GAUSS_SEIDEL = F, @@ -86,105 +90,6 @@ $ Implicit with ww3ifr code version JGS_LIMITER = F, JGS_NORM_THR = 1.E-6 / $ -$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - -$ JONSWAP : Namelist SBT1 -$ GAMMA : As it says. -$ &SBT1 GAMMA = 0.15 / -$ -$ Propagation schemes ------------------------------------------------ $ -$ First order : Namelist PRO1 -$ CFLTM : Maximum CFL number for refraction. -$ -$ UQ with diffusion : Namelist PRO2 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ DTIME : Swell age (s) in garden sprinkler -$ correction. If 0., all diffusion -$ switched off. If small non-zero -$ (DEFAULT !!!) only wave growth -$ diffusion. -$ LATMIN : Maximum latitude used in calc. of -$ strength of diffusion for prop. -$ -$ UQ with averaging : Namelist PRO3 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ WDTHCG : Tuning factor propag. direction. -$ WDTHTH : Tuning factor normal direction. -$ -$ UQ with divergence : Namelist PRO4 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ QTFAC : Tuning factor Eq. (3.41). -$ RSFAC : Tuning factor Eq. (3.42). -$ RNFAC : Tuning factor Eq. (3.43). -$ -$ Miscellaneous ------------------------------------------------------ $ -$ Misc. parameters : Namelist MISC -$ CICE0 : Ice concentration cut-off. -$ CICEN : Ice concentration cut-off. -$ XSEED : Xseed in seeding alg. (!/SEED). -$ FLAGTR : Indicating presence and type of -$ subgrid information : -$ 0 : No subgrid information. -$ 1 : Transparancies at cell boun- -$ daries between grid points. -$ 2 : Transp. at cell centers. -$ 3 : Like 1 with cont. ice. -$ 4 : Like 2 with cont. ice. -$ XP, XR, XFILT -$ Xp, Xr and Xf for the dynamic -$ integration scheme. -$ -$ In the 'Out of the box' test setup we run with sub-grid obstacles -$ and with continuous ice treatment. -$ -$ -&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, - SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / -&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, - SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, - WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, - SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, - SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, - SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, - SDSBRF1 = 0.50, SDSBRFDF = 0, - SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ -&SBT1 GAMMA = -0.6700E-01 / -&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / -&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / -&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, - US3D = 0, I1US3D = 1, I2US3D = 32, - E3D = 0, I1E3D = 1, I2E3D = 32, - TH1MF = 0, I1TH1M = 1, I2TH1M = 32, - STH1MF= 0, I1STH1M= 1, I2STH1M= 32, - TH2MF = 0, I1TH2M = 1, I2TH2M = 32, - STH2MF= 0, I1STH2M= 1, I2STH2M= 32, - E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / -$ -$ -$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / -$&REF1 REFCOAST=0.1 / -$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&SIN4 BETAMAX = 1.33 / -&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, - XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 - IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. - NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, - FACBERG = 1.0, GSHIFT = 0.000E+00 / -$&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, -$ XSEED = 1.000, FLAGTR = 4, XP = 0.150, XR = 0.100, XFILT = 0.050 -$ IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. -$ NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, WCOR1 = 99.00, WCOR2 = 0.00, -$ FACBERG = 1.0, GSHIFT = 0.000E+00, STDX = -1.00, STDY = -1.00, -$ STDT = -1.00, ICEHMIN = 0.20, ICEHFAC = 1.00, -$ ICEHINIT = 0.50, ICEDISP = F, ICEHDISP = 0.60, -$ ICESLN = 1.00, ICEWIND = 1.00, ICESNL = 1.00, ICESDS = 1.00, -$ ICEDDISP = 80.00, ICEFDISP = 2.00, CALTYPE = standard , TRCKCMPR = T, -$ BTBET = 1.20 / -$ $ Mandatory string to identify end of namelist input section. $ END OF NAMELISTS @@ -226,77 +131,13 @@ $ $ 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_unstr/global_1deg_unstr.msh' $ -$ If the above unit number equals 10, the bottom data is read from -$ this file and follows below (no intermediate comment lines allowed). -$ -$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -$ -$ If sub-grid information is avalaible as indicated by FLAGTR above, -$ additional input to define this is needed below. In such cases a -$ field of fractional obstructions at or between grid points needs to -$ be supplied. First the location and format of the data is defined -$ by (as above) : -$ - Unit number of file (can be 10, and/or identical to bottem depth -$ unit), scale factor for fractional obstruction, IDLA, IDFM, -$ format for formatted read, FROM and filename -$ -$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' -$ -$ *** NOTE if this unit number is the same as the previous bottom -$ depth unit number, it is assumed that this is the same file -$ without further checks. *** -$ -$ If the above unit number equals 10, the bottom data is read from -$ this file and follows below (no intermediate comment lines allowed, -$ except between the two fields). -$ -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 4 0 0 0 0 0 -$ 0 0 0 0 0 0 4 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 5 5 5 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ -$ *** NOTE size of fields is always NX * NY *** $ 10 3 1 '(....)' 'PART' 'mapsta.inp' $ Input boundary points ---------------------------------------------- $ -$ An unlimited number of lines identifying points at which input -$ boundary conditions are to be defined. If the actual input data is -$ not defined in the actual wave model run, the initial conditions -$ will be applied as constant boundary conditions. Each line contains: -$ Discrete grid counters (IX,IY) of the active point and a -$ connect flag. If this flag is true, and the present and previous -$ point are on a grid line or diagonal, all intermediate points -$ are also defined as boundary points. -$ -$ are also defined as boundary points. -$ $ Close list by defining point (0,0) (mandatory) $ 0 0 F $ -$ -$ $ Excluded grid points from segment data ( FROM != PART ) $ First defined as lines, identical to the definition of the input $ boundary points, and closed the same way. @@ -309,14 +150,6 @@ $ 0 0 $ $ Output boundary points --------------------------------------------- $ -$ Output boundary points are defined as a number of straight lines, -$ defined by its starting point (X0,Y0), increments (DX,DY) and number -$ of points. A negative number of points starts a new output file. -$ Note that this data is only generated if requested by the actual -$ program. Example again for spherical grid in degrees. -$ -$ -2.5312 48.5 0.00 0.008738 102 -$ -2.5312 49.3850 0.013554 0.00 51 $ $ Close list by defining line with 0 points (mandatory) $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml index e31a4eabbc..7f8ec4bc30 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_b.nml @@ -10,8 +10,10 @@ SPECTRUM%FREQ1 = 0.035 SPECTRUM%NK = 33 SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 0.5 / + ! -------------------------------------------------------------------- ! ! Define the run parameterization via RUN_NML namelist ! -------------------------------------------------------------------- ! @@ -28,7 +30,7 @@ ! -------------------------------------------------------------------- ! &TIMESTEPS_NML TIMESTEPS%DTMAX = 720. - TIMESTEPS%DTXY = 360. + TIMESTEPS%DTXY = 180. TIMESTEPS%DTKTH = 360. TIMESTEPS%DTMIN = 30. / diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp index 32db4238db..caaa4e78ac 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.inp @@ -1,9 +1,8 @@ $ -------------------------------------------------------------------- $ $ WAVEWATCH III Grid preprocessor input file $ $ -------------------------------------------------------------------- $ -$ Grid name (C*30, in quotes) $ - 'GLOBAL' + 'Global Unstructured' $ $ Frequency increment factor and first frequency (Hz) ---------------- $ $ number of frequencies (wavenumbers) and directions, relative offset @@ -12,7 +11,9 @@ $ In versions 1.18 and 2.22 of the model this value was by definiton 0, $ it is added to mitigate the GSE for a first order scheme. Note that $ this factor is IGNORED in the print plots in ww3_outp. $ - 1.07 0.035 50 36 0. +$gfs: 1.07 0.035 50 36 0.5 +$gefs: 1.1 0.035 33 36 0.5 + 1.1 0.035 33 36 0.5 $ $ Set model flags ---------------------------------------------------- $ $ - FLDRY Dry run (input/output only, no calculation). @@ -27,162 +28,66 @@ $ - Time step information (this information is always read) $ maximum global time step, maximum CFL time step for x-y and $ k-theta, minimum source term time step (all in seconds). $ -$ - 900. 900. 900. 900. +$ + 900. 900. 900. 900. $ $ Start of namelist input section ------------------------------------ $ -$ Starting with WAVEWATCH III version 2.00, the tunable parameters -$ for source terms, propagation schemes, and numerics are read using -$ namelists. Any namelist found in the folowing sections up to the -$ end-of-section identifier string (see below) is temporarily written -$ to ww3_grid.scratch, and read from there if necessary. Namelists -$ not needed for the given switch settings will be skipped -$ automatically, and the order of the namelists is immaterial. -$ -&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / -$ -&SIN4 ALPHA0=0.0095, - BETAMAX=1.33, - SINTHP=2.00, - Z0MAX=0.00, - ZALP=0.006, - ZWND=10.00, - TAUWSHELTER =1.00, - SWELLFPAR = 1, - SWELLF= 0.800, - SWELLF2=-0.018, - SWELLF3 =0.015, - SWELLF4 =100000.0, - SWELLF5 =1.200, - SWELLF6 =0.000, - SWELLF7 =230000.000, - Z0RAT =0.0400 / -$ -$ -$ Implicit with ww3ifr code version -&UNST -UGOBCAUTO = F -UGOBCDEPTH= -10. -EXPFSN = F, -EXPFSPSI = F, -EXPFSFCT = F, -IMPFSN = F, -EXPTOTAL = F, -IMPTOTAL = T, -IMPREFRACTION = T, -IMPFREQSHIFT = T, -IMPSOURCE = T, -SETUP_APPLY_WLV = F, -SOLVERTHR_SETUP=1E-14, -CRIT_DEP_SETUP=0.1, -JGS_USE_JACOBI = T, -JGS_BLOCK_GAUSS_SEIDEL = T, -JGS_TERMINATE_MAXITER = T, -JGS_MAXITER = 1000, -JGS_TERMINATE_NORM = F, -JGS_TERMINATE_DIFFERENCE = T, -JGS_DIFF_THR = 1.E-6, -JGS_PMIN = 3.0, -JGS_LIMITER = F, -JGS_NORM_THR = 1.E-6 / -$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - -$ JONSWAP : Namelist SBT1 -$ GAMMA : As it says. -$ &SBT1 GAMMA = 0.15 / -$ -$ Propagation schemes ------------------------------------------------ $ -$ First order : Namelist PRO1 -$ CFLTM : Maximum CFL number for refraction. -$ -$ UQ with diffusion : Namelist PRO2 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ DTIME : Swell age (s) in garden sprinkler -$ correction. If 0., all diffusion -$ switched off. If small non-zero -$ (DEFAULT !!!) only wave growth -$ diffusion. -$ LATMIN : Maximum latitude used in calc. of -$ strength of diffusion for prop. -$ -$ UQ with averaging : Namelist PRO3 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ WDTHCG : Tuning factor propag. direction. -$ WDTHTH : Tuning factor normal direction. -$ -$ UQ with divergence : Namelist PRO4 -$ CFLTM : Maximum CFL number for refraction. -$ FLSOFT : Flag for 'soft' land boundaries. -$ QTFAC : Tuning factor Eq. (3.41). -$ RSFAC : Tuning factor Eq. (3.42). -$ RNFAC : Tuning factor Eq. (3.43). -$ -$ Miscellaneous ------------------------------------------------------ $ -$ Misc. parameters : Namelist MISC -$ CICE0 : Ice concentration cut-off. -$ CICEN : Ice concentration cut-off. -$ XSEED : Xseed in seeding alg. (!/SEED). -$ FLAGTR : Indicating presence and type of -$ subgrid information : -$ 0 : No subgrid information. -$ 1 : Transparancies at cell boun- -$ daries between grid points. -$ 2 : Transp. at cell centers. -$ 3 : Like 1 with cont. ice. -$ 4 : Like 2 with cont. ice. -$ XP, XR, XFILT -$ Xp, Xr and Xf for the dynamic -$ integration scheme. -$ -$ In the 'Out of the box' test setup we run with sub-grid obstacles -$ and with continuous ice treatment. -$ -$ -&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, - SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / -&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, - SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, - WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, - SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, - SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, - SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, - SDSBRF1 = 0.50, SDSBRFDF = 0, - SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, -, WHITECAPWIDTH = 0.30/ -&SBT1 GAMMA = -0.6700E-01 / -&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / -&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / -&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, - US3D = 0, I1US3D = 1, I2US3D = 32, - E3D = 0, I1E3D = 1, I2E3D = 32, - TH1MF = 0, I1TH1M = 1, I2TH1M = 32, - STH1MF= 0, I1STH1M= 1, I2STH1M= 32, - TH2MF = 0, I1TH2M = 1, I2TH2M = 32, - STH2MF= 0, I1STH2M= 1, I2STH2M= 32, - E3D = 1, USSP = 1, IUSSP = 3, STK_WN = 0.04, 0.110, 0.3305 / -$ $ -$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / -$&REF1 REFCOAST=0.1 / -$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / -&SIN4 BETAMAX = 1.33 / -&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, - XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 - IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. - NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, - FACBERG = 1.0, GSHIFT = 0.000E+00 / -$&MISC CICE0 = 0.250, CICEN = 0.750, LICE = 0.0, PMOVE = 0.500, -$ XSEED = 1.000, FLAGTR = 4, XP = 0.150, XR = 0.100, XFILT = 0.050 -$ IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. -$ NOSW = 3, FMICHE = 1.600, RWNDC = 1.000, WCOR1 = 99.00, WCOR2 = 0.00, -$ FACBERG = 1.0, GSHIFT = 0.000E+00, STDX = -1.00, STDY = -1.00, -$ STDT = -1.00, ICEHMIN = 0.20, ICEHFAC = 1.00, -$ ICEHINIT = 0.50, ICEDISP = F, ICEHDISP = 0.60, -$ ICESLN = 1.00, ICEWIND = 1.00, ICESNL = 1.00, ICESDS = 1.00, -$ ICEDDISP = 80.00, ICEFDISP = 2.00, CALTYPE = standard , TRCKCMPR = T, -$ BTBET = 1.20 / +&OUTS + USSP = 1, + IUSSP = 3, + STK_WN = 0.04, 0.110, 0.3305 / +&SIN4 + BETAMAX = 1.315, + TAUWSHELTER = 1.0, + SWELLF = 0.798, + SWELLF2 = -0.0127, + SWELLF3 = 0.0151, + SWELLF4 = 100025.0, + SWELLF5 = 1.1999, + SWELLF7 = 235500.0 / +&SNL1 + NLPROP = 2.502E7 / +&SDS4 + FXFM3 = 2.501, + SDSC2 = -2.1975e-05, + SDSCUM = -0.4032, + SDSC6 = 0.2978, + SDSBR = 0.0009035 / +&MISC + CICE0 = 0.75, + CICEN = 0.75 / +&SBT1 + GAMMA = -0.038 / +&PRO3 + WDTHCG=1.5, + WDTHTH=1.5 / +&UNST + UGOBCAUTO = F, + UGOBCDEPTH = -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_NLEVEL = 0, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-6, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / $ $ Mandatory string to identify end of namelist input section. $ @@ -225,77 +130,13 @@ $ $ 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_unstr/global_1deg_unstr.msh' $ -$ If the above unit number equals 10, the bottom data is read from -$ this file and follows below (no intermediate comment lines allowed). -$ -$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 -$ -$ If sub-grid information is avalaible as indicated by FLAGTR above, -$ additional input to define this is needed below. In such cases a -$ field of fractional obstructions at or between grid points needs to -$ be supplied. First the location and format of the data is defined -$ by (as above) : -$ - Unit number of file (can be 10, and/or identical to bottem depth -$ unit), scale factor for fractional obstruction, IDLA, IDFM, -$ format for formatted read, FROM and filename -$ -$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' -$ -$ *** NOTE if this unit number is the same as the previous bottom -$ depth unit number, it is assumed that this is the same file -$ without further checks. *** -$ -$ If the above unit number equals 10, the bottom data is read from -$ this file and follows below (no intermediate comment lines allowed, -$ except between the two fields). -$ -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 4 0 0 0 0 0 -$ 0 0 0 0 0 0 4 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 5 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 5 5 5 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ 0 0 0 0 0 0 0 0 0 0 0 0 -$ -$ *** NOTE size of fields is always NX * NY *** $ 10 3 1 '(....)' 'PART' 'mapsta.inp' $ Input boundary points ---------------------------------------------- $ -$ An unlimited number of lines identifying points at which input -$ boundary conditions are to be defined. If the actual input data is -$ not defined in the actual wave model run, the initial conditions -$ will be applied as constant boundary conditions. Each line contains: -$ Discrete grid counters (IX,IY) of the active point and a -$ connect flag. If this flag is true, and the present and previous -$ point are on a grid line or diagonal, all intermediate points -$ are also defined as boundary points. -$ -$ are also defined as boundary points. -$ $ Close list by defining point (0,0) (mandatory) $ 0 0 F $ -$ -$ $ Excluded grid points from segment data ( FROM != PART ) $ First defined as lines, identical to the definition of the input $ boundary points, and closed the same way. @@ -308,14 +149,6 @@ $ 0 0 $ $ Output boundary points --------------------------------------------- $ -$ Output boundary points are defined as a number of straight lines, -$ defined by its starting point (X0,Y0), increments (DX,DY) and number -$ of points. A negative number of points starts a new output file. -$ Note that this data is only generated if requested by the actual -$ program. Example again for spherical grid in degrees. -$ -$ -2.5312 48.5 0.00 0.008738 102 -$ -2.5312 49.3850 0.013554 0.00 51 $ $ Close list by defining line with 0 points (mandatory) $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml index 9c68a4e317..00dcdf635b 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_c.nml @@ -6,10 +6,11 @@ ! Define the spectrum parameterization via SPECTRUM_NML namelist ! -------------------------------------------------------------------- ! &SPECTRUM_NML - SPECTRUM%XFR = 1.07 + SPECTRUM%XFR = 1.1 SPECTRUM%FREQ1 = 0.035 - SPECTRUM%NK = 50 + SPECTRUM%NK = 33 SPECTRUM%NTH = 36 + SPECTRUM%THOFF = 0.5 / ! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp index c721aeffce..ccc3d4722b 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.inp @@ -19,7 +19,7 @@ $ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED $ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 $ N - WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR UST CHA + WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR $ $--------------------------------------------------------------------- $ $ netCDF version [3,4] diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml index 2995d58833..ec1c8f0f86 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_ounf.nml @@ -28,8 +28,6 @@ FILE%VAR(10) = 'PHS' FILE%VAR(11) = 'PTP' FILE%VAR(12) = 'PDIR' - FILE%VAR(13) = 'UST' - FILE%VAR(14) = 'CHA' / ! -------------------------------------------------------------------- ! diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp index c33d0a4d1c..4030e0593e 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.inp @@ -27,7 +27,7 @@ $ Fields of mean wave parameters $ 20210401 000000 3600 20210402 000000 N -CHA EF UST WND HS FP DP PHS PTP PDIR CUR ICE + WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR $ $ Point output $ diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml index c3ceb1056e..0fa97ba304 100644 --- a/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_shel.nml @@ -25,7 +25,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'CHA EF UST WND HS FP DP PHS PTP PDIR CUR ICE' + TYPE%FIELD%LIST = 'WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR' TYPE%POINT%FILE = '../input_unstr/ww3_points.list' / From c13906477c5e61cfe377023093693b0e6fcbf14c Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Tue, 28 Oct 2025 14:19:13 +0100 Subject: [PATCH 110/136] Bugfix th2m (#1517) --- manual/eqs/output.tex | 2 +- model/src/w3iogomd.F90 | 2 +- regtests/ww3_tp2.3/input/namelists_GARDEN.nml | 2 +- regtests/ww3_tp2.3/input/ww3_grid.inp | 2 +- regtests/ww3_tp2.3/input/ww3_ounf.inp | 2 +- regtests/ww3_tp2.3/input/ww3_ounf.nml | 2 +- regtests/ww3_tp2.3/input/ww3_shel.inp | 2 +- regtests/ww3_tp2.3/input/ww3_shel.nml | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/manual/eqs/output.tex b/manual/eqs/output.tex index ef9e38c664..174b3adfef 100644 --- a/manual/eqs/output.tex +++ b/manual/eqs/output.tex @@ -128,7 +128,7 @@ \subsection{~Output parameters} \label{sub:outpars} \frac{a_1(f)^2+b_1(f)^2}{E(f)^2} \right )^{1/2} \right \} \right ]^{1/2} \: , \label{eq:sig_th1} \end{equation} \item \textbf{TH2M} Mean direction from $a_2$ and $b_2$ (degr.) - \begin{equation} \theta_2 (f)= \mbox{atan} \left ( \frac{b_2(f)}{a_2(f)} \right ) + \begin{equation} \theta_2 (f)= 0.5 \mbox{atan} \left ( \frac{b_2(f)}{a_2(f)} \right ) \: , \label{eq:theta_2} \end{equation} \begin{equation} a_2(f) = 2 \pi \int_0^{2\pi} \int_0^\infty \cos(2 \theta) F(\sigma,\theta) \: \mathrm{d}\theta \: , \end{equation} \begin{equation} diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 91a82f9001..c4c78191ed 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1684,7 +1684,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) IF ( FLOLOC( 3, 3).AND.(IK.GE.E3DF(2,3).AND.IK.LE.E3DF(3,3))) & STH1M(JSEA,IK)= SQRT(ABS(2.*(1-M1)))*RADE IF ( FLOLOC( 3, 4).AND.(IK.GE.E3DF(2,4).AND.IK.LE.E3DF(3,4))) & - TH2M(JSEA,IK)= MOD ( 270. - RADE*0.5*ATAN2(ABY2(JSEA),AB2X(JSEA)) , 180. ) + TH2M(JSEA,IK)= MOD ( 270. - RADE*0.5*ATAN2(AB2Y(JSEA),AB2X(JSEA)) , 180. ) M2 = SQRT(AB2X(JSEA)**2+AB2Y(JSEA)**2)/MAX(1E-20,AB(JSEA)) IF ( FLOLOC( 3, 5).AND.(IK.GE.E3DF(2,5).AND.IK.LE.E3DF(3,5))) & STH2M(JSEA,IK)= SQRT(ABS(0.5*(1-M2)))*RADE diff --git a/regtests/ww3_tp2.3/input/namelists_GARDEN.nml b/regtests/ww3_tp2.3/input/namelists_GARDEN.nml index b8533dddaa..4069e95450 100644 --- a/regtests/ww3_tp2.3/input/namelists_GARDEN.nml +++ b/regtests/ww3_tp2.3/input/namelists_GARDEN.nml @@ -1,4 +1,4 @@ -&OUTS E3D=1, TH1MF=1, STH1MF=1 / +&OUTS E3D=1, TH1MF=1, STH1MF=1,TH2MF=1, STH2MF=1 / &PRO2 DTIME=345600. / &PRO3 WDTHTH=1.50, WDTHCG=1.50 / END OF NAMELISTS diff --git a/regtests/ww3_tp2.3/input/ww3_grid.inp b/regtests/ww3_tp2.3/input/ww3_grid.inp index 3a42713071..a6794bcd6e 100644 --- a/regtests/ww3_tp2.3/input/ww3_grid.inp +++ b/regtests/ww3_tp2.3/input/ww3_grid.inp @@ -16,7 +16,7 @@ $ $ $ Activated up to one line per namelist !! $ - &OUTS E3D=1, TH1MF=1, STH1MF=1 / + &OUTS E3D=1, TH1MF=1, STH1MF=1, TH2MF=1, STH2MF=1 / $ &PRO2 DTIME= 0. / $ &PRO2 DTIME=172800. / &PRO2 DTIME=345600. / diff --git a/regtests/ww3_tp2.3/input/ww3_ounf.inp b/regtests/ww3_tp2.3/input/ww3_ounf.inp index b0c2404f0d..4fb0a9dde9 100644 --- a/regtests/ww3_tp2.3/input/ww3_ounf.inp +++ b/regtests/ww3_tp2.3/input/ww3_ounf.inp @@ -13,7 +13,7 @@ $ file for a full documentation of field output options. Namelist type $ selection is used here (for alternative F/T flags, see ww3_shel.inp). $ N - HS DIR SPR DP EF TH1M STH1M + HS DIR SPR DP EF TH1M STH1M TH2M STH2M $ $--------------------------------------------------------------------- $ $ netCDF version [3,4] diff --git a/regtests/ww3_tp2.3/input/ww3_ounf.nml b/regtests/ww3_tp2.3/input/ww3_ounf.nml index 034cc7cdcc..4244fcf3db 100644 --- a/regtests/ww3_tp2.3/input/ww3_ounf.nml +++ b/regtests/ww3_tp2.3/input/ww3_ounf.nml @@ -9,7 +9,7 @@ FIELD%TIMESTART = '19680606 000000' FIELD%TIMESTRIDE = '86400.' FIELD%TIMECOUNT = '999' - FIELD%LIST = 'HS DIR SPR DP EF TH1M STH1M' + FIELD%LIST = 'HS DIR SPR DP EF TH1M STH1M TH2M STH2M' FIELD%PARTITION = '0 1 2' FIELD%TYPE = 4 / diff --git a/regtests/ww3_tp2.3/input/ww3_shel.inp b/regtests/ww3_tp2.3/input/ww3_shel.inp index 2d69bd5e4a..ad588a3b7e 100644 --- a/regtests/ww3_tp2.3/input/ww3_shel.inp +++ b/regtests/ww3_tp2.3/input/ww3_shel.inp @@ -18,7 +18,7 @@ $ 19680606 000000 86400 19680611 000000 $ (1) Forcing Fields N -HS DIR SPR DP EF TH1M STH1M +HS DIR SPR DP EF TH1M STH1M TH2M STH2M $ 19680606 000000 0 19680608 000000 19680606 000000 0 19680608 000000 diff --git a/regtests/ww3_tp2.3/input/ww3_shel.nml b/regtests/ww3_tp2.3/input/ww3_shel.nml index 8b5e606293..42b29b1879 100644 --- a/regtests/ww3_tp2.3/input/ww3_shel.nml +++ b/regtests/ww3_tp2.3/input/ww3_shel.nml @@ -21,7 +21,7 @@ ! Define the output types point parameters via OUTPUT_TYPE_NML namelist ! -------------------------------------------------------------------- ! &OUTPUT_TYPE_NML - TYPE%FIELD%LIST = 'HS DIR SPR DP EF TH1M STH1M' + TYPE%FIELD%LIST = 'HS DIR SPR DP EF TH1M STH1M TH2M STH2M' / ! -------------------------------------------------------------------- ! From 1b8dbd95a6ac25552fdad1a0cf1ad425bc8acfd7 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 31 Oct 2025 17:15:35 -0400 Subject: [PATCH 111/136] add only clause to use statement in w3wavemd and fix USE MODULE remarks (#1520) --- model/src/w3adatmd.F90 | 6 +- model/src/w3pro2md.F90 | 4 +- model/src/w3pro3md.F90 | 4 +- model/src/w3profsmd_pdlib.F90 | 1 - model/src/w3wavemd.F90 | 124 ++++++++++++++++++++++++++-------- 5 files changed, 104 insertions(+), 35 deletions(-) diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 06576d1473..01eedd344a 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -563,7 +563,7 @@ MODULE W3ADATMD #endif REAL, POINTER :: SPPNT(:,:,:) ! - INTEGER :: ITIME, IPASS, IDLAST, NSEALM + INTEGER :: ITIME, IPASS, IDLAST, NSEALM, ITSTEP REAL, POINTER :: ALPHA(:,:) LOGICAL :: AINIT, AINIT2, FL_ALL, FLCOLD, FLIWND ! @@ -685,7 +685,7 @@ MODULE W3ADATMD #endif REAL, POINTER :: SPPNT(:,:,:) ! - INTEGER, POINTER :: ITIME, IPASS, IDLAST, NSEALM + INTEGER, POINTER :: ITIME, IPASS, IDLAST, NSEALM, ITSTEP REAL, POINTER :: ALPHA(:,:) LOGICAL, POINTER :: AINIT, AINIT2, FL_ALL, FLCOLD, FLIWND !/ @@ -800,6 +800,7 @@ SUBROUTINE W3NAUX ( NDSE, NDST ) WADATS(I)%IPASS = 0 WADATS(I)%IDLAST = 0 WADATS(I)%NSEALM = 0 + WADATS(I)%ITSTEP = 0 WADATS(I)%FLCOLD = .FALSE. WADATS(I)%FLIWND = .FALSE. WADATS(I)%AINIT = .FALSE. @@ -2760,6 +2761,7 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) IPASS => WADATS(IMOD)%IPASS IDLAST => WADATS(IMOD)%IDLAST NSEALM => WADATS(IMOD)%NSEALM + ITSTEP => WADATS(IMOD)%ITSTEP FLCOLD => WADATS(IMOD)%FLCOLD FLIWND => WADATS(IMOD)%FLIWND AINIT => WADATS(IMOD)%AINIT diff --git a/model/src/w3pro2md.F90 b/model/src/w3pro2md.F90 index a23f893efa..0a26c8c944 100644 --- a/model/src/w3pro2md.F90 +++ b/model/src/w3pro2md.F90 @@ -1412,7 +1412,7 @@ SUBROUTINE W3KTP2 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DEPTH, & USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & CTMAX - USE W3ADATMD, ONLY: MAPTH2, MAPWN2, ITIME + USE W3ADATMD, ONLY: MAPTH2, MAPWN2, ITIME, ITSTEP USE W3IDATMD, ONLY: FLCUR USE W3ODATMD, ONLY: NDSE, NDST #ifdef W3_S @@ -1604,7 +1604,7 @@ SUBROUTINE W3KTP2 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DEPTH, & ! ! 5. Propagate ------------------------------------------------------ * ! - IF ( MOD(ITIME,2) .EQ. 0 ) THEN + IF ( MOD(ITSTEP,2) .EQ. 0 ) THEN IF ( FLCK ) THEN DO ITH=1, NTH VQ(NK+2+(ITH-1)*NK2) = FACHFA * VQ(NK+1+(ITH-1)*NK2) diff --git a/model/src/w3pro3md.F90 b/model/src/w3pro3md.F90 index 96396a7a43..cd28cd96a2 100644 --- a/model/src/w3pro3md.F90 +++ b/model/src/w3pro3md.F90 @@ -1625,7 +1625,7 @@ SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & CTMAX, DMIN - USE W3ADATMD, ONLY: MAPTH2, MAPWN2, ITIME + USE W3ADATMD, ONLY: MAPTH2, MAPWN2, ITIME, ITSTEP USE W3IDATMD, ONLY: FLCUR USE W3ODATMD, ONLY: NDSE, NDST #ifdef W3_S @@ -1848,7 +1848,7 @@ SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & ! ! 5. Propagate ------------------------------------------------------ * ! - IF ( MOD(ITIME,2) .EQ. 0 ) THEN + IF ( MOD(ITSTEP,2) .EQ. 0 ) THEN IF ( FLCK ) THEN DO ITH=1, NTH VQ(NK+2+(ITH-1)*NK2) = FACHFA * VQ(NK+1+(ITH-1)*NK2) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 478baa9680..f4135f4ff5 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5548,7 +5548,6 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL #ifdef W3_REF1 USE W3GDATMD, only: REFPARS #endif - use mpi_f08 implicit none LOGICAL, INTENT(IN) :: LCALC diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index fd24f3d913..6d1ba15cdf 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -406,62 +406,125 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE CONSTANTS + USE CONSTANTS, ONLY : UNDEF, RADIUS, DERA, DAIR, SRCE_DIRECT, LPDLIB, & + SRCE_IMP_POST, SRCE_IMP_PRE, TPIINV !/ - USE W3GDATMD - USE W3WDATMD - USE W3ADATMD - USE W3IDATMD - USE W3ODATMD + USE W3GDATMD, ONLY : IGRID, NSEAL, NSPEC, NX, NY, NK, NSEA, & + GTYPE, UNGTYPE, SMCTYPE, RSTYPE, FILEXT, & + MAPSF, MAPFS, MAPSTA, IOBP, CTHG0S, & + FLCTH, FSREFRACTION, FLCK, FSFREQSHIFT, FLAGLL, & + FLDRY, FSTOTALIMP, FLCX, FLCY, FLSOU, FLAGST, & + SIG, CLATS, TRNX, TRNY, DTMAX, DTCFLI, DTH, & + DMIN, W3SETG, MAPST2 !/ - USE W3UPDTMD - USE W3SRCEMD + USE W3WDATMD, ONLY : UST, IWDATA, TIME, TLEV, TICE, TIC1, VA, ASF, & + RHOAIR, USTDIR, ICE, ICEH, ICEF, ICEDMAX, BERG, & + FPIS, W3SETW + !/ + USE W3ADATMD, ONLY : FLIWND, FLCOLD, IAPPRO, IDLAST, IADATA, IPASS, & + ITIME, CFLXYMAX, CFLTHMAX, CFLKMAX, DTDYN, & + CG, DW, CX, CY, DCDX, DCDY, DCXDX, DCXDY, DCYDX, & + DCYDY, AS, TAUOX, TAUOY, TAUWIX, TAUWIY, TAUWNX, & + TAUWNY, DDDX, DDDY, ALPHA, WN, U10, U10D, TAUA, & + TAUADIR, FCUT, WHITECAP, BEDFORMS, TAUBBL, & + TAUICE, PHIBBL, TAUOCX, TAUOCY, WNMEAN, PHIAW, & + PHIOC, TWS, PHICE, CHARN, W3SETA, ITSTEP + !/ + USE W3IDATMD, ONLY : IIDATA, INFLAGS1, FLLEV, FLCUR, FLWIND, FLICE, & + FLTAUA, FLRHOA, FLIC1, FLIC2, FLIC3, FLIC4, & + FLIC5, TLN, TC0, TCN, TW0, TWN, TIN, TU0, TUN, & + TI1, TGN, TG0, GA0, GAN, GD0, GDN, TDN, TRN, & + TR0, W3SETI + !/ + USE W3ODATMD, ONLY : FLOUT, FLOGRD, FLOGR2, FLBPI, NOGE, & + NDS, NOGE, NAPLOG, NAPOUT, NDSO, NDSE, NDST, & + NAPROC, NAPERR, SCREEN, IAPROC, IOUTP, NOTYPE, & + NAPBPT, TOFRST, TONEXT, TBPIN, TBPI0, TOLAST, & + DTOUT, NAPFLD, NAPPNT, W3SETO, FNMRST + !/ + USE W3UPDTMD, ONLY : W3DZXY, W3UWND, W3UINI, W3UTAU, W3URHO, W3UBPT, & + W3UICE, W3ULEV, W3UCUR, W3UIC1, W3UTRN + !/ + USE W3SRCEMD, ONLY : W3SRCE + !/ +#ifdef W3_MPI + USE W3ODATMD, ONLY : NRQGO, NRQGO2, IRQGO, IRQGO2, NRQPO, NRQPO2, & + IRQPO1, IRQPO2 + USE W3ODATMD, ONLY : NRQRS, IRQRS, IRQPO1, NRQBP, IRQBP1, IRQBP2, & + NRQBP2 + USE W3ADATMD, ONLY : NRQSG1, IRQSG1, NRQSG1, MPI_COMM_WAVE +#endif +#ifdef W3_NL5 + USE W3ODATMD, ONLY : TOSNL5 +#endif +#ifdef W3_BIN2NC + USE W3IOPOMD, ONLY : W3IOPON +#endif +#ifdef W3_SEC1 + USE W3GDATMD, ONLY : NITERSEC1 +#endif +#ifdef W3_REF1 + USE W3GDATMD, ONLY : RLGTYPE, SX, SY, CLGTYPE, HPFAC, HQFAC, REFLC, REFLD +#endif +#ifdef W3_BT4 + USE W3GDATMD, ONLY : SED_D50, SED_PSIC +#endif #ifdef W3_PR1 - USE W3PRO1MD + USE W3PRO1MD, ONLY : W3MAP1, W3XYP1, W3KTP1 #endif #ifdef W3_PR2 - USE W3PRO2MD + USE W3PRO2MD, ONLY : W3XYP2, W3MAP2, W3KTP2 #endif #ifdef W3_PR3 - USE W3PRO3MD + USE W3PRO3MD, ONLY : W3MAPT, W3XYP3, W3CFLXY, W3MAP3, W3KTP3 #endif #ifdef W3_SMC - USE W3PSMCMD + USE W3PSMCMD, ONLY : SMCDHXY, SMCDCXY, W3SCATSMC, W3GATHSMC, W3PSMC, W3KRTN + USE W3GDATMD, only : ANGARC, ARCTC, NBAC, NBGL, NGLO, NCel, ICLBAC, SPCBAC + USE W3ADATMD, only : DHDX, DHDY, DHLMT + USE W3GDATMD, only : NTH + USE W3SERVMD, only : W3ACTURN #endif ! #ifdef W3_PR1 - USE W3PROFSMD + USE W3PROFSMD, ONLY : W3XYPUG #endif #ifdef W3_PR2 - USE W3PROFSMD + USE W3PROFSMD, ONLY : W3XYPUG #endif #ifdef W3_PR3 - USE W3PROFSMD + USE W3PROFSMD, ONLY : W3XYPUG, W3CFLUG #endif !/ - USE W3TRIAMD - USE W3IOGRMD - USE W3IOGOMD - USE W3IOPOMD - USE W3IOTRMD - USE W3IORSMD - USE W3IOBCMD - USE W3IOSFMD + USE W3TRIAMD, ONLY : UG_GRADIENTS + USE W3IOGOMD, ONLY : W3IOGO, W3OUTG + USE W3IOPOMD, ONLY : W3IOPO, W3IOPE + USE W3IOTRMD, ONLY : W3IOTR + USE W3IORSMD, ONLY : W3IORS + USE W3IOBCMD, ONLY : W3IOBC + USE W3IOSFMD, ONLY : W3IOSF, W3CPRT #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, only : APPLY_BOUNDARY_CONDITION_VA USE PDLIB_W3PROFSMD, only : PDLIB_W3XYPUG, PDLIB_W3XYPUG_BLOCK_IMPLICIT, PDLIB_W3XYPUG_BLOCK_EXPLICIT USE PDLIB_W3PROFSMD, only : ALL_VA_INTEGRAL_PRINT, ALL_VAOLD_INTEGRAL_PRINT, ALL_FIELD_INTEGRAL_PRINT USE W3PARALL, only : PDLIB_NSEAL, PDLIB_NSEALM USE yowNodepool, only: npa, iplg, np + USE W3WDATMD, ONLY : VAOLD, VSTOT, VDTOT, SHAVETOT + USE W3GDATMD, ONLY : FSSOURCE, FSTOTALEXP + USE W3GDATMD, ONLY : IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC #endif !/ - USE W3SERVMD - USE W3TIMEMD + USE W3SERVMD, ONLY : EXTCDE, WWTIME + USE W3TIMEMD, ONLY : DSEC21, TICK21, STME21 #ifdef W3_IC3 - USE W3SIC3MD + USE W3SIC3MD, ONLY : CALLEDIC3TABLE, IC3TABLE_CHENG, W3IC3WNCG_V1, W3IC3WNCG_CHENG + USE W3GDATMD, ONLY : IC3PARS + USE W3IDATMD, ONLY : ICEP1, ICEP2, ICEP3, ICEP4 #endif #ifdef W3_IS2 - USE W3SIS2MD + USE W3WDATMD, ONLY : TIC5 + USE W3IDATMD, ONLY : TI5 + USE W3UPDTMD, ONLY : W3UIC5 #endif #ifdef W3_UOST USE W3UOSTMD, ONLY: UOST_SETGRID @@ -473,6 +536,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_OASIS USE W3OACPMD, ONLY: ID_OASIS_TIME, CPLT0 + USE W3WDATMD, ONLY: TIME00, TIMEEND #endif #ifdef W3_OASOCM USE W3OGCMMD, ONLY: SND_FIELDS_TO_OCEAN @@ -1017,7 +1081,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTGA = DTTST / REAL(NT) IF ( DTTST .EQ. 0. ) THEN IT0 = 0 - IF ( .NOT.FLZERO ) ITIME = ITIME - 1 + IF ( .NOT.FLZERO ) THEN + ITIME = ITIME - 1 + ITSTEP = ITSTEP - 1 + END IF NT = 0 ELSE IT0 = 1 @@ -1061,6 +1128,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 0') ! ITIME = ITIME + 1 + ITSTEP = ITSTEP + 1 ! DTG = REAL(NINT(DTGA+DTRES+0.0001)) DTRES = DTRES + DTGA - DTG From 9c95c6e589404f6f4f50f020b60077503f5b1247 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Wed, 5 Nov 2025 11:43:34 -0500 Subject: [PATCH 112/136] Fix Fortran compile flag scope to avoid ifx real-size override warning in WW3 and operational workflow (#1522) --- model/src/CMakeLists.txt | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/model/src/CMakeLists.txt b/model/src/CMakeLists.txt index 59dec391c2..63b95f933f 100644 --- a/model/src/CMakeLists.txt +++ b/model/src/CMakeLists.txt @@ -206,9 +206,17 @@ foreach(program ${programs}) target_link_libraries(${program} PRIVATE ww3_lib) endforeach() -target_compile_options(ww3_lib PUBLIC "$<$:${compile_flags}>") -target_compile_options(ww3_lib PUBLIC "$<$,$>:${compile_flags_debug}>") -target_compile_options(ww3_lib PUBLIC "$<$,$>:${compile_flags_release}>") +if (UFS_CAP) + # Building as part of UFS (submodule) + set(WW3_FLAG_SCOPE PRIVATE) +else() + # Standalone WW3 build + set(WW3_FLAG_SCOPE PUBLIC) +endif() + +target_compile_options(ww3_lib ${WW3_FLAG_SCOPE} "$<$:${compile_flags}>") +target_compile_options(ww3_lib ${WW3_FLAG_SCOPE} "$<$,$>:${compile_flags_debug}>") +target_compile_options(ww3_lib ${WW3_FLAG_SCOPE} "$<$,$>:${compile_flags_release}>") install( TARGETS ${programs} ww3_lib From 639b3983400c7e251fb3f32ee7312c51c2336958 Mon Sep 17 00:00:00 2001 From: Alain Coat <97431609+alcoat@users.noreply.github.com> Date: Wed, 5 Nov 2025 18:24:36 +0100 Subject: [PATCH 113/136] Solve GNU & Intel build and allow to compile with switches S and T (#1509) --- .github/workflows/{gnu.yml.tempdisable => gnu.yml} | 9 +++++---- .../workflows/{intel.yml.tempdisable => intel.yml} | 2 +- .../{regtest_gnu.yml.tempdisable => regtest_gnu.yml} | 8 ++++---- model/ci/spack_gnu.yaml | 6 +++--- model/ci/spack_intel.yaml | 4 ++-- model/src/w3adatmd.F90 | 4 ++-- model/src/w3iogrmd.F90 | 11 +++++++---- model/src/w3snl1md.F90 | 8 ++++++-- model/src/wmesmfmd.F90 | 8 +++++--- model/src/ww3_prtide.F90 | 3 +++ 10 files changed, 38 insertions(+), 25 deletions(-) rename .github/workflows/{gnu.yml.tempdisable => gnu.yml} (93%) rename .github/workflows/{intel.yml.tempdisable => intel.yml} (99%) rename .github/workflows/{regtest_gnu.yml.tempdisable => regtest_gnu.yml} (96%) diff --git a/.github/workflows/gnu.yml.tempdisable b/.github/workflows/gnu.yml similarity index 93% rename from .github/workflows/gnu.yml.tempdisable rename to .github/workflows/gnu.yml index d28d1bb5b5..78db170f63 100644 --- a/.github/workflows/gnu.yml.tempdisable +++ b/.github/workflows/gnu.yml @@ -8,9 +8,9 @@ concurrency: env: cache_key: gnu11 - CC: gcc-10 - FC: gfortran-10 - CXX: g++-10 + CC: gcc-14 + FC: gfortran-14 + CXX: g++-14 # Split into a steup step, and a WW3 build step which @@ -45,7 +45,8 @@ jobs: run: | # Install NetCDF, ESMF, g2, etc using Spack sudo apt install cmake - git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git + #git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git + git clone -c feature.manyFiles=true --depth=2 --branch=spack-stack-1.9.3 https://github.com/JCSDA/spack.git source spack/share/spack/setup-env.sh spack env create ww3-gnu ww3/model/ci/spack_gnu.yaml spack env activate ww3-gnu diff --git a/.github/workflows/intel.yml.tempdisable b/.github/workflows/intel.yml similarity index 99% rename from .github/workflows/intel.yml.tempdisable rename to .github/workflows/intel.yml index f5de65dcd3..bf18a8cead 100644 --- a/.github/workflows/intel.yml.tempdisable +++ b/.github/workflows/intel.yml @@ -26,7 +26,7 @@ env: jobs: setup: - runs-on: ubuntu-latest + runs-on: ubuntu-22.04 steps: diff --git a/.github/workflows/regtest_gnu.yml.tempdisable b/.github/workflows/regtest_gnu.yml similarity index 96% rename from .github/workflows/regtest_gnu.yml.tempdisable rename to .github/workflows/regtest_gnu.yml index d5b71673c3..642a1cb2d0 100644 --- a/.github/workflows/regtest_gnu.yml.tempdisable +++ b/.github/workflows/regtest_gnu.yml @@ -8,9 +8,9 @@ concurrency: env: cache_key: gnu11-1 - CC: gcc-10 - FC: gfortran-10 - CXX: g++-10 + CC: gcc-14 + FC: gfortran-14 + CXX: g++-14 # Split into a steup step, and a WW3 build step which @@ -45,7 +45,7 @@ jobs: run: | # Install NetCDF, ESMF, g2, etc using Spack sudo apt install cmake - git clone -c feature.manyFiles=true https://github.com/JCSDA/spack.git + git clone -c feature.manyFiles=true --depth=2 --branch=spack-stack-1.9.3 https://github.com/JCSDA/spack.git source spack/share/spack/setup-env.sh spack env create ww3-gnu ww3/model/ci/spack_gnu.yaml spack env activate ww3-gnu diff --git a/model/ci/spack_gnu.yaml b/model/ci/spack_gnu.yaml index d2c16711aa..6003d7594d 100644 --- a/model/ci/spack_gnu.yaml +++ b/model/ci/spack_gnu.yaml @@ -7,12 +7,12 @@ spack: - metis@5.1.0~shared - parmetis@4.0.3~shared - scotch@7.0.1+mpi+metis~shared - - netcdf-c@4.7.4~dap - - netcdf-fortran@4.5.3 + - netcdf-c@4.9.2~dap + - netcdf-fortran@4.6.1 - jasper@2.0.32 - g2@3.4.5 - bacio@2.4.1 - - w3emc@2.9.2 + - w3emc@2.12.0 - parallelio@2.5.9+fortran~pnetcdf - esmf@8.4.2~debug~xerces+external-parallelio view: true diff --git a/model/ci/spack_intel.yaml b/model/ci/spack_intel.yaml index c571da825d..17079194f8 100644 --- a/model/ci/spack_intel.yaml +++ b/model/ci/spack_intel.yaml @@ -5,8 +5,8 @@ spack: providers: mpi: [intel-oneapi-mpi] specs: - - netcdf-c@4.7.4~dap - - netcdf-fortran@4.5.3 + - netcdf-c@4.9.2~dap + - netcdf-fortran@4.6.1 - bacio@2.4.1 - g2@3.4.5 - metis@5.1.0~shared diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 01eedd344a..fc40222a81 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -948,11 +948,11 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) !/ Local parameters !/ INTEGER :: JGRID, NXXX, NSEAL_tmp + integer :: memunit #ifdef W3_S INTEGER, SAVE :: IENT = 0 CALL STRACE (IENT, 'W3DIMA') #endif - integer :: memunit ! ! -------------------------------------------------------------------- / ! 1. Test input and module status @@ -1565,11 +1565,11 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) !/ Local parameters !/ INTEGER :: JGRID, NXXX, I + integer :: memunit #ifdef W3_S INTEGER, SAVE :: IENT = 0 CALL STRACE (IENT, 'W3XDMA') #endif - integer :: memunit ! ! -------------------------------------------------------------------- / ! 1. Test input and module status diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index cd0b0d7b0a..61e14b3711 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -1646,10 +1646,13 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) END IF - IF ( FLTEST ) WRITE (NDST,9051) SNLC1, LAM, & - KDCON, KDMN, SNLS1, SNLS2, SNLS3, & - IQTPE, NLTAIL, GQNF1, GQNT1, GQNQ_OM2, & - GQTHRSAT, GQTHRCOU, GQAMP + IF ( FLTEST ) WRITE (NDST,*) & + 'SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP:', & + SNLC1, LAM, KDCON, KDMN, SNLS1, SNLS2, SNLS3, & + IQTPE, NLTAIL, GQNF1, GQNT1, & + GQNQ_OM2, GQTHRSAT, GQTHRCOU, GQAMP #endif ! #ifdef W3_NL2 diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index e7a39578cf..09f8cee351 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -1555,10 +1555,10 @@ SUBROUTINE INSNLGQM !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: GRAV USE W3GDATMD, ONLY: NK , NTH , XFR , FR1, GQNF1, GQNT1, GQNQ_OM2, NLTAIL, GQTHRCOU - #ifdef W3_S - CALL STRACE (IENT, 'INSNLGQM') + USE W3SERVMD, ONLY: STRACE #endif + IMPLICIT NONE !.....LOCAL VARIABLES INTEGER JF , JT , JF1 , JT1 , NF1P1 , IAUX , NT , NF , IK @@ -1582,6 +1582,10 @@ SUBROUTINE INSNLGQM DOUBLE PRECISION :: FREQ(NK) DOUBLE PRECISION, ALLOCATABLE :: F1SF(:) , X_CHE_TE1(:) , X_CHE_OM2(:) , X_LEG_OM2(:) , W_LEG_OM2(:) & , MAXCLA(:) +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 + CALL STRACE (IENT, 'INSNLGQM') +#endif PI = Acos(-1.) LBUF = 500 diff --git a/model/src/wmesmfmd.F90 b/model/src/wmesmfmd.F90 index f3206485f7..9c288cbdb3 100644 --- a/model/src/wmesmfmd.F90 +++ b/model/src/wmesmfmd.F90 @@ -167,7 +167,6 @@ module WMESMFMD !/ ! --- ESMF Module use ESMF - ! --- NUOPC modules use NUOPC use NUOPC_Model, parent_SetServices => SetServices @@ -203,6 +202,7 @@ module WMESMFMD !/ #ifdef W3_MPI use mpi_f08 + use, intrinsic :: iso_c_binding, only: C_INT #endif !/ implicit none @@ -757,7 +757,8 @@ subroutine InitializeP1 ( gcomp, impState, expState, extClock, rc ) integer, parameter :: iwt=2 real(8) :: wstime, wftime integer :: idsi, idso, idss, idst, idse - integer :: mpiComm = -99 + type(MPI_COMM) :: mpicomm = MPI_COMM_WORLD + integer(C_INT) :: c_int_mpicomm logical :: configIsPresent type(ESMF_Config) :: config character(ESMF_MAXSTR) :: wrkdir = '.' @@ -887,7 +888,8 @@ subroutine InitializeP1 ( gcomp, impState, expState, extClock, rc ) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ESMF_LogFoundError(rc, PASSTHRU)) return call ESMF_VMGet(vm, petCount=npet, localPet=lpet, & - mpiCommunicator=mpiComm, rc=rc) + mpiCommunicator=c_int_mpicomm, rc=rc) + mpicomm = MPI_Comm(c_int_mpicomm) if (ESMF_LogFoundError(rc, PASSTHRU)) return nmproc = npet improc = lpet + 1 diff --git a/model/src/ww3_prtide.F90 b/model/src/ww3_prtide.F90 index daa4bb9e19..1fd84f28ea 100644 --- a/model/src/ww3_prtide.F90 +++ b/model/src/ww3_prtide.F90 @@ -192,6 +192,9 @@ PROGRAM W3PRTIDE ! LOGICAL :: TIDEFILL ! +#ifdef W3_S + INTEGER, SAVE :: IENT = 0 +#endif !/ !/ ------------------------------------------------------------------- / !/ From ac2f91cfea85a50647a511e07614495d55399835 Mon Sep 17 00:00:00 2001 From: Mickael Accensi <49198861+mickaelaccensi@users.noreply.github.com> Date: Fri, 7 Nov 2025 18:19:18 +0100 Subject: [PATCH 114/136] initialize some variables to avoid ww3_multi to crash with gnu compiler (#1525) --- model/src/wminitmd.F90 | 4 +++- model/src/wmwavemd.F90 | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 7d39b94d94..4dad61f4ac 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -774,6 +774,7 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & FLG2(NOGRP,NRGRD),OUTFF(8,0:NRGRD)) ! + ODAT(:,:) = 0 MDS = -1 MDSF = -1 FLGR2 = .FALSE. @@ -4155,8 +4156,9 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & FLGRD(NOGRP,NGRPP,NRGRD), OT2(0:NRGRD), FLGD(NOGRP,NRGRD), & MDSF(-NRINP:NRGRD,JFIRST:9), IPRT(6,NRGRD), LPRT(NRGRD), & FLGR2(NOGRP,NGRPP,NRGRD),FLG2D(NOGRP,NGRPP), FLG1D(NOGRP), & - FLG2(NOGRP,NRGRD),OUTFF(7,0:NRGRD)) + FLG2(NOGRP,NRGRD),OUTFF(8,0:NRGRD)) ! + ODAT(:,:) = 0 MDS = -1 MDSF = -1 FLGR2 = .FALSE. diff --git a/model/src/wmwavemd.F90 b/model/src/wmwavemd.F90 index eefc411efb..e788d846af 100644 --- a/model/src/wmwavemd.F90 +++ b/model/src/wmwavemd.F90 @@ -401,6 +401,7 @@ SUBROUTINE WMWAVE ( TEND ) ! ! 0.d Output ! + TPRNT(:) = 0 IF ( MDSS.NE.MDSO .AND. NMPSCR.EQ.IMPROC ) THEN CALL WMPRNT ( MDSO, NRGRD, TSYNC(:,0), GRSTAT ) CALL STME21 ( TSYNC(:,0), MTIME ) From 9171405091c4a0daa8d712718f2a3ce1ae786d9c Mon Sep 17 00:00:00 2001 From: kestonsmith-noaa <107580916+kestonsmith-noaa@users.noreply.github.com> Date: Thu, 13 Nov 2025 11:09:14 -0500 Subject: [PATCH 115/136] Modification to PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK to address reproducibility issues with implicit time stepping on unstructured meshes. (#1528) --- model/src/w3profsmd_pdlib.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index f4135f4ff5..18d48d48c3 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5669,6 +5669,10 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL VA(ISP,JSEA) = VA(ISP,JSEA) / CG1(IK) * CLATS(ISEA) END DO END DO + ! + ! for reproducability state must be communicated at the start of solver + ! + CALL PDLIB_exchange2DREAL_zero(VA) VAOLD = VA(1:NSPEC,1:NSEAL) #ifdef W3_DEBUGSRC From 07d5ba092600c6eb1add1377e9a0c946a9203443 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 17 Nov 2025 13:10:47 -0500 Subject: [PATCH 116/136] replace EXTERNAL declarations with INTERFACE and CONTAINS for safer procedure referencing (#1521) --- model/src/serv_xnl4v5.f90 | 9 +++-- model/src/w3profsmd.F90 | 76 +++++++++++++++++++++++++++------------ 2 files changed, 60 insertions(+), 25 deletions(-) diff --git a/model/src/serv_xnl4v5.f90 b/model/src/serv_xnl4v5.f90 index f6d38c141d..e080559469 100644 --- a/model/src/serv_xnl4v5.f90 +++ b/model/src/serv_xnl4v5.f90 @@ -497,7 +497,13 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) ! implicit none ! -real func ! external function +abstract interface + real function func_proto(x) + real, intent(in) :: x + end function func_proto +end interface +procedure(func_proto) :: func +! real, intent (in) :: x1 ! x-value at one side of interval real, intent (in) :: x2 ! x-value at other side of interval real, intent (in) :: xacc ! requested accuracy @@ -512,7 +518,6 @@ real function z_root2(func,x1,x2,xacc,iprint,ierr) logical lopen ! check if a file is opened parameter (maxit = 20) -external func ! integer iter ! counter for number of iterations real fh ! function value FUNC(xh) diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 17350959ab..6078cba32e 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -57,6 +57,12 @@ MODULE W3PROFSMD !/ ------------------------------------------------------------------- / !/ PUBLIC + + PRIVATE :: bcgstab, implu, uppdir, givens, stopbis, tidycg, brkdn, & + bisinit, mgsro, amux, amuxms, atmux, atmuxr, amuxe, amuxd, & + amuxj, vbrmv, lsol, ldsol, lsolc, ldsolc, ldsoll, usol, & + udsol, usolc, udsolc, lusol, lutsol, qsplit, runrc, ilut, & + ilu0, pgmres, DNRM2, DLASSQ, ddot, daxpy !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -1105,8 +1111,6 @@ SUBROUTINE W3XYPFSNIMP ( ISP, C, LCALC, RD10, RD20, DT, AC) REAL*8 :: AU(NNZ+1) REAL*8 :: INIU(NX) - external bcgstab - POS_TRICK(1,1) = 2 POS_TRICK(1,2) = 3 POS_TRICK(2,1) = 3 @@ -1664,11 +1668,6 @@ SUBROUTINE SETDEPTH END SUBROUTINE SETDEPTH - !/ ------------------------------------------------------------------- / - -END MODULE W3PROFSMD - - !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- !-------------------------------------------------------------------------- @@ -2083,12 +2082,6 @@ subroutine bcgstab(n, rhs, sol, ipar, fpar, w) ! here, so that the right-preconditioning may be applied ! at the end !----------------------------------------------------------------------- - ! external routines used - ! - real*8 ddot - logical stopbis, brkdn - external ddot, stopbis, brkdn - ! real*8 one parameter(one=1.0D0) ! @@ -2368,6 +2361,7 @@ subroutine bcgstab(n, rhs, sol, ipar, fpar, w) end subroutine bcgstab !----------------------------------------------------------------------- subroutine implu(np,umm,beta,ypiv,u,permut,full) + implicit none real*8 umm,beta,ypiv(*),u(*),x, xpiv logical full, perm, permut(*) integer np,k,npm1 @@ -2500,8 +2494,7 @@ end subroutine givens logical function stopbis(n,ipar,mvpi,fpar,r,delx,sx) implicit none integer n,mvpi,ipar(16) - real*8 fpar(16), r(n), delx(n), sx, ddot - external ddot + real*8 fpar(16), r(n), delx(n), sx !----------------------------------------------------------------------- ! function for determining the stopping criteria. return value of ! true if the stopbis criteria is satisfied. @@ -2732,9 +2725,8 @@ subroutine mgsro(full,lda,n,m,ind,ops,vec,hh,ierr) ! External routines used: real*8 ddot !----------------------------------------------------------------------- integer i,k - real*8 nrm0, nrm1, fct, thr, ddot, zero, one, reorth + real*8 nrm0, nrm1, fct, thr, zero, one, reorth parameter (zero=0.0D0, one=1.0D0, reorth=0.98D0) - external ddot ! ! compute the norm of the input vector ! @@ -2853,6 +2845,7 @@ end subroutine mgsro ! 1) M A T R I X B Y V E C T O R P R O D U C T S c !----------------------------------------------------------------------c subroutine amux (n, x, y, a,ja,ia) + implicit none real*8 x(*), y(*), a(*) integer n, ja(*), ia(*) !----------------------------------------------------------------------- @@ -2899,6 +2892,7 @@ subroutine amux (n, x, y, a,ja,ia) end subroutine amux !----------------------------------------------------------------------- subroutine amuxms (n, x, y, a,ja) + implicit none real*8 x(*), y(*), a(*) integer n, ja(*) !----------------------------------------------------------------------- @@ -2941,6 +2935,7 @@ subroutine amuxms (n, x, y, a,ja) end subroutine amuxms !----------------------------------------------------------------------- subroutine atmux (n, x, y, a, ja, ia) + implicit none real*8 x(*), y(*), a(*) integer n, ia(*), ja(*) !----------------------------------------------------------------------- @@ -2990,6 +2985,7 @@ subroutine atmux (n, x, y, a, ja, ia) end subroutine atmux !----------------------------------------------------------------------- subroutine atmuxr (m, n, x, y, a, ja, ia) + implicit none real*8 x(*), y(*), a(*) integer m, n, ia(*), ja(*) !----------------------------------------------------------------------- @@ -3088,6 +3084,7 @@ subroutine amuxe (n,x,y,na,ncol,a,ja) end subroutine amuxe !----------------------------------------------------------------------- subroutine amuxd (n,x,y,diag,ndiag,idiag,ioff) + implicit none integer n, ndiag, idiag, ioff(idiag) real*8 x(n), y(n), diag(ndiag,idiag) !----------------------------------------------------------------------- @@ -3140,6 +3137,7 @@ subroutine amuxd (n,x,y,diag,ndiag,idiag,ioff) end subroutine amuxd !----------------------------------------------------------------------- subroutine amuxj (n, x, y, jdiag, a, ja, ia) + implicit none integer n, jdiag, ja(*), ia(*) real*8 x(n), y(n), a(*) !----------------------------------------------------------------------- @@ -3195,6 +3193,7 @@ end subroutine amuxj !----------------------------------------------------------------------- subroutine vbrmv(nr, nc, ia, ja, ka, a, kvstr, kvstc, x, b) !----------------------------------------------------------------------- + implicit none integer nr, nc, ia(nr+1), ja(*), ka(*), kvstr(nr+1), kvstc(*) real*8 a(*), x(*), b(*) !----------------------------------------------------------------------- @@ -3248,6 +3247,7 @@ end subroutine vbrmv ! 2) T R I A N G U L A R S Y S T E M S O L U T I O N S c !----------------------------------------------------------------------c subroutine lsol (n,x,y,al,jal,ial) + implicit none integer n, jal(*),ial(n+1) real*8 x(n), y(n), al(*) !----------------------------------------------------------------------- @@ -3291,6 +3291,7 @@ subroutine lsol (n,x,y,al,jal,ial) end subroutine lsol !----------------------------------------------------------------------- subroutine ldsol (n,x,y,al,jal) + implicit none integer n, jal(*) real*8 x(n), y(n), al(*) !----------------------------------------------------------------------- @@ -3334,6 +3335,7 @@ subroutine ldsol (n,x,y,al,jal) end subroutine ldsol !----------------------------------------------------------------------- subroutine lsolc (n,x,y,al,jal,ial) + implicit none integer n, jal(*),ial(*) real*8 x(n), y(n), al(*) !----------------------------------------------------------------------- @@ -3378,6 +3380,7 @@ subroutine lsolc (n,x,y,al,jal,ial) end subroutine lsolc !----------------------------------------------------------------------- subroutine ldsolc (n,x,y,al,jal) + implicit none integer n, jal(*) real*8 x(n), y(n), al(*) !----------------------------------------------------------------------- @@ -3425,6 +3428,7 @@ subroutine ldsolc (n,x,y,al,jal) end subroutine ldsolc !----------------------------------------------------------------------- subroutine ldsoll (n,x,y,al,jal,nlev,lev,ilev) + implicit none integer n, nlev, jal(*), ilev(nlev+1), lev(n) real*8 x(n), y(n), al(*) !----------------------------------------------------------------------- @@ -3477,6 +3481,7 @@ subroutine ldsoll (n,x,y,al,jal,nlev,lev,ilev) end subroutine ldsoll !----------------------------------------------------------------------- subroutine usol (n,x,y,au,jau,iau) + implicit none integer n, jau(*),iau(n+1) real*8 x(n), y(n), au(*) !----------------------------------------------------------------------- @@ -3520,6 +3525,7 @@ subroutine usol (n,x,y,au,jau,iau) end subroutine usol !----------------------------------------------------------------------- subroutine udsol (n,x,y,au,jau) + implicit none integer n, jau(*) real*8 x(n), y(n),au(*) !----------------------------------------------------------------------- @@ -3564,6 +3570,7 @@ subroutine udsol (n,x,y,au,jau) end subroutine udsol !----------------------------------------------------------------------- subroutine usolc (n,x,y,au,jau,iau) + implicit none real*8 x(*), y(*), au(*) integer n, jau(*),iau(*) !----------------------------------------------------------------------- @@ -3608,6 +3615,7 @@ subroutine usolc (n,x,y,au,jau,iau) end subroutine usolc !----------------------------------------------------------------------- subroutine udsolc (n,x,y,au,jau) + implicit none integer n, jau(*) real*8 x(n), y(n), au(*) !----------------------------------------------------------------------- @@ -3784,8 +3792,20 @@ end subroutine qsplit subroutine runrc(n,rhs,sol,ipar,fpar,wk,guess,a,ja,ia,au,jau,ju,solver) implicit none integer n,ipar(16),ia(n+1),ja(*),ju(*),jau(*) - real*8 fpar(16),rhs(n),sol(n),guess(n),wk(*),a(*),au(*) - external solver + real*8 fpar(16),rhs(n),sol(n),guess(n),a(*),au(*) + real*8, target :: wk(*) + ! + abstract interface + subroutine solver_proto(n,rhs,sol,ipar,fpar,w) + implicit none + integer n + real*8 rhs(n), sol(n), w(n,8) + integer ipar(16) + real*8 fpar(16) + end subroutine solver_proto + end interface + procedure(solver_proto) :: solver + ! !----------------------------------------------------------------------- ! the actual tester. It starts the iterative linear system solvers ! with a initial guess suppied by the user. @@ -3797,6 +3817,7 @@ subroutine runrc(n,rhs,sol,ipar,fpar,wk,guess,a,ja,ia,au,jau,ju,solver) ! local variables ! integer :: i, its + real*8, pointer :: w_2d(:,:) ! real :: dtime, dt(2), time ! external dtime save its @@ -3816,9 +3837,10 @@ subroutine runrc(n,rhs,sol,ipar,fpar,wk,guess,a,ja,ia,au,jau,ju,solver) ! ipar(1) = 0 ! time = dtime(dt) - + w_2d(1:n,1:8) => wk(1:n*8) + do - call solver(n,rhs,sol,ipar,fpar,wk) + call solver(n,rhs,sol,ipar,fpar,w_2d) if (ipar(7).ne.its) then its = ipar(7) @@ -4208,7 +4230,7 @@ end subroutine ilut !---------------------------------------------------------------------- ! subroutine ilu0(n, a, ja, ia, alu, jlu, ju, iw, ipoint1, ipoint2, ierr) subroutine ilu0(n, a, ja, ia, alu, jlu, ju, iw, ierr) - + implicit none !implicit real*8 (a-h,o-z) real*8 a(*), alu(*), tl integer n, ju0, ii, jj, i, j, jcol, js, jf, jm, jrow, jw, ierr @@ -4285,7 +4307,7 @@ subroutine pgmres(n, im, rhs, sol, eps, maxits, aspar, nnz, ia, ja, alu, jlu, ju real*8 :: rhs(*), sol(*) real*8 :: eps - real*8 :: eps1, epsmac, gam, t, ddot, dnrm2, ro, tl + real*8 :: eps1, epsmac, gam, t, ro, tl integer :: i,i1,j,jj,k,k1,iii,ii,ju0 integer :: its,jrow,jcol,jf,jm,js,jw @@ -4535,6 +4557,7 @@ end subroutine pgmres ! subroutine from blas1.f90 !----------------------------------------------------------------------- DOUBLE PRECISION FUNCTION DNRM2(N,X) + implicit none ! .. Scalar Arguments .. INTEGER N ! .. @@ -4608,6 +4631,7 @@ SUBROUTINE DLASSQ( N, X, SCALE, SUMSQ ) ! -- LAPACK auxiliary routine (version 3.1) -- ! Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. ! November 2006 + implicit none INTEGER N DOUBLE PRECISION SCALE, SUMSQ DOUBLE PRECISION X( * ) @@ -4654,6 +4678,7 @@ double precision function ddot(n,dx,dy) ! uses unrolled loops for increments equal to one. ! jack dongarra, linpack, 3/11/78. ! + implicit none double precision dx(*),dy(*) integer i,m,mp1,n ! @@ -4681,6 +4706,7 @@ subroutine daxpy(n,da,dx,incx,dy,incy) ! uses unrolled loops for increments equal to one. ! jack dongarra, linpack, 3/11/78. ! + implicit none double precision dx(1),dy(1),da integer i,incx,incy,ix,iy,m,mp1,n ! @@ -4724,3 +4750,7 @@ subroutine daxpy(n,da,dx,incx,dy,incy) end do return end subroutine daxpy + + !/ ------------------------------------------------------------------- / + +END MODULE W3PROFSMD From 6ec7a272dc97e60361efd1117efb2c9e119a2353 Mon Sep 17 00:00:00 2001 From: kestonsmith-noaa <107580916+kestonsmith-noaa@users.noreply.github.com> Date: Wed, 19 Nov 2025 15:23:44 -0500 Subject: [PATCH 117/136] Addition of switch to activate precision truncation in PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK to address reproducibility issues (#1524) --- model/inp/ww3_grid.inp | 2 + model/src/w3gdatmd.F90 | 3 + model/src/w3gridmd.F90 | 14 +- model/src/w3iogrmd.F90 | 9 + model/src/w3profsmd_pdlib.F90 | 29 ++++ regtests/bin/matrix.base | 2 + .../ww3_ufs1.1/input_unstr/switch_PDLIB_TRNK | 1 + .../ww3_ufs1.1/input_unstr/ww3_grid_d.inp | 160 ++++++++++++++++++ 8 files changed, 219 insertions(+), 1 deletion(-) create mode 100644 regtests/ww3_ufs1.1/input_unstr/switch_PDLIB_TRNK create mode 100644 regtests/ww3_ufs1.1/input_unstr/ww3_grid_d.inp diff --git a/model/inp/ww3_grid.inp b/model/inp/ww3_grid.inp index bd6e5a3772..a9c6152aa6 100644 --- a/model/inp/ww3_grid.inp +++ b/model/inp/ww3_grid.inp @@ -358,6 +358,8 @@ $ JGS_LIMITER : TRUE: Use total (quasi-steady: limits $ FALSE: default $ JGS_LIMITER_FUNC : 1 - old limiter (default) $ 2 - alternatnive limiter +$                           JGS_TRUNK_DIGITS  : [Only with switch TRNK] Number of digits of precision to truncate solution to at the end of iterative solver. +$                                               Can be used to force bit-for-bit reproducibility. $ SETUP_APPLY_WLV : Compute wave setup (TRUE/FALSE, default TRUE) $ SOLVERTHR_SETUP : Solver threshold for setup computations (default 1E-6) $ CRIT_DEP_SETUP : Critical depth for setup computations (default 0.1) diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index ee1ab25c16..4f5aad1716 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -1055,6 +1055,7 @@ MODULE W3GDATMD LOGICAL :: B_JGS_LIMITER LOGICAL :: B_JGS_USE_JACOBI LOGICAL :: B_JGS_BLOCK_GAUSS_SEIDEL + INTEGER :: B_JGS_TRUNK_DIGITS INTEGER :: B_JGS_MAXITER INTEGER :: B_JGS_LIMITER_FUNC REAL*8 :: B_JGS_PMIN @@ -1418,6 +1419,7 @@ MODULE W3GDATMD LOGICAL, POINTER :: B_JGS_BLOCK_GAUSS_SEIDEL INTEGER, POINTER :: B_JGS_MAXITER INTEGER, POINTER :: B_JGS_LIMITER_FUNC + INTEGER, POINTER :: B_JGS_TRUNK_DIGITS REAL(8), POINTER :: B_JGS_PMIN REAL(8), POINTER :: B_JGS_DIFF_THR REAL(8), POINTER :: B_JGS_NORM_THR @@ -2864,6 +2866,7 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) B_JGS_NORM_THR => MPARS(IMOD)%SCHMS%B_JGS_NORM_THR B_JGS_NLEVEL => MPARS(IMOD)%SCHMS%B_JGS_NLEVEL B_JGS_SOURCE_NONLINEAR => MPARS(IMOD)%SCHMS%B_JGS_SOURCE_NONLINEAR + B_JGS_TRUNK_DIGITS => MPARS(IMOD)%SCHMS%B_JGS_TRUNK_DIGITS RETURN ! ! Formats diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index ed8929a8c2..3fe8d9be13 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -942,6 +942,7 @@ MODULE W3GRIDMD REAL*8 :: JGS_PMIN REAL*8 :: JGS_DIFF_THR REAL*8 :: JGS_NORM_THR + INTEGER :: JGS_TRUNK_DIGITS REAL*8 :: SOLVERTHR_SETUP REAL*8 :: CRIT_DEP_SETUP ! @@ -1109,6 +1110,7 @@ MODULE W3GRIDMD JGS_NORM_THR, & JGS_NLEVEL, & JGS_SOURCE_NONLINEAR, & + JGS_TRUNK_DIGITS, & SETUP_APPLY_WLV, SOLVERTHR_SETUP, & CRIT_DEP_SETUP NAMELIST /MISC/ CICE0, CICEN, LICE, XSEED, FLAGTR, XP, XR, & @@ -2480,6 +2482,7 @@ SUBROUTINE W3GRID() JGS_NORM_THR = 1.E-20 JGS_NLEVEL = 0 JGS_SOURCE_NONLINEAR = .FALSE. + JGS_TRUNK_DIGITS = 5 ! read data from the unstructured devoted namelist CALL READNL ( NDSS, 'UNST', STATUS ) @@ -2496,6 +2499,7 @@ SUBROUTINE W3GRID() B_JGS_NORM_THR = JGS_NORM_THR B_JGS_NLEVEL = JGS_NLEVEL B_JGS_SOURCE_NONLINEAR = JGS_SOURCE_NONLINEAR + B_JGS_TRUNK_DIGITS = JGS_TRUNK_DIGITS nbSel=0 @@ -3363,6 +3367,9 @@ SUBROUTINE W3GRID() JGS_DIFF_THR, & JGS_NORM_THR, & JGS_NLEVEL, & +#ifdef W3_TRNK + JGS_TRUNK_DIGITS, & +#endif JGS_SOURCE_NONLINEAR ! WRITE (NDSO,2976) P2SF, I1P2SF, I2P2SF, & @@ -6342,7 +6349,7 @@ SUBROUTINE W3GRID() 2922 FORMAT ( ' &SNL1 LAMBDA =',F7.3,', NLPROP =',E10.3, & ', KDCONV =',F7.3,', KDMIN =',F7.3,','/ & ' SNLCS1 =',F7.3,', SNLCS2 =',F7.3, & - ', SNLCS3 = ',F7.3,','/ & + ', SNLCS3 = ',F7.3,','/ & ' IQTYPE =',I2,', TAILNL =',F5.1,','/ & ' GQMNF1 =',I2,', GQMNT1 =',I2,',', & ' GQMNQ_OM2 =',I2,', GQMTHRSAT =',E11.4,', GQMTHRCOU =',F4.3,','/ & @@ -6714,7 +6721,12 @@ SUBROUTINE W3GRID() ', JGS_DIFF_THR=', F8.3, & ', JGS_NORM_THR=', F8.3, & ', JGS_NLEVEL=', I3, & +#ifdef W3_TRNK + ', JGS_TRUNK_DIGITS=', I3, & +#endif ', JGS_SOURCE_NONLINEAR=', L3 / ) + + ! 960 FORMAT (/' Miscellaneous ',A/ & ' --------------------------------------------------') diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 61e14b3711..f292c1eb04 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -805,6 +805,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & B_JGS_DIFF_THR, & B_JGS_NORM_THR, & B_JGS_NLEVEL, & +#ifdef W3_TRNK + B_JGS_TRUNK_DIGITS, & +#endif B_JGS_SOURCE_NONLINEAR #ifdef W3_ASCII WRITE (NDSA,*) & @@ -839,6 +842,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & B_JGS_DIFF_THR, & B_JGS_NORM_THR, & B_JGS_NLEVEL, & +#ifdef W3_TRNK + B_JGS_TRUNK_DIGITS, & +#endif B_JGS_SOURCE_NONLINEAR #endif !Init COUNTCON and IOBDP to zero, it needs to be set somewhere or @@ -1004,6 +1010,9 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & B_JGS_DIFF_THR, & B_JGS_NORM_THR, & B_JGS_NLEVEL, & +#ifdef W3_TRNK + B_JGS_TRUNK_DIGITS, & +#endif B_JGS_SOURCE_NONLINEAR IF (IERR.NE.0) CALL EXTIOF(NDSE,IERR,'W3IOGR','mod_def.'//FILEXT(:IEXT),51) IF (.NOT. GUGINIT) THEN diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 18d48d48c3..00f0091af1 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5235,6 +5235,7 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION(IMOD) REAL :: RD1, RD2, RD10, RD20 INTEGER :: IK, ITH, ISEA INTEGER :: IBI, IP_glob, ISP, JX + #ifdef W3_S CALL STRACE (IENT, 'APPLY_BOUNDARY_CONDITION') #endif @@ -5538,6 +5539,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL USE W3PARALL, only : ListISPprevDir, ListISPnextDir USE W3PARALL, only : JX_TO_JSEA USE W3GDATMD, only: B_JGS_NLEVEL, B_JGS_SOURCE_NONLINEAR + USE yowfunction, only : pdlib_abort USE yowNodepool, only: np_global USE W3DISPMD, only : WAVNU_LOCAL @@ -5549,6 +5551,10 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL USE W3GDATMD, only: REFPARS #endif +#ifdef W3_TRNK + USE W3GDATMD, only: B_JGS_TRUNK_DIGITS +#endif + implicit none LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD @@ -5603,6 +5609,11 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL INTEGER JP_glob INTEGER is_converged, itmp +#ifdef W3_TRNK + integer :: expVA + real :: trVA +#endif + INTEGER :: TESTNODE = 923 LOGICAL :: LSIG = .FALSE. @@ -6327,6 +6338,24 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL endif endif #endif + +#ifdef W3_TRNK + ! + ! Truncate precision to B_JGS_TRUNK_DIGITS to enforce bit for bit reproducability + ! across repeated wavewatch runs. + ! + DO IP = 1, npa + DO ISP=1,NSPEC + if (VA(ISP,IP) .gt. tiny(1.0) )then + expVA=nint(log10( VA(ISP,IP) ) ) + trVA = 10.**( expVA - B_JGS_TRUNK_DIGITS ) + if (trVA .gt. tiny(1.0)) VA(ISP,IP) = ANINT(VA(ISP,IP) / trVA) * trVA + endif + ENDDO + ENDDO +#endif + + ! call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION LOOP 7') ! diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 95981c01ce..4a56edb676 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -2175,6 +2175,8 @@ echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_b -g b -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body # Domain Decomposition Implicit echo "$rtst -s MPI -s PDLIB -i input_unstr -w work_unstr_c -g c -f -p $mpi -n $np $ww3 ww3_ufs1.1" >> matrix.body + # Domain Decomposition Implicit with precision truncation to force bit for bit reproducability + echo "$rtst -s MPI -s PDLIB_TRNK -i input_unstr -w work_unstr_d -g d -f -p $mpi -n $np $ww3 ww3_ufs1.1" >>matrix.body fi #Test of UFS applications with ww3_multi_esmf and grib2 output diff --git a/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB_TRNK b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB_TRNK new file mode 100644 index 0000000000..b26ec10363 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/switch_PDLIB_TRNK @@ -0,0 +1 @@ +TRNK NCO PDLIB SCOTCH NOGRB BIN2NC DIST MPI PR3 UQ FLX0 SEED ST4 STAB0 NL1 BT1 DB1 MLIM FLD2 TR0 BS0 RWND WNX1 WNT1 CRX1 CRT1 O0 O1 O2 O3 O4 O5 O6 O7 O14 O15 IC0 IS0 REF0 diff --git a/regtests/ww3_ufs1.1/input_unstr/ww3_grid_d.inp b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_d.inp new file mode 100644 index 0000000000..9a81401722 --- /dev/null +++ b/regtests/ww3_ufs1.1/input_unstr/ww3_grid_d.inp @@ -0,0 +1,160 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ + 'Global Unstructured' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ +$gfs: 1.07 0.035 50 36 0.5 +$gefs: 1.1 0.035 33 36 0.5 + 1.1 0.035 33 36 0.5 +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 900. 900. 900. 900. +$ +$ Start of namelist input section ------------------------------------ $ +$ +&OUTS + USSP = 1, + IUSSP = 3, + STK_WN = 0.04, 0.110, 0.3305 / +&SIN4 + BETAMAX = 1.315, + TAUWSHELTER = 1.0, + SWELLF = 0.798, + SWELLF2 = -0.0127, + SWELLF3 = 0.0151, + SWELLF4 = 100025.0, + SWELLF5 = 1.1999, + SWELLF7 = 235500.0 / +&SNL1 + NLPROP = 2.502E7 / +&SDS4 + FXFM3 = 2.501, + SDSC2 = -2.1975e-05, + SDSCUM = -0.4032, + SDSC6 = 0.2978, + SDSBR = 0.0009035 / +&MISC + CICE0 = 0.75, + CICEN = 0.75 / +&SBT1 + GAMMA = -0.038 / +&PRO3 + WDTHCG=1.5, + WDTHTH=1.5 / +&UNST + UGOBCAUTO = F, + UGOBCDEPTH = -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_NLEVEL = 0, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-6, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_TRUNK_DIGITS = 5, + JGS_NORM_THR = 1.E-6 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T T +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_unstr/global_1deg_unstr.msh' +$ +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ From 44a3409c194b9e312e6b932d70f56503ffc27704 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 21 Nov 2025 08:52:29 -0500 Subject: [PATCH 118/136] fix SCOTCH and MPI_COMM_RANK explicit-interface warnings for debug build (#1531) --- model/src/PDLIB/yowpdlibmain.F90 | 38 ++++++++++++++++++++++++++++++++ model/src/w3profsmd_pdlib.F90 | 2 +- 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index e06ac3e65f..193c6c17c3 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -449,6 +449,44 @@ subroutine runParmetis(MNP) INTEGER :: np_toSend +#ifdef W3_SCOTCH + interface +#ifdef SCOTCH_707 + subroutine SCOTCHFParMETIS_V3_PartGeomKway(vtxdist, xadj, adjncy, & + vwgt, adjwgt, wgtflag, numflag, ndims, xyz, ncon, nparts, & + tpwgts, ubvec, options, edgecut, part, comm, ref) + import :: MPI_Comm + integer, intent(in) :: vtxdist(*), xadj(*), adjncy(*) + integer, intent(in) :: vwgt(*), adjwgt(*) + integer, intent(in) :: wgtflag, numflag, ndims, ncon, nparts + real(4), intent(in) :: xyz(*) + real(4), intent(in) :: tpwgts(*), ubvec(*) + integer, intent(in) :: options(*) + integer, intent(out) :: edgecut + integer, intent(inout) :: part(*) + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ref + end subroutine SCOTCHFParMETIS_V3_PartGeomKway +#else + subroutine SCOTCH_ParMETIS_V3_PartGeomKway(vtxdist, xadj, adjncy, & + vwgt, adjwgt, wgtflag, numflag, ndims, xyz, ncon, nparts, & + tpwgts, ubvec, options, edgecut, part, comm, ref) + import :: MPI_Comm + integer, intent(in) :: vtxdist(*), xadj(*), adjncy(*) + integer, intent(in) :: vwgt(*), adjwgt(*) + integer, intent(in) :: wgtflag, numflag, ndims, ncon, nparts + real(4), intent(in) :: xyz(*) + real(4), intent(in) :: tpwgts(*), ubvec(*) + integer, intent(in) :: options(*) + integer, intent(out) :: edgecut + integer, intent(inout) :: part(*) + type(MPI_Comm), intent(in) :: comm + integer, intent(out) :: ref + end subroutine SCOTCH_ParMETIS_V3_PartGeomKway +#endif + end interface +#endif + ! CALL REAL_MPI_BARRIER_PDLIB(comm, "runParmetis, step 1") ! Create xadj and adjncy arrays. They holds the nodes neighbors in CSR Format ! Here, the adjacency structure of a graph is represented by two arrays, diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 00f0091af1..3d5843d9ca 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5521,7 +5521,7 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL use yowDatapool, only: rtype use YOWNODEPOOL, only: npa, iplg use yowExchangeModule, only : PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal - use mpi_f08, only : MPI_SUM, MPI_INT, MPI_ALLREDUCE + use mpi_f08, only : MPI_SUM, MPI_INT, MPI_ALLREDUCE, MPI_COMM_RANK USE W3ADATMD, only: MPI_COMM_WCMP USE W3GDATMD, only: NSEA, SIG, FACP, FLSOU USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC From 9d0cb9477c4496ed2f78725c82596ab1c4fccd6a Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Wed, 26 Nov 2025 10:29:39 -0500 Subject: [PATCH 119/136] Add explicit interfaces for BACIO and g2 routines in ww3_grib.F90 to remove Intel #8889 warnings (#1536) --- model/src/ww3_grib.F90 | 61 +++++++++++++++++++++++++++++++++++++++--- 1 file changed, 58 insertions(+), 3 deletions(-) diff --git a/model/src/ww3_grib.F90 b/model/src/ww3_grib.F90 index 393d3f5ee4..7a4fe135e7 100644 --- a/model/src/ww3_grib.F90 +++ b/model/src/ww3_grib.F90 @@ -160,6 +160,60 @@ PROGRAM W3GRIB ! IMPLICIT NONE !/ +#ifdef W3_NCEP2 + INTERFACE + ! + SUBROUTINE BAOPENW(LU, CFN, IRET) + INTEGER, INTENT(IN) :: LU + CHARACTER(LEN=*), INTENT(IN) :: CFN + INTEGER, INTENT(OUT) :: IRET + END SUBROUTINE BAOPENW + ! + SUBROUTINE WRYTE(LU, NB, A) + INTEGER, INTENT(IN) :: LU + INTEGER, INTENT(IN) :: NB + CHARACTER, INTENT(IN) :: A(*) + END SUBROUTINE WRYTE + ! + SUBROUTINE GRIBCREATE(CGRIB, LCGRIB, LISTSEC0, LISTSEC1, IERR) + CHARACTER(LEN=1), INTENT(INOUT) :: CGRIB(*) + INTEGER, INTENT(IN) :: LCGRIB + INTEGER, INTENT(IN) :: LISTSEC0(*), LISTSEC1(*) + INTEGER, INTENT(OUT) :: IERR + END SUBROUTINE GRIBCREATE + ! + SUBROUTINE ADDGRID(CGRIB, LCGRIB, IGDS, IGDSTML, IGDSTMLEN, & + IDEFLIST, IDEFNUM, IERR) + CHARACTER(LEN=1), INTENT(INOUT) :: CGRIB(*) + INTEGER, INTENT(IN) :: LCGRIB, IDEFNUM, IGDSTMLEN + INTEGER, INTENT(IN) :: IGDS(*), IGDSTML(*), IDEFLIST(*) + INTEGER, INTENT(OUT) :: IERR + END SUBROUTINE ADDGRID + ! + SUBROUTINE ADDFIELD(CGRIB, LCGRIB, IPDSNUM, IPDSTML, IPDSTMLEN, & + COORDLIST, NUMCOORD, IDRSNUM, IDRSTML, & + IDRSTMLEN, FLD, NGRDPTS, IBMAP, BMAP, IERR) + CHARACTER(LEN=1), INTENT(INOUT) :: CGRIB(*) + INTEGER, INTENT(INOUT) :: IDRSTML(*) + INTEGER, INTENT(IN) :: LCGRIB, IPDSNUM, IPDSTMLEN, & + NUMCOORD, IDRSNUM, IDRSTMLEN, & + NGRDPTS, IBMAP + INTEGER, INTENT(IN) :: IPDSTML(*) + REAL, INTENT(IN) :: COORDLIST(*) + REAL, TARGET, INTENT(IN) :: FLD(*) + LOGICAL*1, INTENT(IN) :: BMAP(*) + INTEGER, INTENT(OUT) :: IERR + END SUBROUTINE ADDFIELD + ! + SUBROUTINE GRIBEND(CGRIB, LCGRIB, LENGRIB, IERR) + CHARACTER(LEN=1), INTENT(INOUT) :: CGRIB(*) + INTEGER, INTENT(IN) :: LCGRIB, LENGRIB + INTEGER, INTENT(OUT) :: IERR + END SUBROUTINE GRIBEND + ! + END INTERFACE +#endif + !/ !/ ------------------------------------------------------------------- / !/ Local variables !/ @@ -175,10 +229,11 @@ PROGRAM W3GRIB ! GRIB2 specific variables #ifdef W3_NCEP2 INTEGER :: KPDS(200), KGDS(200), IDRS(200) - INTEGER :: LISTSEC0(3), LISTSEC1(13),IGDS(5) - INTEGER :: IDEFLIST, IDEFNUM, KPDSNUM, NUMCOORD + INTEGER :: LISTSEC0(3), LISTSEC1(13), IGDS(5), IDEFLIST(1) + INTEGER :: IDEFNUM, KPDSNUM, NUMCOORD INTEGER :: IBMP, LCGRIB, LENGRIB, IDRSNUM - REAL :: COORDLIST, XN + REAL :: XN + REAL :: COORDLIST(1) CHARACTER(LEN=1), ALLOCATABLE :: CGRIB(:) INTEGER :: LATAN1, LONV, SCNMOD, LATIN1, & LATIN2, LATSP, LONSP From 6fc769bd840c80474b185196e815f204bdee255c Mon Sep 17 00:00:00 2001 From: Daisy Brown Date: Thu, 4 Dec 2025 18:38:22 +0000 Subject: [PATCH 120/136] Initiatlise XFT variable outside of ST2 switch (#1542) --- model/src/w3gridmd.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 3fe8d9be13..86ac59d05d 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -3514,6 +3514,7 @@ SUBROUTINE W3GRID() FXPM = FXPM * GRAV / 28. FXFM = FXFM * TPI XFC = 3.0 + XFT = 0.0 #ifdef W3_ST2 XFH = 2.0 XF1 = 1.75 From a55d64213b0b3600964194849a180ba8e6a24f69 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 5 Dec 2025 11:11:45 -0500 Subject: [PATCH 121/136] Fix non-B4B issue in ww3_tp2.1 by using separate output filenames for dual postprocessing steps (#1546) --- regtests/ww3_tp2.1/input/ww3_ounf_flds_hrly.inp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regtests/ww3_tp2.1/input/ww3_ounf_flds_hrly.inp b/regtests/ww3_tp2.1/input/ww3_ounf_flds_hrly.inp index d50d9d0962..085004c359 100644 --- a/regtests/ww3_tp2.1/input/ww3_ounf_flds_hrly.inp +++ b/regtests/ww3_tp2.1/input/ww3_ounf_flds_hrly.inp @@ -31,7 +31,7 @@ $ number of characters in date [0(nodate),4(yearly),6(monthly),8(daily),10(hourl $ IX and IY ranges [regular:IX NX IY NY, unstructured:IP NP 1 1] $ ww3. - 6 + 8 1 1000000 1 1000000 $ $ For each field and time a new file is generated with the file name From 037b762c0a2015879b96b47eaa79c985ceda0e9a Mon Sep 17 00:00:00 2001 From: AliS-Noaa <118747646+AliS-Noaa@users.noreply.github.com> Date: Wed, 10 Dec 2025 10:58:15 -0500 Subject: [PATCH 122/136] Changing access argument in ww3_outp to support cray compiler (#1463) --- model/src/ww3_outp.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index d4397a2cd0..b18ee26409 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -967,10 +967,10 @@ PROGRAM W3OUTP J = LEN_TRIM(FNMPRE) IF (FLFORM) THEN OPEN(NDSTAB, FILE=TRIM(TFNAME), STATUS='OLD', & - IOSTAT=IERR, FORM='UNFORMATTED', ACCESS='APPEND') + IOSTAT=IERR, FORM='UNFORMATTED', ACCESS='SEQUENTIAL', POSITION='APPEND') ELSE OPEN(NDSTAB, FILE=TRIM(TFNAME), STATUS='OLD', & - IOSTAT=IERR, FORM='FORMATTED', ACCESS='APPEND') + IOSTAT=IERR, FORM='FORMATTED', ACCESS='SEQUENTIAL', POSITION='APPEND') END IF PROCESS_POINT_ONLY = .TRUE. From 96c03efbebe46f812befa52eb9ffdbd195c40f16 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Tue, 16 Dec 2025 08:01:45 -0500 Subject: [PATCH 123/136] resolve compiler remarks in w3strkmd.F90 w3sdb1md.F90 w3profsmd.F90 w3pro3md.F90 (#1548) --- model/src/w3pro3md.F90 | 43 +++++++++++------------- model/src/w3profsmd.F90 | 72 +++++++++++++++++------------------------ model/src/w3sdb1md.F90 | 9 ++++-- model/src/w3strkmd.F90 | 38 +++++++++------------- 4 files changed, 70 insertions(+), 92 deletions(-) diff --git a/model/src/w3pro3md.F90 b/model/src/w3pro3md.F90 index cd28cd96a2..41b1337e33 100644 --- a/model/src/w3pro3md.F90 +++ b/model/src/w3pro3md.F90 @@ -215,12 +215,15 @@ SUBROUTINE W3MAP3 ! ! 10. Source code : !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NK, NTH, NSPEC, NX, NY, NSEA, MAPSTA, MAPSF,& - GTYPE + USE W3GDATMD, ONLY: NK, NTH, NX, NY, NSEA, MAPSTA, MAPSF, GTYPE USE W3ADATMD, ONLY: NMX0, NMX1, NMX2, NMY0, NMY1, NMY2, NACT, & NCENT, MAPX2, MAPY2, MAPAXY, MAPCXY, & MAPTH2, MAPWN2 +#ifdef W3_T + USE W3GDATMD, ONLY: NSPEC USE W3ODATMD, ONLY: NDST +#endif + !/ #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -571,7 +574,7 @@ SUBROUTINE W3MAPT ! ! 10. Source code : !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF + USE W3GDATMD, ONLY: NSEA, MAPSF USE W3ADATMD, ONLY: ATRNX, ATRNY, MAPTRN #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -788,14 +791,14 @@ SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) USE W3TIMEMD, ONLY: DSEC21 ! USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, DTCFL, CLATS, & - ICLOSE, FLCX, FLCY, NK, NTH, DTH, XFR, & + ICLOSE, FLCX, FLCY, NTH, DTH, XFR, & ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL, & - ECOS, ESIN, SIG, WDCG, WDTH, PFMOVE, & + ECOS, ESIN, SIG, WDCG, WDTH, & FLAGLL, DPDX, DPDY, DQDX, DQDY, GSQRT USE W3WDATMD, ONLY: TIME USE W3ADATMD, ONLY: NMX0, NMX1, NMX2, NMY0, NMY1, NMY2, NACT, & - NCENT, MAPX2, MAPY2, MAPAXY, MAPCXY, & - MAPTRN, CG, CX, CY, ATRNX, ATRNY, ITIME + NCENT, MAPX2, MAPY2, MAPAXY, MAPCXY, & + MAPTRN, CG, CX, CY, ATRNX, ATRNY USE W3IDATMD, ONLY: FLCUR USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, & ISBPI, BBPI0, BBPIN, IAPROC, NAPERR @@ -808,6 +811,9 @@ SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) #endif #ifdef W3_UNO USE W3UNO2MD +#endif +#ifdef W3_MGG + USE W3GDATMD, ONLY: PFMOVE #endif !/ IMPLICIT NONE @@ -1625,7 +1631,7 @@ SUBROUTINE W3KTP3 ( ISEA, FACTH, FACK, CTHG0, CG, WN, DW, & USE W3GDATMD, ONLY: NK, NK2, NTH, NSPEC, SIG, DSIP, ECOS, ESIN, & EC2, ESC, ES2, FACHFA, MAPWN, FLCTH, FLCK, & CTMAX, DMIN - USE W3ADATMD, ONLY: MAPTH2, MAPWN2, ITIME, ITSTEP + USE W3ADATMD, ONLY: MAPTH2, MAPWN2, ITSTEP USE W3IDATMD, ONLY: FLCUR USE W3ODATMD, ONLY: NDSE, NDST #ifdef W3_S @@ -2050,17 +2056,10 @@ SUBROUTINE W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX, VGX, VGY ) ! USE W3TIMEMD, ONLY: DSEC21 ! - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, DTCFL, CLATS, & - FLCX, FLCY, NK, NTH, DTH, XFR, & - ECOS, ESIN, SIG, WDCG, WDTH, PFMOVE, & - FLAGLL, DPDX, DPDY, DQDX, DQDY, GSQRT - USE W3WDATMD, ONLY: TIME - USE W3ADATMD, ONLY: NMX0, NMX1, NMX2, NMY0, NMY1, NMY2, NACT, & - NCENT, MAPX2, MAPY2, MAPAXY, MAPCXY, & - MAPTRN, CG, CX, CY, ATRNX, ATRNY, ITIME + USE W3GDATMD, ONLY: NX, NY, MAPSF, CLATS, & + NK, NTH, ECOS, ESIN, DPDX, DPDY, DQDX, DQDY + USE W3ADATMD, ONLY: CG, CX, CY USE W3IDATMD, ONLY: FLCUR - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, & - ISBPI, BBPI0, BBPIN #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -2077,15 +2076,11 @@ SUBROUTINE W3CFLXY ( ISEA, DTG, MAPSTA, MAPFS, CFLXYMAX, VGX, VGY ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: ITH, IK, IXY, IP - INTEGER :: IX, IY, IXC, IYC, IBI + INTEGER :: ITH, IK, IXY + INTEGER :: IX, IY #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - REAL :: CG0, CGA, CGN, CGX, CGY, CXC, CYC, & - CXMIN, CXMAX, CYMIN, CYMAX - REAL :: CGC, FGSE = 1. - REAL :: FTH, FTHX, FTHY, FCG, FCGX, FCGY REAL :: CP, CQ !/ !/ Automatic work arrays diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 6078cba32e..63d0108eea 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -136,16 +136,13 @@ SUBROUTINE W3XYPUG ( ISP, FACX, FACY, DTG, VQ, VGX, VGY, LCALC ) ! USE W3TIMEMD, ONLY: DSEC21 ! - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, MAPFS, DTCFL, CLATS, & - FLCX, FLCY, NK, NTH, DTH, XFR, & - ECOS, ESIN, SIG, PFMOVE,IEN, & - NTRI, TRIGP, CCON , & - IE_CELL, POS_CELL, IOBP, IOBPD, IOBDP, & - FSN, FSPSI, FSFCT, FSNIMP, GTYPE, UNGTYPE + USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, MAPFS, CLATS, & + NTH, ECOS, ESIN, IOBP, & + IOBDP, FSN, FSPSI, FSFCT, FSNIMP, UNGTYPE USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: TBPI0, TBPIN, FLBPI - USE W3ADATMD, ONLY: CG, CX, CY, ATRNX, ATRNY, ITIME, CFLXYMAX, DW + USE W3ADATMD, ONLY: CG, CX, CY USE W3IDATMD, ONLY: FLCUR ! USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, & ! ISBPI, BBPI0, BBPIN @@ -347,17 +344,14 @@ SUBROUTINE W3CFLUG ( ISEA, NKCFL, FACX, FACY, DT, MAPFS, CFLXYMAX, & ! USE W3TIMEMD, ONLY: DSEC21 ! - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, DTCFL, CLATS, & - FLCX, FLCY, NK, NTH, DTH, XFR, & - ECOS, ESIN, SIG, PFMOVE,IEN, INDEX_CELL, & - NTRI, TRIGP, CCON , & - IE_CELL, POS_CELL, COUNTRI, SI, IOBP + USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, CLATS, & + NTH, ECOS, ESIN, IEN, INDEX_CELL, & + TRIGP, IE_CELL, POS_CELL, SI, IOBP - USE W3ADATMD, ONLY: CG, CX, CY, ATRNX, ATRNY, ITIME, DW + USE W3ADATMD, ONLY: CG, CX, CY USE W3IDATMD, ONLY: FLCUR #ifdef W3_T - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, & - ISBPI, BBPI0, BBPIN + USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -531,15 +525,14 @@ SUBROUTINE W3XYPFSN2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! !/ ------------------------------------------------------------------- / !/ - USE W3GDATMD, ONLY : NK, NTH, NTRI, NX, CCON, IE_CELL,POS_CELL, SI, & - IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBP, IOBDP, & + USE W3GDATMD, ONLY : NTH, NTRI, NX, SI, & + IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBP, IOBDP, & IOBPA, FSBCCFL #ifdef W3_REF1 USE W3GDATMD, ONLY : REFPARS #endif - USE W3WDATMD, ONLY: TIME - USE W3ADATMD, ONLY: CG, ITER, DW - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ADATMD, ONLY: CG, ITER + USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, ONLY: DSEC21 #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -582,13 +575,13 @@ SUBROUTINE W3XYPFSN2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! ! local double ! - REAL*8 :: UTILDE, BOUNDARY_FORCING + REAL*8 :: UTILDE REAL*8 :: CFLXY REAL*8 :: FL11, FL12, FL21, FL22, FL31, FL32 REAL*8 :: FL111, FL112, FL211, FL212, FL311, FL312 REAL*8 :: DTSI(NX), U(NX) REAL*8 :: DTMAXGL, DTMAXEXP, REST - REAL*8 :: LAMBDA(2), KTMP(3), CLOC(2,3) + REAL*8 :: LAMBDA(2), KTMP(3) REAL*8 :: KELEM(3,NTRI), FLALL(3,NTRI) REAL*8 :: KKSUM(NX), ST(NX) REAL*8 :: NM(NTRI) @@ -778,14 +771,13 @@ SUBROUTINE W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! !/ ------------------------------------------------------------------- / !/ - USE W3GDATMD, ONLY : NK, NTH, NTRI, NX, CCON, IE_CELL,POS_CELL, SI, & - IEN, TRIGP, CLATS, MAPSF, IOBPA, IOBPD, IOBP, NNZ, IOBDP + USE W3GDATMD, ONLY : NTH, NTRI, NX, SI, & + IEN, TRIGP, CLATS, MAPSF, IOBPA, IOBPD, IOBDP #ifdef W3_REF1 USE W3GDATMD, ONLY : REFPARS #endif - USE W3WDATMD, ONLY: TIME USE W3ADATMD, ONLY: CG, ITER - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, ONLY: DSEC21 #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -828,13 +820,13 @@ SUBROUTINE W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !: ! local double ! - REAL*8 :: UTILDE, BOUNDARY_FORCING + REAL*8 :: UTILDE REAL*8 :: FT, CFLXY REAL*8 :: FL11, FL12, FL21, FL22, FL31, FL32 REAL*8 :: FL111, FL112, FL211, FL212, FL311, FL312 REAL*8 :: DTSI(NX), U(NX) REAL*8 :: DTMAXGL, DTMAXEXP, REST - REAL*8 :: LAMBDA(2), KTMP(3), TMP(3) + REAL*8 :: LAMBDA(2), KTMP(3) REAL*8 :: THETA_L(3), BET1(3), BETAHAT(3) REAL*8 :: KELEM(3,NTRI), FLALL(3,NTRI) REAL*8 :: KKSUM(NX), ST(NX) @@ -1032,15 +1024,14 @@ SUBROUTINE W3XYPFSNIMP ( ISP, C, LCALC, RD10, RD20, DT, AC) ! !/ ------------------------------------------------------------------- / !/ - USE W3GDATMD, ONLY : NK, NTH, NTRI, NX, CCON, IE_CELL,POS_CELL, SI, & - IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBPA, IOBP, IAA, JAA, POSI, & + USE W3GDATMD, ONLY : NTH, NTRI, NX, CCON, IE_CELL,POS_CELL, & + IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBPA, IAA, JAA, POSI, & TRIA, NNZ #ifdef W3_REF1 USE W3GDATMD, ONLY : REFPARS #endif - USE W3WDATMD, ONLY: TIME - USE W3ADATMD, ONLY: CG, ITER - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ADATMD, ONLY: CG + USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, ONLY: DSEC21 #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -1084,7 +1075,6 @@ SUBROUTINE W3XYPFSNIMP ( ISP, C, LCALC, RD10, RD20, DT, AC) !: ! local double ! - REAL*8 :: BOUNDARY_FORCING REAL*8 :: FL11, FL12, FL21, FL22, FL31, FL32 REAL*8 :: U(NX) REAL*8 :: DTMAXGL @@ -1332,14 +1322,13 @@ SUBROUTINE W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! !/ ------------------------------------------------------------------- / !/ - USE W3GDATMD, ONLY : NK, NTH, NTRI, NX, CCON, IE_CELL,POS_CELL, SI, & - IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBPA, TRIA, IOBDP + USE W3GDATMD, ONLY : NTH, NTRI, NX, SI, & + IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBPA, IOBDP #ifdef W3_REF1 USE W3GDATMD, ONLY : REFPARS #endif - USE W3WDATMD, ONLY: TIME USE W3ADATMD, ONLY: CG, ITER - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, ONLY: DSEC21 #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -1383,7 +1372,7 @@ SUBROUTINE W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !: ! local double ! - REAL*8 :: UTILDE, BOUNDARY_FORCING + REAL*8 :: UTILDE REAL*8 :: FT, CFLXY REAL*8 :: FL11, FL12, FL21, FL22, FL31, FL32 REAL*8 :: FL111, FL112, FL211, FL212, FL311, FL312 @@ -1637,8 +1626,7 @@ SUBROUTINE SETDEPTH USE W3SERVMD, ONLY: STRACE #endif ! - USE CONSTANTS, ONLY : LPDLIB - USE W3GDATMD, ONLY: MAPSF, NSEAL, DMIN, IOBDP, MAPSTA, IOBP, MAPFS, NX + USE W3GDATMD, ONLY: DMIN, IOBDP, MAPFS, NX USE W3ADATMD, ONLY: DW IMPLICIT NONE @@ -1655,7 +1643,7 @@ SUBROUTINE SETDEPTH !/ !/ ------------------------------------------------------------------- / ! - INTEGER :: JSEA, ISEA, IX, IP + INTEGER :: IP REAL*8, PARAMETER :: DTHR = 10E-6 #ifdef W3_S CALL STRACE (IENT, 'SETDEPTH') diff --git a/model/src/w3sdb1md.F90 b/model/src/w3sdb1md.F90 index 0e0c09e809..1be24a9759 100644 --- a/model/src/w3sdb1md.F90 +++ b/model/src/w3sdb1md.F90 @@ -183,19 +183,22 @@ SUBROUTINE W3SDB1 (IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D ) !/ ------------------------------------------------------------------- / !/ USE CONSTANTS - USE W3GDATMD, ONLY: NK, NTH, NSPEC, SDBC1, SDBC2, FDONLY, FSSOURCE, DDEN - USE W3ODATMD, ONLY: NDST + USE W3GDATMD, ONLY: NK, NTH, NSPEC, SDBC1, SDBC2, FDONLY, DDEN USE W3GDATMD, ONLY: SIG - USE W3ODATMD, only : IAPROC USE W3PARALL, only : THR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif +#ifdef W3_T + USE W3ODATMD, ONLY: NDST +#endif #ifdef W3_T0 USE W3ARRYMD, ONLY: PRT2DS + USE W3ODATMD, ONLY: NDST #endif #ifdef W3_T1 USE W3ARRYMD, ONLY: OUTMAT + USE W3ODATMD, ONLY: NDST #endif !/ IMPLICIT NONE diff --git a/model/src/w3strkmd.F90 b/model/src/w3strkmd.F90 index 97796dfda1..c10e02d30f 100644 --- a/model/src/w3strkmd.F90 +++ b/model/src/w3strkmd.F90 @@ -369,8 +369,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & INTEGER :: maxGroup, intype, tmax, tcur, ntint INTEGER, POINTER :: maxSys(:) TYPE(dat2d), POINTER :: wsdat(:) - TYPE(timsys), POINTER :: sysA(:), sysAA(:) - INTEGER :: NumConsSys, iConsSys + TYPE(timsys), POINTER :: sysA(:) REAL :: dt REAL :: minlon, maxlon, minlat, maxlat INTEGER :: mxcwt, mycwt @@ -419,7 +418,7 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & REAL, ALLOCATABLE :: mlon(:,:), mlat(:,:), tmp_r4(:) REAL, POINTER :: uniqueTim(:),uniqueLatraw(:),uniqueLonraw(:), & uniqueLat(:),uniqueLon(:) - INTEGER :: ioerr,ierr, i, j, k, l, alreadyIn, ok, tss, tsA + INTEGER :: ioerr,ierr, i, j, k, l, tsA INTEGER :: maxPart, DATETIME(2) INTEGER :: tstep, iline, numpart, skipln, readln, filesize REAL :: x,y,wnd,wnddir @@ -427,14 +426,13 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & REAL :: invar5, invar6, invar7 REAL, ALLOCATABLE :: phs(:),ptp(:),pdir(:),pspr(:),pwf(:) ! current partition values REAL*8 :: date1, date2, ttest, ttemp - INTEGER :: ic, leng, maxpartout ! Remove? - REAL :: dx + INTEGER :: maxpartout ! Remove? INTEGER :: latind1, latind2, lonind1, lonind2 REAL :: lonext, latext LOGICAL :: endloop #ifdef W3_MPI - INTEGER :: rank, irank, nproc, EXTENT, DOMSIZE, tag1, tag2 + INTEGER :: rank, irank, nproc, EXTENT, DOMSIZE, tag1, tag2, ic ! INTEGER :: MPI_INT_DOMARR, MPI_REAL_DOMARR type(MPI_STATUS) :: MPI_STAT INTEGER :: REQ(16) @@ -2127,21 +2125,18 @@ SUBROUTINE timeTrackingV2 (sysA ,maxSys ,tpTimeKnob , & LOGICAL :: file_exists CHARACTER :: dummy*23 TYPE(sysmemory) :: sysMem(50) !!! 50 memory spaces should be enough Check!!! - INTEGER :: leng, l, i, ii, j, k, kk, idir, numSys, & - counter, new, DIFSIZE, tpMinInd, dirMinInd, used, ok - REAL :: Tb, deltaPer, deltaDir, tpMinVal, dirMinVal, & - dirForTpMin, tpForDirMin + INTEGER :: leng, l, i, ii, j, k, kk, idir, & + counter, new, tpMinInd, dirMinInd, used, ok + REAL :: deltaPer, deltaDir, tpMinVal REAL, ALLOCATABLE :: sysOrdered(:), TEMP(:), dirs(:) - REAL, POINTER :: DIFARR(:) INTEGER, ALLOCATABLE :: indSorted(:), alreadyUsed(:), allInd(:) INTEGER, ALLOCATABLE :: ind(:), ind2(:) INTEGER :: ts1 REAL, ALLOCATABLE :: GOF(:,:), GOFMinVal(:), GOFMinInd(:), & Tbsysmem(:), deltaDirsysmem(:), & deltaPersysmem(:),m1sysmem(:),m2sysmem(:) - REAL :: m1, m2 REAL :: lonmean, latmean, dmndiag - INTEGER :: npnts, npnts2 + INTEGER :: npnts REAL, ALLOCATABLE :: mnlonlist(:), mnlatlist(:), mndist(:) REAL, POINTER :: dummy1(:),dummy2(:),dummy3(:) INTEGER, ALLOCATABLE :: olsize(:) @@ -3057,14 +3052,12 @@ SUBROUTINE findSys (i ,j ,wsdat ,maxSys , & TYPE(mtchsys) :: match LOGICAL :: found INTEGER :: counter, ii, jj, nngbr, startCount, endCount, l,& - nout, maxS, s, p, n, countAll, ind, minInd, & - npart, pp, leng + nout, maxS, s, p, n, countAll, ind, npart, pp, leng INTEGER :: allFullSys(50) REAL, POINTER :: realarr(:) INTEGER, ALLOCATABLE :: allSys(:) REAL :: hsAll(50),tpAll(50),dirAll(50),GOF(50) - REAL :: absDir,absPer,absHs,T,& - deltaPer,deltaDir,deltaHs,temp + REAL :: absDir,absPer,absHs,T,deltaPer,deltaDir,deltaHs REAL :: dx, m1, m2 REAL :: GOFMinVal INTEGER :: GOFMinInd @@ -3344,7 +3337,7 @@ SUBROUTINE combineWaveSystems (wsdat ,maxSys ,maxPts , & ! combine Int input Toggle: 1=combine systems; 0=do not combine TYPE(dat2d) :: wsdat - TYPE(system), POINTER :: sys(:), systemp(:) + TYPE(system), POINTER :: sys(:) INTEGER :: maxSys, maxPts, maxI, maxJ, combine REAL :: perKnob ,dirKnob, hsKnob @@ -3357,12 +3350,11 @@ SUBROUTINE combineWaveSystems (wsdat ,maxSys ,maxPts , & ! nSys Int Number of wave systems (for checking iterative combining loop) ! LOGICAL :: found - INTEGER, ALLOCATABLE :: sysOut(:) INTEGER, ALLOCATABLE :: actSysInd(:) INTEGER :: iter, ok, nSys, mS, s, so, ss, ind, leng, & iw, jw, iloop INTEGER :: actSys - REAL :: dev, hsCmp, maxHgt, temp(5) + REAL :: dev, hsCmp, maxHgt ! ! 4. Subroutines used : ! @@ -3835,7 +3827,7 @@ SUBROUTINE combineSys (wsdat ,sys ,maxSys ,maxI , & REAL, ALLOCATABLE :: sysOrdered(:), rounded(:) REAL, POINTER :: uniarr(:), difarr(:), allngbr(:) INTEGER :: leng, leng2, s, ss, so, ngb, lsys, lsys2, hh, i, j, & - ii, jj, ind, ind2, nn, nbr, icEnd,ic,iii,iloop + ii, jj, ind, ind2, nn, nbr, ic, iii INTEGER :: myngbr, indMatch, matchSys, keep, replacedInd, & hhForIndMatch, lMatch, tot, outsize INTEGER :: ngbIndex(10000), keepInd(maxI*maxJ), oneLess(1000) !Array large enough? @@ -4428,7 +4420,7 @@ SUBROUTINE combinePartitionsV2 (dat) TYPE(duplicate) :: dup(100) !40.PAR LOGICAL :: found - INTEGER :: nsys, ndup, p, pp, maxInd, npart, s, ss, ppp + INTEGER :: nsys, p, pp, maxInd, npart, s, ss, ppp REAL :: temp ! ! 4. Subroutines used : @@ -5869,7 +5861,7 @@ RECURSIVE SUBROUTINE QSORT_DESC(ARRAY,IDX,LO,HI) !/ ! Local variables ! ---------------------------------------------------------------- - INTEGER :: TOP, BOT, I + INTEGER :: TOP, BOT REAL :: VAL, TMP LOGICAL :: LOOP ! From 7f8905732c97c5082a8f2d988e122a8c399038fd Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 12 Jan 2026 16:40:32 -0500 Subject: [PATCH 124/136] Partially address compiler remarks in modules w3iopomd, w3iogomd, w3adatmd, w3gdatmd, and w3triamd (#1556) --- model/src/w3adatmd.F90 | 28 ++++------- model/src/w3gdatmd.F90 | 16 ++++--- model/src/w3iogomd.F90 | 57 +++++++++++----------- model/src/w3iopomd.F90 | 63 +++++++++++++------------ model/src/w3triamd.F90 | 104 ++++++++++++++++++----------------------- 5 files changed, 123 insertions(+), 145 deletions(-) diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index fc40222a81..d4c5f0e285 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -757,7 +757,6 @@ SUBROUTINE W3NAUX ( NDSE, NDST ) !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NGRIDS USE W3SERVMD, ONLY: EXTCDE - USE W3ODATMD, ONLY: IAPROC #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -926,11 +925,9 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY : LPDLIB - USE W3GDATMD, ONLY: NGRIDS, IGRID, W3SETG, NK, NX, NY, NSEA, & - NSEAL, NSPEC, NTH, E3DF, P2MSF, US3DF, & - USSPF, GTYPE, UNGTYPE - USE W3ODATMD, ONLY: IAPROC, NAPROC, NTPROC, NAPFLD, & - NOSWLL, NOEXTR, UNDEF, FLOGRD, FLOGR2 + USE W3GDATMD, ONLY: NGRIDS, IGRID, W3SETG, NK, NX, NY, NSEA, & + NSEAL, NSPEC, NTH, E3DF, P2MSF, US3DF, USSPF, GTYPE, UNGTYPE + USE W3ODATMD, ONLY: IAPROC, NAPROC, NOSWLL, NOEXTR, UNDEF USE W3IDATMD, ONLY: FLCUR, FLWIND, FLTAUA, FLRHOA USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S @@ -947,7 +944,7 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: JGRID, NXXX, NSEAL_tmp + INTEGER :: JGRID, NXXX integer :: memunit #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -1543,12 +1540,8 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NGRIDS, IGRID, W3SETG, NK, NX, NY, NSEA, & - NSEAL, NSPEC, NTH, E3DF, P2MSF, US3DF, & - USSPF, GTYPE, UNGTYPE - USE W3ODATMD, ONLY: IAPROC, NAPROC, NTPROC, NAPFLD, & - NOSWLL, NOEXTR, UNDEF, FLOGRD, FLOGR2, & - NOGRP, NGRPP + USE W3GDATMD, ONLY: NGRIDS, IGRID, W3SETG, NK, E3DF, P2MSF, UNGTYPE + USE W3ODATMD, ONLY: IAPROC, NAPROC, NOSWLL, NOEXTR, UNDEF, NOGRP, NGRPP USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -2495,9 +2488,7 @@ SUBROUTINE W3DMNL ( IMOD, NDSE, NDST, NSP, NSPX ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NGRIDS, IGRID, NK, NX, NY, NSEA, NSEAL, & - NSPEC, NTH, GTYPE, UNGTYPE - USE W3ODATMD, ONLY: NAPROC + USE W3GDATMD, ONLY: NGRIDS, UNGTYPE USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -2711,7 +2702,7 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) !/ ------------------------------------------------------------------- / ! USE W3IDATMD, ONLY: INPUTS - USE W3GDATMD, ONLY: E3DF, P2MSF, US3DF, USSPF, GTYPE, UNGTYPE + USE W3GDATMD, ONLY: GTYPE, UNGTYPE ! USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S @@ -3139,8 +3130,7 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) ! !/ ------------------------------------------------------------------- / ! - USE W3IDATMD, ONLY: INPUTS - USE W3GDATMD, ONLY: E3DF, P2MSF, US3DF, USSPF, GTYPE, UNGTYPE + USE W3GDATMD, ONLY: UNGTYPE ! USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 4f5aad1716..a43a4cd822 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -2970,7 +2970,10 @@ SUBROUTINE W3GNTX ( IMOD, NDSE, NDST ) LOGICAL, PARAMETER :: SPHERE = .FALSE. INTEGER :: PRANGE(2), QRANGE(2) INTEGER :: LBI(2), UBI(2), LBO(2), UBO(2), ISTAT +#if defined(TEST_W3GDATMD) || defined(TEST_W3GDATMD_W3GNTX) REAL , ALLOCATABLE :: COSA(:,:) +#endif + #ifdef W3_S INTEGER, SAVE :: IENT = 0 CALL STRACE (IENT, 'W3GNTX') @@ -3189,7 +3192,6 @@ SUBROUTINE W3DIMUG ( IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST ) !/ Parameter list !/ INTEGER, INTENT(IN) :: IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST - INTEGER :: IAPROC = 1 !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -3361,15 +3363,17 @@ SUBROUTINE W3SETREF !/ !/ ------------------------------------------------------------------- / !/ - INTEGER :: ISEA, IX, IY, IXY, IXN, IXP, IYN, IYP - INTEGER :: J, K, NEIGH1(0:7) - INTEGER :: ILEV, NLEV + INTEGER :: IX, IY + INTEGER :: NEIGH1(0:7) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif +#ifdef W3_REF1 + REAL :: COSAVG, SINAVG, THAVG, CLAT + INTEGER :: J, K +#endif - REAL :: TRIX(NY*NX), TRIY(NY*NX), DX, DY, & - COSAVG, SINAVG, THAVG, ANGLES(0:7), CLAT + REAL :: ANGLES(0:7) !/ !/ ------------------------------------------------------------------- / !/ diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index c4c78191ed..3422b6bf52 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -401,7 +401,6 @@ SUBROUTINE W3READFLGRD ( NDSI , NDSO, NDSS, NDSEN, COMSTR, & ! !/ ------------------------------------------------------------------- / USE CONSTANTS - USE W3GDATMD, ONLY: US3DF, USSPF USE W3ODATMD, ONLY: NOGRP, NGRPP, NOGE, IDOUT USE W3SERVMD, ONLY: NEXTLN, STRSPLIT, STR_TO_UPPER #ifdef W3_S @@ -657,7 +656,6 @@ SUBROUTINE W3FLGRDFLAG ( NDSO, NDSS, NDSEN, FLDOUT, & USE CONSTANTS USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT USE W3SERVMD, ONLY: STRSPLIT, STR_TO_UPPER - USE W3GDATMD, ONLY: US3DF, USSPF #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -676,7 +674,7 @@ SUBROUTINE W3FLGRDFLAG ( NDSO, NDSS, NDSEN, FLDOUT, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: I, IFI, IFJ, IOUT + INTEGER :: IFI, IFJ, IOUT #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -1300,24 +1298,23 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) !/ ------------------------------------------------------------------- / USE CONSTANTS USE W3GDATMD - USE W3WDATMD, ONLY: UST, FPIS USE W3ADATMD, ONLY: CG, WN, DW USE W3ADATMD, ONLY: HS, WLM, T02, T0M1, T01, FP0, & THM, THS, THP0 USE W3ADATMD, ONLY: ABA, ABD, UBA, UBD, FCUT, SXX, & SYY, SXY, PHS, PTP, PLP, PDIR, PSI, PWS, & - PWST, PNR, USERO, TUSX, TUSY, PRMS, TPMS, & + PWST, PNR, TUSX, TUSY, PRMS, TPMS, & USSX, USSY, MSSX, MSSY, MSSD, MSCX, MSCY, & - MSCD, CHARN, & - BHD, CGE, P2SMS, US3D, EF, TH1M, STH1M, & + MSCD, BHD, CGE, P2SMS, EF, TH1M, STH1M, & TH2M, STH2M, HSIG, STMAXE, STMAXD, & - HCMAXE, HMAXE, HCMAXD, HMAXD, USSP, QP, PQP,& + HCMAXE, HMAXE, HCMAXD, HMAXD, QP, PQP, & PTHP0, PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & WBT, QKK - USE W3ODATMD, ONLY: NDST, UNDEF, IAPROC, NAPROC, NAPFLD, & - ICPRT, DTPRT, WSCUT, NOSWLL, FLOGRD, FLOGR2,& - NOGRP, NGRPP - USE W3ADATMD, ONLY: NSEALM + USE W3ODATMD, ONLY: UNDEF, ICPRT, DTPRT, WSCUT, & + NOSWLL, FLOGRD, FLOGR2, NOGRP, NGRPP +#ifdef W3_T + USE W3ODATMD, ONLY: NDST +#endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -1335,13 +1332,11 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) !/ Local parameters !/ INTEGER :: IK, ITH, JSEA, ISEA, IX, IY, & - IKP0(NSEAL), NKH(NSEAL), & - I, J, LKMS, HKMS, ITL + IKP0(NSEAL), NKH(NSEAL), I, J, ITL #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif REAL :: FXPMC, FACTOR, FACTOR2, EBAND, FKD, & - AABS, UABS, & XL, XH, XL2, XH2, EL, EH, DENOM, KD, & M1, M2, MA, MB, MC, STEX, STEY, STED REAL :: ET(NSEAL), EWN(NSEAL), ETR(NSEAL), & @@ -1367,8 +1362,8 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) T02P(NSEAL), NV(NSEAL), NS(NSEAL), & NB(NSEAL), MODE(NSEAL), & MU(NSEAL), NI(NSEAL), STMAXEL(NSEAL),& - PHI(21,NSEAL),PHIST(NSEAL), & - EBC(NK,NSEAL), ABP(NSEAL), & + PHI(21,NSEAL),PHIST(NSEAL), & + EBC(NK,NSEAL), & STMAXDL(NSEAL), TLPHI(NSEAL), & WL02X(NSEAL), WL02Y(NSEAL), & ALPXT(NSEAL), ALPYT(NSEAL), & @@ -2518,7 +2513,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & USE W3ADATMD, ONLY: W3SETA, W3DIMA, W3XETA USE W3ODATMD, ONLY: W3SETO !/ - USE W3WDATMD, ONLY: TIME, DINIT, WLV, ICE, ICEF, ICEH, BERG, & + USE W3WDATMD, ONLY: TIME, DINIT, WLV, ICE, BERG, & UST, USTDIR, ASF, RHOAIR USE W3ADATMD, ONLY: AINIT, DW, UA, UD, AS, CX, CY, WN, & TAUA, TAUADIR @@ -2537,18 +2532,23 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& USSP, TAUOCX, TAUOCY, QKK, SKEW, EMBIA1, EMBIA2 !/ - USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & + USE W3ODATMD, ONLY: NOGRP, NGRPP, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & FNMPRE, FNMGRD, NOSWLL, NOEXTR !/ USE W3SERVMD, ONLY: EXTCDE, EXTOPN, EXTIOF - USE W3ODATMD, only: IAPROC USE W3ODATMD, ONLY: OFILES +#ifdef W3_T + USE W3ODATMD, ONLY: IDOUT +#endif #ifdef W3_SETUP USE W3WDATMD, ONLY: ZETA_SETUP #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE +#endif +#ifdef W3_IS2 + USE W3WDATMD, ONLY: ICEF, ICEH #endif ! IMPLICIT NONE @@ -2569,14 +2569,12 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & !/ Local parameters !/ INTEGER :: IGRD, IERR, I, J, IX, IY, MOGRP, & - MGRPP, ISEA, MOSWLL, IK, IFI, IFJ & - ,IFILOUT + MGRPP, ISEA, MOSWLL, IK, IFI, IFJ INTEGER, ALLOCATABLE :: MAPTMP(:,:) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - REAL :: AUX1(NSEA), AUX2(NSEA), & - AUX3(NSEA), AUX4(NSEA) + REAL :: AUX1(NSEA), AUX2(NSEA) #ifdef W3_SMC REAL :: UDARC #endif @@ -4191,12 +4189,11 @@ SUBROUTINE CALC_U3STOKES ( A , USS_SWITCH ) ! !/ ------------------------------------------------------------------- / USE CONSTANTS, ONLY: TPIINV, GRAV, TPI - USE W3GDATMD, ONLY: DDEN, DSII, XFR, SIG, NK, NTH, NSEAl, & + USE W3GDATMD, ONLY: DDEN, DSII, SIG, NK, NTH, NSEAl, & ECOS, ESIN, US3DF, USSPF, USSP_WN USE W3ADATMD, ONLY: CG, WN, DW - USE W3ADATMD, ONLY: USSX, USSY, US3D, USSP - USE W3ODATMD, ONLY: IAPROC, NAPROC - USE W3PARALL, ONLY: INIT_GET_ISEA + USE W3ADATMD, ONLY: US3D, USSP + USE W3PARALL, ONLY: INIT_GET_ISEA #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -4645,7 +4642,7 @@ SUBROUTINE SECONDHH(NKHF,FAC0,FAC1,FAC2,FAC3) ! V E ZAKHAROV(1967) !------------------------------------------------------------------- USE CONSTANTS, ONLY: GRAV, TPI - USE W3GDATMD, ONLY: NK, NTH, XFR, SIG, TH, DTH, ECOS, ESIN + USE W3GDATMD, ONLY: NTH, XFR, SIG, TH, DTH, ECOS, ESIN IMPLICIT NONE INTEGER, INTENT(IN) :: NKHF @@ -4930,7 +4927,7 @@ SUBROUTINE SKEWNESS(A) REAL(KIND=4) :: CONX, DELTA REAL(KIND=4) :: FH, DELF, XK1 - REAL(KIND=4) :: XPI, XPJ, XPK, XN, XFAC, CO1 + REAL(KIND=4) :: XPI, XPJ, XPK, XN, CO1 REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE :: F2 REAL(KIND=4), DIMENSION(0:3,0:2,0:2) :: XMU, XLAMBDA REAL(KIND=4), DIMENSION(:) , ALLOCATABLE:: SIGHF, DFIMHF, FAK diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index be7bcbff16..a4c1edb198 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -344,18 +344,15 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) !/ ------------------------------------------------------------------- / USE NETCDF USE W3GSRUMD, ONLY: W3GRMP - USE W3GDATMD, ONLY: NTH, NK, NSPEC, NX, NY, X0, Y0, SX, GSU,& - RLGTYPE, CLGTYPE, UNGTYPE, GTYPE, FLAGLL, & - ICLOSE,ICLOSE_NONE,ICLOSE_SMPL,ICLOSE_TRPL, & - MAPSTA, MAPFS, FILEXT, ZB, TRNX, TRNY - USE W3GDATMD, ONLY: TRIGP,MAXX, MAXY, DXYMAX + USE W3GDATMD, ONLY: GSU, RLGTYPE, CLGTYPE, UNGTYPE, GTYPE, FLAGLL, & + ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL, MAPSTA, FILEXT #ifdef W3_RTD !! Use rotated N-Pole lat/lon and conversion sub. JGLi12Jun2012 - USE W3GDATMD, ONLY: PoLat, PoLon, FLAGUNR + USE W3GDATMD, ONLY: PoLat, PoLon, FLAGUNR, X0 USE W3SERVMD, ONLY: W3LLTOEQ #endif - USE W3ODATMD, ONLY: W3DMO2, FNMPRE - USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, NAPOUT, SCREEN, & + USE W3ODATMD, ONLY: W3DMO2 + USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, & NOPTS, PTLOC, PTNME, GRDID, IPTINT, PTIFAC USE W3SERVMD, ONLY: EXTOPN, EXTIOF #ifdef W3_S @@ -363,6 +360,10 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) #endif USE W3TRIAMD, ONLY: IS_IN_UNGRID USE W3GDATMD, ONLY: FILEXT +#ifdef W3_O7a + USE W3GDATMD, ONLY: NX, NY, ICLOSE, MAPFS, ZB, TRNX, TRNY + USE W3ODATMD, ONLY: NAPOUT, SCREEN +#endif ! #ifdef W3_MPI use mpi_f08 @@ -385,8 +386,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) !/ Local parameters !/ LOGICAL :: INGRID - INTEGER :: IPT, J, K - INTEGER :: IX1, IY1, IXS, IYS + INTEGER :: IPT, K #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -397,7 +397,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD, MPI_COMM_IOPP ) INTEGER :: ITOUT ! Triangle index in unstructured grids #ifdef W3_O7a INTEGER :: IX0, IXN, IY0, IYN, NNX, & - KX, KY, JX, IIX, IX2, IY2, IS1 + KX, KY, JX, IIX, IX2, IY2, IS1, J, IX1, IY1 REAL :: RD1, RD2, RDTOT, ZBOX(4), DEPTH CHARACTER(LEN=1) :: SEA(5), LND(5), OUT(5) CHARACTER(LEN=9) :: PARTS @@ -954,8 +954,7 @@ SUBROUTINE W3IOPE ( A ) ! !/ ------------------------------------------------------------------- / USE CONSTANTS - USE W3GDATMD, ONLY: NK, NTH, SIG, NX, NY, NSEA, NSEAL, & - MAPSTA, MAPFS + USE W3GDATMD, ONLY: NK, NTH, SIG, NSEAL, MAPSTA, MAPFS #ifdef W3_RTD !! Use spectral rotation sub and angle. JGLi12Jun2012 USE W3GDATMD, ONLY: NSPEC, AnglD, FLAGUNR @@ -970,9 +969,8 @@ SUBROUTINE W3IOPE ( A ) #ifdef W3_FLX5 USE W3ADATMD, ONLY: TAUA, TAUADIR #endif - USE W3ODATMD, ONLY: NDST, NOPTS, IPTINT, PTIFAC, IL, IW, II, & - DPO, WAO, WDO, ASO, CAO, CDO, ICEO, ICEHO, & - ICEFO, SPCO, NAPROC + USE W3ODATMD, ONLY: NOPTS, IPTINT, PTIFAC, IL, IW, II, & + DPO, WAO, WDO, ASO, CAO, CDO, ICEO, ICEHO, ICEFO, SPCO #ifdef W3_FLX5 USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO #endif @@ -988,6 +986,10 @@ SUBROUTINE W3IOPE ( A ) #endif #ifdef W3_T USE W3ARRYMD, ONLY: PRT2DS + USE W3ODATMD, ONLY: NDST +#endif +#ifdef W3_DIST + USE W3ODATMD, ONLY: NAPROC #endif ! #ifdef W3_MPI @@ -1003,8 +1005,7 @@ SUBROUTINE W3IOPE ( A ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: I, IX1, IY1, IX(4), IY(4), J, IS(4), & - IM(4), IK, ITH, ISP + INTEGER :: I, IX(4), IY(4), J, IS(4), IM(4), IK, ITH, ISP #ifdef W3_MPI INTEGER :: IOFF, IERR_MPI type(MPI_STATUS) :: STAT(4*NOPTS) @@ -1020,6 +1021,7 @@ SUBROUTINE W3IOPE ( A ) #endif INTEGER :: JSEA, ISEA #ifdef W3_T + INTEGER :: IX1, IY1 REAL :: SPTEST(NK,NTH) #endif #ifdef W3_RTD @@ -1328,9 +1330,9 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr, TOUT ) USE W3ODATMD, ONLY: W3DMO2 USE W3WDATMD, ONLY: TIME USE W3GDATMD, ONLY: NTH, NK, NSPEC, FILEXT - USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & - IL, IW, II, PTLOC, PTIFAC, DPO, WAO, WDO, & - ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, FNMPNT, & + USE W3ODATMD, ONLY: NDSE, NDST, IPASS => IPASS2, NOPTS, & + IL, IW, II, PTLOC, DPO, WAO, WDO, & + ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, & GRDID, ICEO, ICEHO, ICEFO, W3DMO2 USE W3SERVMD, ONLY: EXTCDE #ifdef W3_FLX5 @@ -1350,9 +1352,9 @@ SUBROUTINE W3IOPON_READ(IOTST, IMOD_IN, filename, ncerr, TOUT ) LOGICAL :: per_time_step INTEGER :: IGRD,MK,MTH integer :: fh, itime - integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time, d_ww3time - integer :: d_nopts_len, d_nspec_len, d_vsize_len, d_namelen_len, d_grdidlen_len, d_time_len, d_ww3time_len - integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time + integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time + integer :: d_nopts_len, d_nspec_len, d_vsize_len, d_namelen_len, d_grdidlen_len, d_time_len + integer :: v_nk, v_nth, v_ptloc, v_ptnme, v_ww3time integer :: v_dpo, v_wao, v_wdo #ifdef W3_FLX5 integer :: v_tauao,v_taudo, v_dairo @@ -1617,9 +1619,8 @@ SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr, NDSOP, fname, path) USE NETCDF USE W3GDATMD, ONLY: NTH, NK, NSPEC USE W3WDATMD, ONLY: TIME - USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & - PTLOC, PTIFAC, DPO, WAO, WDO, & - ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, FNMPNT, & + USE W3ODATMD, ONLY: IPASS => IPASS2, NOPTS, & + PTLOC, DPO, WAO, WDO, ASO, CAO, CDO, SPCO, PTNME, & GRDID, ICEO, ICEHO, ICEFO USE W3TIMEMD, ONLY: CALTYPE, T2D, U2D, TSUB #ifdef W3_FLX5 @@ -1638,9 +1639,9 @@ SUBROUTINE W3IOPON_WRITE(timestep_only,filename, ncerr, NDSOP, fname, path) CHARACTER(LEN=124), INTENT(IN), OPTIONAL :: fname CHARACTER(LEN=256), INTENT(IN), OPTIONAL :: path ! - integer :: ndim, nvar, fmt, itime, fh + integer :: itime, fh integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time - integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time + integer :: v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time integer :: v_dpo, v_wao, v_wdo #ifdef W3_FLX5 integer :: v_tauao, v_taudo, v_dairo @@ -2212,8 +2213,8 @@ SUBROUTINE W3IOPO ( INXOUT, NDSOP, IOTST, IMOD & !/ USE W3GDATMD, ONLY: NTH, NK, NSPEC, FILEXT USE W3WDATMD, ONLY: TIME - USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, IPTINT, & - IL, IW, II, PTLOC, PTIFAC, DPO, WAO, WDO, & + USE W3ODATMD, ONLY: NDST, NDSE, IPASS => IPASS2, NOPTS, & + IL, IW, II, PTLOC, DPO, WAO, WDO, & ASO, CAO, CDO, SPCO, PTNME, O2INIT, FNMPRE, FNMPNT, & GRDID, ICEO, ICEHO, ICEFO #ifdef W3_FLX5 diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index 14c9ec41ac..cc38b5fc46 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -201,11 +201,10 @@ SUBROUTINE READMSH(NDS,FNAME) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3ODATMD, ONLY: NDSE, NDST, NDSO + USE W3ODATMD, ONLY: NDSE, NDST USE W3GDATMD, ONLY: ZB, XGRD, YGRD, NTRI, NX, COUNTOT, TRIGP, NNZ, W3DIMUG USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE USE CONSTANTS, only: LPDLIB - USE W3ODATMD, ONLY: IAPROC ! IMPLICIT NONE !/ @@ -216,20 +215,16 @@ SUBROUTINE READMSH(NDS,FNAME) !/ !/ local parameters !/ - INTEGER :: i,j,k, NODES, NELTS, ID, KID - INTEGER :: ID1, ID2, KID1, ITMP(3) + INTEGER :: i,j,k, NODES, NELTS + INTEGER :: ITMP(3) INTEGER :: I1, I2, I3 INTEGER(KIND=4) :: Ind,eltype,ntag, INode - CHARACTER :: COMSTR*1, SPACE*1 = ' ', CELS*64 + CHARACTER :: COMSTR*1 REAL, ALLOCATABLE :: TAGS(:) - CHARACTER(LEN=64), ALLOCATABLE :: ELS(:) CHARACTER(LEN=120) :: LINE - CHARACTER(LEN=50) :: CHTMP - CHARACTER(LEN=10) :: A, B, C - INTEGER,ALLOCATABLE :: NELS(:), TRIGPTMP1(:,:), TRIGPTMP2(:,:) + INTEGER,ALLOCATABLE :: TRIGPTMP1(:,:), TRIGPTMP2(:,:) INTEGER(KIND=4),ALLOCATABLE :: IFOUND(:), VERTEX(:), BOUNDTMP(:) DOUBLE PRECISION, ALLOCATABLE :: XYBTMP1(:,:),XYBTMP2(:,:) - REAL :: z OPEN(NDS,FILE = FNAME,STATUS='old') READ (NDS,'(A)') COMSTR @@ -456,11 +451,9 @@ SUBROUTINE READMSH_IOBP(NDS,FNAME) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3ODATMD, ONLY: NDSE, NDST, NDSO + USE W3ODATMD, ONLY: NDSE USE W3GDATMD USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE - USE CONSTANTS, only: LPDLIB - USE W3ODATMD, ONLY: IAPROC ! IMPLICIT NONE !/ @@ -473,7 +466,7 @@ SUBROUTINE READMSH_IOBP(NDS,FNAME) !/ INTEGER :: i,j,k, NODES LOGICAL :: lfile_exists - CHARACTER :: COMSTR*1, SPACE*1 = ' ', CELS*64 + CHARACTER :: COMSTR*1 DOUBLE PRECISION, ALLOCATABLE :: XYBTMP1(:,:) INQUIRE(FILE=FNAME, EXIST=lfile_exists) @@ -716,8 +709,8 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NX, NY, CCON , COUNTCON - USE W3ODATMD, ONLY: NDSE, NDST, NDSO + USE W3GDATMD, ONLY: NX, NY + USE W3ODATMD, ONLY: NDSE USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -734,9 +727,9 @@ SUBROUTINE READMSHOBC(NDS, FNAME, TMPSTA, UGOBCOK) !/ !/ local parameters !/ - INTEGER :: I, IERR + INTEGER :: IERR INTEGER(KIND=4) :: Ind,ntag, INode - CHARACTER :: COMSTR*1, SPACE*1 = ' ', CELS*64 + CHARACTER :: COMSTR*1 REAL, ALLOCATABLE :: TAGS(:) CHARACTER(LEN=120) :: LINE @@ -825,7 +818,7 @@ SUBROUTINE UG_GETOPENBOUNDARY(TMPSTA,ZBIN,ZLIM) ! 9. Switches : ! ! 10. Source code : - USE W3GDATMD, ONLY: NX, NY, CCON, COUNTCON, IOBP + USE W3GDATMD, ONLY: NX, NY #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -933,13 +926,12 @@ SUBROUTINE SPATIAL_GRID #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3ODATMD, ONLY: NDSE IMPLICIT NONE ! !local parameters ! - REAL :: TL1, TL2, TL3, TMPTRIGP + REAL :: TMPTRIGP INTEGER :: I1, I2, I3 INTEGER :: K REAL*8 :: PT(3,2) @@ -1046,14 +1038,12 @@ SUBROUTINE NVECTRI ! !local parameter ! - INTEGER :: IP, IE - INTEGER :: I1, I2, I3, I11, I22, I33 + INTEGER :: IE + INTEGER :: I1, I2, I3 ! REAL*8 :: P1(2), P2(2), P3(2) REAL*8 :: R1(2), R2(2), R3(2) REAL*8 :: N1(2), N2(2), N3(2) - REAL*8 :: TMP(3) - REAL*8 :: TMPINV(3) REAL*8 :: PT(3,2) #ifdef W3_S INTEGER :: IENT = 0 @@ -1188,7 +1178,7 @@ SUBROUTINE COUNT(TRIGPTEMP) !/ local parameter INTEGER :: CONN(NX) - INTEGER :: COUNTER, IP, IE, I, J, N(3) + INTEGER :: IP, IE, I, J, N(3) #ifdef W3_S INTEGER :: IENT = 0 #endif @@ -1386,10 +1376,9 @@ SUBROUTINE AREA_SI(IMOD) !/ local parameters - INTEGER :: COUNTER,ifound,alreadyfound - INTEGER :: I, J, K, II - INTEGER :: IP, IE, POS, POS_I, POS_J, POS_K, IP_I, IP_J, IP_K - INTEGER :: I1, I2, I3, IP2, CHILF(NX) + INTEGER :: I, J, K + INTEGER :: IP, IE, POS, POS_J, POS_K, IP_I, IP_J, IP_K + INTEGER :: I1, I2, I3, CHILF(NX) INTEGER :: TMP(NX), CELLVERTEX(NX,COUNTRI,2) INTEGER :: COUNT_MAX DOUBLE PRECISION :: TRIA03 @@ -1696,7 +1685,6 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3ODATMD, ONLY: NDSE IMPLICIT NONE !/ ------------------------------------------------------------------- / @@ -1907,7 +1895,6 @@ SUBROUTINE IS_IN_UNGRID2(IMOD, XTIN, YTIN, FORCE, ITOUT, IS, JS, RW) #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif - USE W3ODATMD, ONLY: NDSE IMPLICIT NONE !/ ------------------------------------------------------------------- / @@ -1921,7 +1908,7 @@ SUBROUTINE IS_IN_UNGRID2(IMOD, XTIN, YTIN, FORCE, ITOUT, IS, JS, RW) !/ ------------------------------------------------------------------- / !local parameters - DOUBLE PRECISION :: x1, x2, x3, D1, D2, D3, DISTMIN, DDMIN + DOUBLE PRECISION :: x1, x2, x3, D1, D2, D3 DOUBLE PRECISION :: s1, s2, s3, sg1, sg2, sg3, smin, ssum DOUBLE PRECISION :: y1, y2, y3 INTEGER :: ITRI, ITRIS @@ -2083,8 +2070,7 @@ SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) ! 10. Source code : USE CONSTANTS USE W3GDATMD, ONLY : TRIGP, NTRI, NX, NSEA, MAPFS, CLATIS, & - MAPSTA, ANGLE, FLAGLL, IOBP, IEN, TRIA, NSEAL, NTRI - USE W3ADATMD, ONLY : NSEALM + FLAGLL, IEN, TRIA, NSEAL, NTRI #ifdef W3_PDLIB USE yowElementpool use yowNodepool, only: PDLIB_IEN, PDLIB_TRIA, NPA @@ -2099,15 +2085,18 @@ SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) ! local parameters - INTEGER :: VERTICES(3), NI(3), NI_GL(3) - REAL :: TMP1(3), TMP2(3) - INTEGER :: I, IX, IE, IE_GL + INTEGER :: NI(3) + INTEGER :: IE REAL :: VAR(3), FACT, LATMEAN - REAL :: DIFFXTMP, DIFFYTMP REAL :: DEDX(3), DEDY(3) REAL :: DVDXIE, DVDYIE - REAL :: WEI(NX), WEI_LOCAL(NSEAL) - REAL*8 :: RTMP(NSEAL) + REAL :: WEI(NX) + +#ifdef W3_PDLIB + INTEGER :: NI_GL(3) + INTEGER :: IE_GL + REAL :: WEI_LOCAL(NSEAL) +#endif DIFFX = 0. DIFFY = 0. @@ -2228,10 +2217,14 @@ SUBROUTINE W3NESTUG(DISTMIN,FLOK) !/ ------------------------------------------------------------------- / #ifdef W3_S USE W3SERVMD, ONLY: STRACE +#endif + ! +#ifdef W3_T + USE W3GDATMD, ONLY: MAPSF #endif ! USE W3ODATMD, ONLY: NBI, NDSE, ISBPI, XBPI, YBPI - USE W3GDATMD, ONLY: NX, XGRD, YGRD, MAPSTA, MAPFS, MAPSF + USE W3GDATMD, ONLY: NX, XGRD, YGRD, MAPSTA, MAPFS REAL, INTENT(IN) :: DISTMIN @@ -2371,8 +2364,6 @@ SUBROUTINE SET_IOBP (MASK, STATUS) ! ! USE W3GDATMD, ONLY: NX, NTRI, TRIGP - USE W3ODATMD, ONLY: IAPROC - IMPLICIT NONE @@ -2387,7 +2378,6 @@ SUBROUTINE SET_IOBP (MASK, STATUS) INTEGER :: ISFINISHED !, INEXT, IPREV INTEGER :: INEXT(3), IPREV(3) INTEGER :: ZNEXT, IP, I, IE, IPNEXT, IPPREV, COUNT - integer nb0, nb1, nbM1 STATUS = -1 INEXT=(/ 2, 3, 1 /) !IPREV=1+MOD(I+1,3) IPREV=(/ 3, 1, 2 /) !INEXT=1+MOD(I,3) @@ -2872,19 +2862,13 @@ SUBROUTINE SET_UG_IOBP() USE CONSTANTS ! ! - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPFS, & - NK, NTH, DTH, XFR, MAPSTA, COUNTRI, & - ECOS, ESIN, IEN, NTRI, TRIGP, & - IOBP,IOBPD, IOBPA, & + USE W3GDATMD, ONLY: NX, NTH, MAPSTA, ECOS, ESIN, IEN, & + NTRI, TRIGP, IOBP,IOBPD, IOBPA + #ifdef W3_REF1 - REFPARS, REFLC, REFLD, & + USE W3GDATMD, ONLY: REFPARS, REFLC, REFLD, MAPFS, DTH #endif - ANGLE0, ANGLE - USE W3ODATMD, ONLY: TBPI0, TBPIN, FLBPI - USE W3ADATMD, ONLY: CG, CX, CY, ATRNX, ATRNY, ITIME, CFLXYMAX - USE W3IDATMD, ONLY: FLCUR - USE W3ODATMD, only : IAPROC #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -2897,9 +2881,7 @@ SUBROUTINE SET_UG_IOBP() !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: ITH, IX, I, J, IP, IE, NDIRSUM - REAL (KIND = 8) :: COSSUM, SINSUM - REAL (KIND = 8) :: DIRMIN, DIRMAX, SHIFT, TEMPO, DIRCOAST + INTEGER :: ITH, I, IP, IE REAL (KIND = 8) :: X1, X2, Y1, Y2, DXP1, DXP2, DXP3 REAL (KIND = 8) :: DYP1, DYP2, DYP3, eDet1, eDet2, EVX, EVY REAL(KIND=8), PARAMETER :: THR = TINY(1.) @@ -2909,6 +2891,11 @@ SUBROUTINE SET_UG_IOBP() #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif + +#ifdef W3_REF1 + INTEGER :: NDIRSUM + REAL (KIND = 8) :: COSSUM, SINSUM, DIRCOAST +#endif !/ ------------------------------------------------------------------- / ! ! 1. Preparations --------------------------------------------------- * @@ -3091,7 +3078,6 @@ SUBROUTINE FIX_PERIODCITY(I1,I2,I3,XGRD,YGRD,PT) ! ! Local variables. ! ---------------------------------------------------------------- - INTEGER :: I INTEGER :: R1GT180, R2GT180, R3GT180 ! ---------------------------------------------------------------- ! From f3c317351e7bd5686d388166e70cce41e099edb4 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 23 Jan 2026 09:16:57 -0500 Subject: [PATCH 125/136] Address compiler remarks in modules w3iorsmd, w3initmd, w3iobcmd, w3partmd, w3iosfmd, and w3iotrmd (#1557) --- model/src/w3initmd.F90 | 47 ++++++++++++++++++++++-------------------- model/src/w3iobcmd.F90 | 8 +++---- model/src/w3iorsmd.F90 | 15 +++++++++----- model/src/w3iosfmd.F90 | 13 ++++++------ model/src/w3iotrmd.F90 | 7 ++++--- model/src/w3partmd.F90 | 11 +++++----- 6 files changed, 55 insertions(+), 46 deletions(-) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index bdfa168132..629d392b49 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -388,23 +388,25 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, USE W3TIMEMD, ONLY: DSEC21, TICK21, STME21 USE W3ARRYMD, ONLY: PRTBLK !/ - USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, MAPSTA, MAPST2, MAPFS, & - MAPSF, FLAGLL, & - ICLOSE, ZB, TRNX, TRNY, DMIN, DTCFL, DTMAX, & + USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, MAPSTA, MAPST2, & + MAPSF, FLAGLL, ZB, DMIN, DTCFL, DTMAX, & FLCK, NK, NTH, NSPEC, SIG, GNAME #ifdef W3_PDLIB USE W3GDATMD, ONLY : FLCTH, B_JGS_BLOCK_GAUSS_SEIDEL, B_JGS_USE_JACOBI #endif - USE W3WDATMD, ONLY: TIME, TLEV, TICE, TRHO, WLV, UST, USTDIR, VA + USE W3WDATMD, ONLY: TIME, TLEV, TICE, TRHO, WLV, VA USE W3ODATMD, ONLY: NDSO, NDSE, NDST, SCREEN, NDS, NTPROC, & - NAPROC, IAPROC, NAPLOG, NAPOUT, NAPERR, & + NAPROC, IAPROC, NAPLOG, NAPERR, & NAPFLD, NAPPNT, NAPTRK, NAPRST, NAPBPT, & NAPPRT, TOFRST, DTOUT, TONEXT, TOLAST, & FLOUT, FLOGRD, FLBPO, NOPTS, PTNME, & - PTLOC, IPTINT, PTIFAC, UNDEF, IDOUT, FLBPI, & + PTLOC, UNDEF, IDOUT, & OUTPTS, FNMPRE, IX0, IXN, IXS, IY0, IYN, & IYS, FLFORM, IOSTYP, UNIPTS, UPPROC, NOTYPE,& FLOGR2, NOGRP, NGRPP, FLOGD, FLOG2 +#ifdef W3_T + USE W3ODATMD, ONLY: NAPOUT +#endif #ifdef W3_NL5 USE W3ODATMD, ONLY: TOSNL5 #endif @@ -427,6 +429,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, ONLY : PDLIB_MAPSTA_INIT, SET_IOBDP_PDLIB, PDLIB_IOBP_INIT, SET_IOBPA_PDLIB USE PDLIB_W3PROFSMD, ONLY : BLOCK_SOLVER_INIT, BLOCK_SOLVER_EXPLICIT_INIT, PDLIB_INIT, DEALLOCATE_PDLIB_GLOBAL + USE W3GDATMD, ONLY : FSREFRACTION, FSFREQSHIFT use yowDatapool, only: istatus #endif #ifdef W3_SETUP @@ -435,8 +438,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, USE W3GDATMD, ONLY : DO_CHANGE_WLV #endif USE W3TRIAMD, ONLY: NVECTRI, AREA_SI, COORDMAX, SPATIAL_GRID - USE W3GDATMD, ONLY: FSN,FSPSI,FSFCT,FSNIMP, FSTOTALIMP, FSTOTALEXP, XGRD, YGRD - USE W3GDATMD, ONLY: FSREFRACTION, FSFREQSHIFT + USE W3GDATMD, ONLY: FSTOTALIMP, FSTOTALEXP USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC, INIT_GET_ISEA #ifdef W3_TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME @@ -478,11 +480,10 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, !/ ------------------------------------------------------------------- / !/ Local parameters !/ - integer :: IRANK, I, ISTAT INTEGER :: IE, IFL, IFT, IERR, NTTOT, NTLOC, & - NTTARG, IK, IP, ITH, IX, IY, & + NTTARG, IK, IP, IX, IY, & J, J0, TOUT(2), TLST(2), ISEA, IS, & - K, I1, I2, JSEA, NTTMAX + K, JSEA, NTTMAX #ifdef W3_DIST INTEGER :: ISTEP, ISP, IW #endif @@ -494,7 +495,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_T - INTEGER :: NX0, NXN + INTEGER :: NX0, NXN, ITH INTEGER, ALLOCATABLE :: MAPOUT(:,:) #endif #ifdef W3_MPI @@ -513,7 +514,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, LOGICAL :: OPENED CHARACTER(LEN=8) :: STTIME CHARACTER(LEN=10) :: STDATE - INTEGER :: ISPROC #ifdef W3_DIST CHARACTER(LEN=12) :: FORMAT #endif @@ -1771,10 +1771,12 @@ SUBROUTINE W3MPII ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif ! - USE W3GDATMD, ONLY: NSEA USE W3ADATMD, ONLY: NSEALM - USE W3GDATMD, ONLY: GTYPE, UNGTYPE + USE W3GDATMD, ONLY: UNGTYPE +#ifdef W3_DIST USE CONSTANTS, ONLY: LPDLIB +#endif + !/ #ifdef W3_MPI USE W3GDATMD, ONLY: NSPEC USE W3WDATMD, ONLY: VA @@ -1783,8 +1785,12 @@ SUBROUTINE W3MPII ( IMOD ) NRQSG1, IRQSG1, NRQSG2, IRQSG2, & GSTORE, SSTORE, MPIBUF, BSTAT, & BISPL, ISPLOC, IBFLOC, NSPLOC + USE W3ODATMD, ONLY: IAPROC +#endif + USE W3ODATMD, ONLY: NAPROC +#ifdef W3_MPIT + USE W3ODATMD, ONLY: NDST #endif - USE W3ODATMD, ONLY: NDST, NAPROC, IAPROC !/ #ifdef W3_MPI use mpi_f08 @@ -2115,12 +2121,10 @@ SUBROUTINE W3MPIO ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3GDATMD, ONLY: NSEA - USE W3ADATMD, ONLY: NSEALM #ifdef W3_MPI USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF, USSPF USE W3WDATMD, ONLY: VA, UST, USTDIR, ASF, FPIS, ICEF - USE W3ADATMD, ONLY: MPI_COMM_WAVE, WW3_FIELD_VEC + USE W3ADATMD, ONLY: MPI_COMM_WAVE, WW3_FIELD_VEC, NSEALM USE W3ADATMD, ONLY: HS, WLM, T02 #endif @@ -2158,9 +2162,9 @@ SUBROUTINE W3MPIO ( IMOD ) IT0PRT, NOSWLL, NOEXTR, NDSE, IOSTYP, & FLOGR2 USE W3PARALL, ONLY : INIT_GET_JSEA_ISPROC -#endif - USE W3GDATMD, ONLY: GTYPE, UNGTYPE USE CONSTANTS, ONLY: LPDLIB +#endif + USE W3GDATMD, ONLY: UNGTYPE !/ #ifdef W3_MPI use mpi_f08 @@ -5472,7 +5476,6 @@ SUBROUTINE W3MPIP ( IMOD ) IERR, ITARG, IX(4), IY(4), & K, IS(4), IP(4) #endif - INTEGER :: itout #ifdef W3_S INTEGER, SAVE :: IENT #endif diff --git a/model/src/w3iobcmd.F90 b/model/src/w3iobcmd.F90 index 9dd3c9e3db..aa88d7fe05 100644 --- a/model/src/w3iobcmd.F90 +++ b/model/src/w3iobcmd.F90 @@ -216,8 +216,8 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) USE W3CSPCMD, ONLY: W3CSPC USE W3TRIAMD, ONLY: W3NESTUG ! - USE W3GDATMD, ONLY: NK, NTH, NSPEC, NSEA, NSEAL, NX, NY, & - X0, Y0, SX, SY, GSU, MAPSTA, MAPFS, MAPSF, & + USE W3GDATMD, ONLY: NK, NTH, NSPEC, NSEA, & + GSU, MAPSTA, MAPFS, MAPSF, & XFR, FR1, SIG2, TH, DTH, FILEXT, FACHFE, & GTYPE, UNGTYPE, SMCTYPE USE W3GDATMD, ONLY: DXYMAX @@ -226,12 +226,12 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) #endif #ifdef W3_RTD !! Use rotated N-Pole lat/lon and conversion sub. JGLi12Jun2012 - USE W3GDATMD, ONLY: PoLat, PoLon, AnglD + USE W3GDATMD, ONLY: PoLat, PoLon, AnglD, NX, NY, X0, Y0, SX, SY USE W3SERVMD, ONLY: W3LLTOEQ, W3EQTOLL, W3ACTURN #endif USE W3WDATMD, ONLY: VA USE W3ADATMD, ONLY: CG - USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPROC, NAPERR, NAPBPT, & + USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, NAPBPT, & NBI, NBI2, NFBPO, NBO, NBO2, NDSL, & NKI, NTHI, XFRI, FR1I, TH1I, & IPBPI, ISBPI, XBPI, YBPI, RDBPI, & diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 37a6988a9b..fad2b98ec2 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -312,8 +312,12 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3IDATMD, ONLY: WXNwrst, WYNwrst #endif USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPROC, NAPERR, NAPRST, & - IFILE => IFILE4, FNMPRE, FNMRST, NTPROC, IOSTYP, & + IFILE => IFILE4, FNMPRE, FNMRST, IOSTYP, & FLOGRR, NOGRP, NGRPP, SCREEN +#ifdef W3_T + USE W3ODATMD, ONLY: NTPROC +#endif + !/ #ifdef W3_MPI USE W3ODATMD, ONLY: NRQRS, NBLKRS, RSBLKS, IRQRS, IRQRSS, & VAAUX @@ -324,7 +328,6 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3SERVMD, ONLY: EXTCDE, EXTIOF USE CONSTANTS, only: LPDLIB, file_endian USE W3PARALL, ONLY: INIT_GET_ISEA, INIT_GET_JSEA_ISPROC - USE W3GDATMD, ONLY: NK, NTH #ifdef W3_TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME #endif @@ -355,15 +358,17 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ! INTEGER :: IGRD, I, J, LRECL, NSIZE, IERR, & NSEAT, MSPEC, TTIME(2), ISEA, JSEA, & - NREC, NPART, IPART, IX, IY, IXL, IP, & - NPRTX2, NPRTY2, IYL, ITMP + NREC, NPART, IPART, IY, IXL, NPRTX2, NPRTY2, ITMP INTEGER, ALLOCATABLE :: MAPTMP(:,:) +#ifdef W3_WRST + INTEGER :: IX, IYL +#endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_MPI INTEGER :: IERR_MPI, IH, IB, ISEA0, ISEAN, & - NRQ, NSEAL_MIN + NRQ, NSEAL_MIN, IP #endif INTEGER(KIND=8) :: RPOS #ifdef W3_MPI diff --git a/model/src/w3iosfmd.F90 b/model/src/w3iosfmd.F90 index 42f7cfa74d..e3cdc9bf43 100644 --- a/model/src/w3iosfmd.F90 +++ b/model/src/w3iosfmd.F90 @@ -174,10 +174,9 @@ SUBROUTINE W3CPRT ( IMOD ) USE W3SERVMD, ONLY: STRACE #endif ! - USE W3GDATMD, ONLY: NSEA, NSEAL, MAPSF, MAPSTA, NK, NTH, SIG + USE W3GDATMD, ONLY: NSEAL, MAPSF, MAPSTA, NK, NTH, SIG USE W3ADATMD, ONLY: WN, CG, U10, U10D, DW - USE W3ODATMD, ONLY: IAPROC, NAPROC, OUTPTS, O6INIT, & - ICPRT, DTPRT, DIMP, PTMETH + USE W3ODATMD, ONLY: OUTPTS, O6INIT, ICPRT, DTPRT, DIMP, PTMETH USE W3WDATMD, ONLY: VA, ASF USE W3ADATMD, ONLY: NSEALM USE W3PARALL, ONLY: INIT_GET_ISEA, INIT_GET_JSEA_ISPROC @@ -438,8 +437,8 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) USE W3GDATMD, ONLY: NSEAL #endif USE W3WDATMD, ONLY: TIME, ASF - USE W3ODATMD, ONLY: NDSE, IAPROC, NAPROC, NAPPRT, NAPERR, & - IPASS => IPASS6, FLFORM, FNMPRE, OUTPTS, & + USE W3ODATMD, ONLY: NDSE, IAPROC, NAPROC, NAPPRT, & + IPASS => IPASS6, FLFORM, FNMPRE, OUTPTS, & IX0, IXN, IXS, IY0, IYN, IYS, DIMP USE W3ADATMD, ONLY: DW, U10, U10D, CX, CY USE W3ADATMD, ONLY: NSEALM @@ -467,7 +466,7 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) !/ Local parameters !/ INTEGER :: I, J, IERR, ISEA, JSEA, JAPROC, & - IX, IY, IP, IOFF, DTSIZ=0 + IX, IY, IP, IOFF, DTSIZ #ifdef W3_MPI INTEGER :: ICSIZ, IERR_MPI, IT, JSLM type(MPI_STATUS) :: STATUS @@ -501,6 +500,8 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) #ifdef W3_T WRITE (NDST,9000) IPASS, FLFORM, NDSPT, IMOD, IAPROC, NAPPRT #endif + + DTSIZ=0 ! ! -------------------------------------------------------------------- / ! 1. Set up file ( IPASS = 1 and proper processor ) diff --git a/model/src/w3iotrmd.F90 b/model/src/w3iotrmd.F90 index c828d6f3dd..c69a68ce96 100644 --- a/model/src/w3iotrmd.F90 +++ b/model/src/w3iotrmd.F90 @@ -221,8 +221,8 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) USE W3ADATMD, ONLY: W3SETA USE W3ODATMD, ONLY: W3SETO, W3DMO3 !/ - USE W3GDATMD, ONLY: NK, NTH, NSPEC, NSEA, NSEAL, NX, NY, & - FLAGLL, ICLOSE, XGRD, YGRD, GSU, & + USE W3GDATMD, ONLY: NK, NTH, NSEAL, NX, NY, & + FLAGLL, XGRD, YGRD, GSU, & DPDX, DPDY, DQDX, DQDY, MAPSTA, MAPST2, & MAPFS, TH, DTH, SIG, DSIP, XFR, FILEXT USE W3GSRUMD, ONLY: W3GFCL @@ -234,8 +234,9 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) USE W3ADATMD, ONLY: CG, DW, CX, CY, UA, UD, AS #ifdef W3_MPI USE W3ADATMD, ONLY: MPI_COMM_WAVE + USE W3GDATMD, ONLY: NSPEC #endif - USE W3ODATMD, ONLY: NDST, NDSE, IAPROC, NAPROC, NAPTRK, NAPERR, & + USE W3ODATMD, ONLY: NDST, NDSE, IAPROC, NAPTRK, NAPERR, & IPASS => IPASS3, ATOLAST => TOLAST, & ADTOUT => DTOUT, O3INIT, STOP, MASK1, & MASK2, TRCKID, FNMPRE diff --git a/model/src/w3partmd.F90 b/model/src/w3partmd.F90 index 64e032c52e..0f8cd4b95b 100644 --- a/model/src/w3partmd.F90 +++ b/model/src/w3partmd.F90 @@ -243,16 +243,15 @@ SUBROUTINE W3PART ( SPEC, UABS, UDIR, DEPTH, WN, NP, XP, DIMXP ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: ITH, IMI(NSPEC), IMD(NSPEC), & - IMO(NSPEC), IND(NSPEC), NP_MAX, & - IP, IT(1), INDEX(DIMXP), NWS, & + INTEGER :: ITH, IMI(NSPEC), & + IMO(NSPEC), IND(NSPEC), NP_MAX, & + IP, IT(1), INDEX(DIMXP), NWS, & IPW, IPT, ISP INTEGER :: PMAP(DIMXP) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - REAL :: ZP(NSPEC), ZMIN, ZMAX, Z(NSPEC), & - FACT, WSMAX, HSMAX + REAL :: ZP(NSPEC), ZMIN, ZMAX, Z(NSPEC), FACT REAL :: TP(DIMP,DIMXP) INTEGER :: IK, WIND_PART ! ChrisB; added for new REAL :: C, UPAR, SIGCUT ! UKMO partioning methods @@ -1233,7 +1232,7 @@ SUBROUTINE PTMEAN ( NPI, IMO, ZP, DEPTH, UABS, UDIR, WN, & ! USE W3GDATMD, ONLY: NK, NTH, NSPEC, DTH, SIG, DSII, DSIP, & ECOS, ESIN, XFR, FACHFE, TH, FTE - USE W3ODATMD, ONLY: IAPROC, NAPERR, NDSE, NDST + USE W3ODATMD, ONLY: IAPROC, NAPERR, NDSE ! IMPLICIT NONE !/ From f8cff114e7443a79b6518bd045149703883f8a69 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 26 Jan 2026 14:43:02 -0500 Subject: [PATCH 126/136] Remove compiler remarks in modules w3tidemd, w3updtmd, w3wavemd, and w3srcemd (#1558) --- model/src/w3srcemd.F90 | 72 ++++++++++++++++++++++----------- model/src/w3tidemd.F90 | 13 +++--- model/src/w3updtmd.F90 | 91 ++++++++++++++++++++++++++++-------------- model/src/w3wavemd.F90 | 79 ++++++++++++++++++++++-------------- 4 files changed, 163 insertions(+), 92 deletions(-) diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index f76569cfa4..020786987a 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -498,12 +498,19 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & 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, & + XFLT, XREL, FXFM, FXPM, DDEN, & + FHMAX, ECOS, ESIN, IICEDISP, & ICESCALES, IICESMOOTH USE W3GDATMD, ONLY: IC_NUMERICS +#if defined(W3_NL5) || defined(W3_NNT) USE W3WDATMD, ONLY: TIME - USE W3ODATMD, ONLY: NDSE, NDST, IAPROC +#endif +#if defined(W3_T) || defined(W3_ST1) || defined(W3_ST2) || defined(W3_ST3) || defined(W3_ST6) + USE W3ODATMD, ONLY: NDST +#endif +#if defined(W3_NNT) || defined(W3_PDLIB) || defined(W3_DEBUGSRC) + USE W3ODATMD, ONLY: IAPROC +#endif USE W3IDATMD, ONLY: INFLAGS2 USE W3DISPMD #ifdef W3_T @@ -513,7 +520,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & USE W3GDATMD, ONLY: IOBP, IOBPD, GTYPE, UNGTYPE, REFPARS #endif #ifdef W3_NNT - USE W3ODATMD, ONLY: IAPROC, SCREEN, FNMPRE + USE W3ODATMD, ONLY: SCREEN, FNMPRE #endif #ifdef W3_FLD1 USE W3FLD1MD, ONLY: W3FLD1 @@ -549,7 +556,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_ST2 USE W3SRC2MD - USE W3GDATMD, ONLY : ZWIND + USE W3GDATMD, ONLY : ZWIND, XFC, XFT #endif #ifdef W3_ST3 USE W3SRC3MD @@ -638,6 +645,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_NNT USE W3SERVMD, ONLY: EXTOPN, EXTIOF + USE W3ODATMD, ONLY: NDSE #endif #ifdef W3_UOST USE W3UOSTMD, ONLY: UOST_SRCTRMCOMPUTE @@ -684,39 +692,42 @@ 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, ISP + IKS1, IS1, NSPECH, IDT REAL :: DTTOT, FHIGH, DT, AFILT, DAMAX, AFAC, & - HDT, ZWND, FP, DEPTH, TAUSCX, TAUSCY, FHIGI + HDT, ZWND, 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 :: EMEAN, FMEAN, AMAX, CD, Z0 REAL :: WN_R(NK), CG_ICE(NK), ALPHA_LIU(NK), ICECOEF2, R(NK) - DOUBLE PRECISION :: ATT, ISO + DOUBLE PRECISION :: ATT REAL :: EBAND, DIFF, EFINISH, HSTOT, PHINL, & FMEAN1, FMEANWS, & 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) + REAL :: DAM (NSPEC), WN2(NSPEC), & VSLN(NSPEC), & VSIN(NSPEC), VDIN(NSPEC), & VSNL(NSPEC), VDNL(NSPEC), & VSDS(NSPEC), VDDS(NSPEC), & VSBT(NSPEC), VDBT(NSPEC) - REAL :: VS(NSPEC), VD(NSPEC), EB(NK) + REAL :: VS(NSPEC), VD(NSPEC) LOGICAL :: SHAVE LOGICAL :: LBREAK LOGICAL, SAVE :: FIRST = .TRUE. - LOGICAL :: PrintDeltaSmDA - REAL :: eInc1, eInc2, eVS, eVD, JAC - REAL :: DeltaSRC(NSPEC) + REAL :: eInc1, eInc2 - REAL :: FOUT(NK,NTH), SOUT(NK,NTH), DOUT(NK,NTH) REAL, SAVE :: TAUNUX, TAUNUY - LOGICAL, SAVE :: FLTEST = .FALSE., FLAGNN = .TRUE. + +#if defined(W3_OMPG) || defined(W3_T) || defined(W3_ST1) || defined(W3_ST2) || defined(W3_ST3) || defined(W3_ST6) + LOGICAL, SAVE :: FLTEST = .FALSE. +#endif + +#if defined(W3_OMPG) || defined(W3_NNT) + LOGICAL, SAVE :: FLAGNN = .TRUE. +#endif #ifdef W3_OMPG !$omp threadprivate( TAUNUX, TAUNUY) @@ -724,6 +735,13 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & !$omp threadprivate( FIRST ) #endif +#if defined(W3_PDLIB) || defined(W3_REF1) + INTEGER :: ISP +#endif + +#if defined(W3_ST0) || defined(W3_ST1) || defined(W3_ST2) || defined(W3_ST6) || defined(W3_FLX2) || defined(W3_FLX3) + REAL :: FP +#endif !/ !/ ------------------------------------------------------------------- / !/ Local parameters dependent on compile switch @@ -735,6 +753,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_NNT INTEGER, SAVE :: NDSD = 89, NDSD2 = 88, J REAL :: QCERR = 0. !/XNL2 and !/NNT + INTEGER :: IERR + REAL :: FOUT(NK,NTH), SOUT(NK,NTH), DOUT(NK,NTH) + LOGICAL, SAVE :: FLAGNN = .TRUE. #endif #ifdef W3_NL5 @@ -786,7 +807,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_IS2 REAL :: VDIR2(NSPEC) + REAL :: SCAT, SMOOTH_ICEDISP DOUBLE PRECISION :: SCATSPEC(NTH) + DOUBLE PRECISION :: ISO #endif #ifdef W3_UOST @@ -806,7 +829,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_ST4 - REAL :: FMEANS, FH1, FH2, FAGE, DLWMEAN + REAL :: FH1, FH2, FAGE, DLWMEAN REAL :: BRLAMBDA(NSPEC) #endif @@ -820,6 +843,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_PDLIB REAL :: PreVS, DVS, SIDT, FAKS, MAXDAC + LOGICAL :: PrintDeltaSmDA + REAL :: DeltaSRC(NSPEC), DAM2(NSPEC) + REAL :: FRLOCAL, JAC, JAC2, eVS, eVD #endif #ifdef W3_NNT @@ -2578,7 +2604,7 @@ SUBROUTINE SIGN_VSD_SEMI_IMPLICIT_WW3(SPEC, VS, VD) USE W3SERVMD, ONLY: STRACE #endif ! - USE W3GDATMD, only : NTH, NK, NSPEC + USE W3GDATMD, only : NSPEC IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / @@ -2594,7 +2620,7 @@ SUBROUTINE SIGN_VSD_SEMI_IMPLICIT_WW3(SPEC, VS, VD) !/ ------------------------------------------------------------------- / !/ - INTEGER :: ISP, ITH, IK, IS + INTEGER :: IS REAL, INTENT(IN) :: SPEC(NSPEC) REAL, INTENT(INOUT) :: VS(NSPEC), VD(NSPEC) #ifdef W3_S @@ -2667,7 +2693,7 @@ SUBROUTINE SIGN_VSD_PATANKAR_WW3(SPEC, VS, VD) #endif ! - USE W3GDATMD, only : NTH, NK, NSPEC + USE W3GDATMD, only : NSPEC IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / @@ -2682,7 +2708,7 @@ SUBROUTINE SIGN_VSD_PATANKAR_WW3(SPEC, VS, VD) !/ !/ ------------------------------------------------------------------- / !/ - INTEGER :: ISP, ITH, IK, IS + INTEGER :: IS REAL, INTENT(IN) :: SPEC(NSPEC) REAL, INTENT(INOUT) :: VS(NSPEC), VD(NSPEC) #ifdef W3_S diff --git a/model/src/w3tidemd.F90 b/model/src/w3tidemd.F90 index 22bbdc4534..9939168996 100644 --- a/model/src/w3tidemd.F90 +++ b/model/src/w3tidemd.F90 @@ -289,8 +289,8 @@ SUBROUTINE TIDE_FIND_INDICES_PREDICTION(LIST,INDS,TIDE_PRMF) ! ! 10. Source code : ! - USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT - USE W3ODATMD, ONLY: NDSE, NDSO + USE W3ODATMD, ONLY: IAPROC, NAPOUT + USE W3ODATMD, ONLY: NDSO #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -387,8 +387,8 @@ SUBROUTINE TIDE_FIND_INDICES_ANALYSIS(LIST) ! ! 10. Source code : ! - USE W3ODATMD, ONLY: IAPROC, NAPROC, NAPERR, NAPOUT - USE W3ODATMD, ONLY: NDSE, NDSO + USE W3ODATMD, ONLY: IAPROC, NAPOUT + USE W3ODATMD, ONLY: NDSO #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -401,7 +401,6 @@ SUBROUTINE TIDE_FIND_INDICES_ANALYSIS(LIST) !/ CHARACTER(LEN=100), INTENT(IN) :: LIST(70) ! - INTEGER TIDE_MF_ALL CHARACTER(LEN=5) :: TIDECON_NAME_ALL(65) ! array of names of tidal constituents REAL :: TIDE_FREQC_ALL(65) ! array of freq. of tidal constituents INTEGER :: INDS(65), J, FOUND, NTIDES @@ -2137,8 +2136,8 @@ subroutine flex_tidana_webpage(IX,IY,XLON,XLAT,KD1,KD2,ndef, itrend, RES, SSQ, R FX, FXI, S, S2, S3, UX, VX, UXI, VXI, & WMIN, WMAX, XMID REAL :: TOLER - REAL(KIND=8) :: AV, SDEV, SUM2, hrm - DOUBLE PRECISION :: X(NR),Y(NR), TIME(NR) + REAL(KIND=8) :: AV, SDEV, hrm + DOUBLE PRECISION :: X(NR),TIME(NR) REAL :: Q(NMAXPM,NMAXP1),FREQ(MC),AMP(MC),PH(MC) DOUBLE PRECISION :: P(NMAXP1),CENHR,CUMHR DOUBLE PRECISION :: yy diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index ca6e03fe53..d426349808 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -244,7 +244,7 @@ SUBROUTINE W3UCUR ( FLFRST ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF + USE W3GDATMD, ONLY: NSEA, MAPSF #ifdef W3_SMC USE W3GDATMD, ONLY: NARC, NGLO, ANGARC USE W3GDATMD, ONLY: FSWND, ARCTC @@ -573,7 +573,7 @@ SUBROUTINE W3UWND ( FLFRST, VGX, VGY ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF + USE W3GDATMD, ONLY: NSEA, MAPSF #ifdef W3_WCOR USE W3GDATMD, ONLY: WWCOR #endif @@ -586,10 +586,13 @@ SUBROUTINE W3UWND ( FLFRST, VGX, VGY ) #ifdef W3_SMC USE W3GDATMD, ONLY: NARC, NGLO, ANGARC, ARCTC, FSWND #endif - USE W3WDATMD, ONLY: TIME, ASF - USE W3ADATMD, ONLY: DW, CX, CY, UA, UD, U10, U10D, AS, & + USE W3WDATMD, ONLY: TIME + USE W3ADATMD, ONLY: CX, CY, UA, UD, U10, U10D, AS, & UA0, UAI, UD0, UDI, AS0, ASI USE W3IDATMD, ONLY: TW0, WX0, WY0, DT0, TWN, WXN, WYN, DTN, FLCUR +#ifdef W3_STAB2 + USE W3WDATMD, ONLY: ASF +#endif !/ IMPLICIT NONE !/ @@ -605,15 +608,19 @@ SUBROUTINE W3UWND ( FLFRST, VGX, VGY ) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - REAL :: D0, DN, DD, DT0N, DT0T, RD, UI2, & - UXR, UYR + REAL :: D0, DN, DD, DT0N, DT0T, RD, UXR, UYR +#if defined(W3_OMPG) || defined(W3_WNT2) + REAL :: UI2 +#endif #ifdef W3_WNT2 REAL :: RD2 #endif #ifdef W3_STAB2 REAL :: STAB0, STAB, THARG1, THARG2, COR1, COR2 #endif +#if defined(W3_OMPG) || defined(W3_SMC) REAL :: UDARC +#endif !/ !/ ------------------------------------------------------------------- / !/ @@ -916,12 +923,19 @@ SUBROUTINE W3UTAU ( FLFRST ) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - REAL :: D0, DN, DD, DT0N, DT0T, RD, MI2, & - MXR, MYR + REAL :: D0, DN, DD, DT0N, DT0T, RD +#ifdef W3_OMPG + REAL :: MXR, MYR +#endif +#if defined(W3_OMPG) || defined(W3_WNT2) + REAL :: MI2 +#endif #ifdef W3_WNT2 REAL :: RD2 #endif +#if defined(W3_OMPG) || defined(W3_SMC) REAL :: MDARC +#endif !/ !/ ------------------------------------------------------------------- / !/ @@ -1120,8 +1134,8 @@ SUBROUTINE W3UINI ( A ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, MAPSF, & - NK, NTH, TH, SIG, DTH, DSIP, UNGTYPE, & + USE W3GDATMD, ONLY : NSEAL, MAPSF, & + NK, NTH, TH, SIG, DTH, UNGTYPE, & RLGTYPE, CLGTYPE, GTYPE, FLAGLL, & HPFAC, HQFAC, FETCH USE W3ADATMD, ONLY: U10, U10D, CG @@ -1129,6 +1143,7 @@ SUBROUTINE W3UINI ( A ) USE W3PARALL, only : GET_JSEA_IBELONG #ifdef W3_T USE W3ARRYMD, ONLY : PRTBLK + USE W3GDATMD, ONLY : NX, NY, NSEA, DSIP #endif ! IMPLICIT NONE @@ -1141,23 +1156,21 @@ SUBROUTINE W3UINI ( A ) !/ ------------------------------------------------------------------- / !/ Local variables !/ - INTEGER :: IX, IY, ISEA, JSEA, IK, ITH, ISPROC + INTEGER :: IX, IY, ISEA, JSEA, IK, ITH #ifdef W3_S INTEGER, SAVE :: IENT = 0 -#endif -#ifdef W3_T - INTEGER :: IX0, IXN, MAPOUT(NX,NY) - INTEGER :: NXP = 60 #endif REAL :: ALFA(NSEAL), FP(NSEAL), YLN(NSEAL), & AA, BB, CC REAL :: XGR, U10C, U10DIR, XSTAR, FSTAR, & GAMMA, FR, D1(NTH), D1INT, F1, F2 - REAL :: ETOT, E1I REAL :: U10MIN = 1. REAL :: U10MAX = 20. #ifdef W3_T + INTEGER :: IX0, IXN, MAPOUT(NX,NY) + INTEGER :: NXP = 60 REAL :: HSIG(NX,NY) + REAL :: ETOT, E1I #endif !/ !/ ------------------------------------------------------------------- / @@ -1381,11 +1394,14 @@ SUBROUTINE W3UBPT ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NSPEC, MAPWN, SIG2, DDEN + USE W3GDATMD, ONLY: NSPEC, MAPWN, SIG2 #ifdef W3_RTD !! Use rotation angle and action conversion sub. JGLi12Jun2012 USE W3GDATMD, ONLY: NK, NTH, NSPEC, AnglD, PoLat USE W3SERVMD, ONLY: W3ACTURN +#endif +#ifdef W3_T0 + USE W3GDATMD, ONLY: DDEN #endif USE W3ADATMD, ONLY: CG USE W3ODATMD, ONLY: NBI, ABPI0, ABPIN, ISBPI, IPBPI, RDBPI, & @@ -1570,8 +1586,12 @@ SUBROUTINE W3UIC1( FLFRST ) ! !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NSEA, NSEA, MAPSF, IICEHMIN, IICEHFAC - USE W3WDATMD, ONLY: TIME, TIC1, ICEH - USE W3IDATMD, ONLY: TI1, ICEP1, FLIC1 + USE W3WDATMD, ONLY: TIC1, ICEH + USE W3IDATMD, ONLY: TI1, ICEP1 + +#ifdef W3_T + USE W3WDATMD, ONLY: TIME +#endif !/ IMPLICIT NONE !/ @@ -1683,7 +1703,11 @@ SUBROUTINE W3UIC5( FLFRST ) !/ ------------------------------------------------------------------- / USE W3IDATMD, ONLY: TI5, ICEP5 USE W3GDATMD, ONLY: NSEA, MAPSF - USE W3WDATMD, ONLY: TIME, TIC5, ICE, ICEH, ICEF, ICEDMAX + USE W3WDATMD, ONLY: TIC5, ICE, ICEH, ICEF, ICEDMAX + +#ifdef W3_T + USE W3WDATMD, ONLY: TIME +#endif !/ IMPLICIT NONE !/ @@ -1835,8 +1859,11 @@ SUBROUTINE W3UICE ( VA ) !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, MAPSTA, MAPST2, & NSPEC, FICEN - USE W3WDATMD, ONLY: TIME, TICE, ICE, BERG, UST + USE W3WDATMD, ONLY: TICE, ICE, BERG, UST USE W3ADATMD, ONLY: NSEALM, CHARN +#ifdef W3_T + USE W3WDATMD, ONLY: TIME +#endif #if defined W3_ST3 || defined(W3_ST4) USE W3GDATMD, ONLY: AALPHA #endif @@ -2101,9 +2128,9 @@ SUBROUTINE W3ULEV ( A, VA ) !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, MAPSF, MAPSTA, MAPST2, & ZB, DMIN, NK, NTH, NSPEC, SIG, DSIP, & - MAPWN, MAPTH, FACHFA, GTYPE, UNGTYPE, W3SETREF - USE W3WDATMD, ONLY: TIME, TLEV, WLV, UST - USE W3ADATMD, ONLY: CG, WN, DW, HS + MAPWN, FACHFA, GTYPE, UNGTYPE, W3SETREF + USE W3WDATMD, ONLY: TLEV, WLV, UST + USE W3ADATMD, ONLY: CG, WN, DW USE W3IDATMD, ONLY: TLN, WLEV USE W3SERVMD, ONLY: EXTCDE USE W3DISPMD, ONLY: WAVNU1 @@ -2127,6 +2154,11 @@ SUBROUTINE W3ULEV ( A, VA ) #ifdef W3_T3 USE W3ARRYMD, ONLY: PRT2DS + USE W3GDATMD, ONLY: MAPTH +#endif + +#if defined(W3_T) || defined(W3_TIDE) + USE W3WDATMD, ONLY: TIME #endif !/ IMPLICIT NONE @@ -2143,7 +2175,7 @@ SUBROUTINE W3ULEV ( A, VA ) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - INTEGER :: MAPDRY(NY,NX), ISPROC + INTEGER :: MAPDRY(NY,NX) REAL :: DWO(NSEA), KDCHCK, WNO(0:NK+1), & CGO(0:NK+1), DEPTH, & RDK, RD1, RD2, TA(NTH,NK), & @@ -2628,10 +2660,9 @@ SUBROUTINE W3URHO ( FLFRST ) #ifdef W3_SMC USE W3GDATMD, ONLY: FSWND #endif - USE W3WDATMD, ONLY: TIME, TRHO, RHOAIR + USE W3WDATMD, ONLY: TIME, RHOAIR USE W3IDATMD, ONLY: TR0, TRN, RH0, RHN USE W3ADATMD, ONLY: RA0, RAI - USE W3ODATMD, ONLY: IAPROC, NAPROC !/ IMPLICIT NONE !/ @@ -2808,8 +2839,7 @@ SUBROUTINE W3UTRN ( TRNX, TRNY ) ! !/ ------------------------------------------------------------------- / USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSTA, MAPSF, & - TRFLAG, FICE0, FICEN, FICEL, & - RLGTYPE, CLGTYPE, GTYPE, FLAGLL, & + TRFLAG, FICE0, FICEN, FICEL, RLGTYPE, CLGTYPE, FLAGLL, & HPFAC, HQFAC, FFACBERG USE W3WDATMD, ONLY: ICE, BERG USE W3ADATMD, ONLY: ATRNX, ATRNY @@ -3227,7 +3257,6 @@ SUBROUTINE W3DZXY( ZZ, ZUNIT, DZZDX, DZZDY ) USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSTA, MAPFS, MAPFS, & DPDX, DPDY, DQDX, DQDY, FLAGLL, ICLOSE, & ICLOSE_NONE, ICLOSE_SMPL, ICLOSE_TRPL - USE W3ODATMD, ONLY: NDSE, IAPROC, NAPERR, NAPROC USE W3SERVMD, ONLY: EXTCDE #ifdef W3_T USE W3ARRYMD, ONLY : PRTBLK @@ -3244,7 +3273,7 @@ SUBROUTINE W3DZXY( ZZ, ZUNIT, DZZDX, DZZDY ) REAL, INTENT(IN) :: ZZ(NSEA) CHARACTER, INTENT(IN) :: ZUNIT*(*) REAL, INTENT(OUT) :: DZZDX(NY,NX), DZZDY(NY,NX) - INTEGER :: ISEA, IX, IY, IXP, IXM, IYP, IYM + INTEGER :: IX, IY, IXP, IXM, IYP, IYM #ifdef W3_T INTEGER :: ISX, ISY, MAPOUT(NX,NY) #endif diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 6d1ba15cdf..5dc6eb0733 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -409,13 +409,13 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USE CONSTANTS, ONLY : UNDEF, RADIUS, DERA, DAIR, SRCE_DIRECT, LPDLIB, & SRCE_IMP_POST, SRCE_IMP_PRE, TPIINV !/ - USE W3GDATMD, ONLY : IGRID, NSEAL, NSPEC, NX, NY, NK, NSEA, & - GTYPE, UNGTYPE, SMCTYPE, RSTYPE, FILEXT, & + USE W3GDATMD, ONLY : IGRID, NSEAL, NSPEC, NX, NY, NK, & + GTYPE, UNGTYPE, SMCTYPE, RSTYPE, & MAPSF, MAPFS, MAPSTA, IOBP, CTHG0S, & FLCTH, FSREFRACTION, FLCK, FSFREQSHIFT, FLAGLL, & FLDRY, FSTOTALIMP, FLCX, FLCY, FLSOU, FLAGST, & SIG, CLATS, TRNX, TRNY, DTMAX, DTCFLI, DTH, & - DMIN, W3SETG, MAPST2 + DMIN, W3SETG !/ USE W3WDATMD, ONLY : UST, IWDATA, TIME, TLEV, TICE, TIC1, VA, ASF, & RHOAIR, USTDIR, ICE, ICEH, ICEF, ICEDMAX, BERG, & @@ -431,8 +431,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & PHIOC, TWS, PHICE, CHARN, W3SETA, ITSTEP !/ USE W3IDATMD, ONLY : IIDATA, INFLAGS1, FLLEV, FLCUR, FLWIND, FLICE, & - FLTAUA, FLRHOA, FLIC1, FLIC2, FLIC3, FLIC4, & - FLIC5, TLN, TC0, TCN, TW0, TWN, TIN, TU0, TUN, & + FLTAUA, FLRHOA, FLIC1, & + TLN, TC0, TCN, TW0, TWN, TIN, TU0, TUN, & TI1, TGN, TG0, GA0, GAN, GD0, GDN, TDN, TRN, & TR0, W3SETI !/ @@ -440,7 +440,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & NDS, NOGE, NAPLOG, NAPOUT, NDSO, NDSE, NDST, & NAPROC, NAPERR, SCREEN, IAPROC, IOUTP, NOTYPE, & NAPBPT, TOFRST, TONEXT, TBPIN, TBPI0, TOLAST, & - DTOUT, NAPFLD, NAPPNT, W3SETO, FNMRST + DTOUT, NAPFLD, NAPPNT, W3SETO !/ USE W3UPDTMD, ONLY : W3DZXY, W3UWND, W3UINI, W3UTAU, W3URHO, W3UBPT, & W3UICE, W3ULEV, W3UCUR, W3UIC1, W3UTRN @@ -519,11 +519,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_IC3 USE W3SIC3MD, ONLY : CALLEDIC3TABLE, IC3TABLE_CHENG, W3IC3WNCG_V1, W3IC3WNCG_CHENG USE W3GDATMD, ONLY : IC3PARS - USE W3IDATMD, ONLY : ICEP1, ICEP2, ICEP3, ICEP4 + USE W3IDATMD, ONLY : ICEP1, ICEP2, ICEP3, ICEP4, FLIC2, FLIC3, FLIC4 #endif #ifdef W3_IS2 USE W3WDATMD, ONLY : TIC5 - USE W3IDATMD, ONLY : TI5 + USE W3IDATMD, ONLY : TI5, FLIC5 USE W3UPDTMD, ONLY : W3UIC5 #endif #ifdef W3_UOST @@ -555,6 +555,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif #ifdef W3_TIMINGS USE W3PARALL, only : PRINT_MY_TIME +#endif +#ifdef W3_PIO + USE W3ODATMD, ONLY : FNMRST + USE W3GDATMD, ONLY : MAPST2 +#endif +#if defined(W3_T) || defined(W3_REFRX) + USE W3GDATMD, ONLY : NSEA +#endif +#if defined(W3_T) || defined(W3_SBS) + USE W3GDATMD, ONLY : FILEXT #endif ! #ifdef W3_MPI @@ -580,15 +590,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - INTEGER :: IP INTEGER :: TCALC(2), IT, IT0, NT, ITEST, & - ITLOC, ITLOCH, NTLOC, ISEA, JSEA, & - IX, IY, ISPEC, J, TOUT(2), TLST(2), & - REFLED(6), IK, ITH, IS, NKCFL - INTEGER :: ISP, IP_glob + ITLOC, ITLOCH, NTLOC, ISEA, JSEA, & + IX, IY, ISPEC, J, TOUT(2), TLST(2), & + REFLED(6), IK, NKCFL INTEGER :: TTEST(2),DTTEST - REAL :: ICEDAVE ! +#ifdef W3_DEBUGRUN + INTEGER :: IS + LOGICAL :: FLAG0 = .FALSE. +#endif #ifdef W3_MPI LOGICAL :: SBSED #endif @@ -604,13 +615,15 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif INTEGER :: IXrel REAL :: DTTST, DTTST1, DTTST2, DTTST3, & - DTL0, DTI0, DTR0, DTI10, DTI50, & - DTGA, DTG, DTGpre, DTRES, & - FAC, VGX, VGY, FACK, FACTH, & - FACX, XXX, REFLEC(4), & - DELX, DELY, DELA, DEPTH, D50, PSIC + DTL0, DTI0, DTI10, DTGA, DTG, DTRES, & + FAC, VGX, VGY, FACK, FACTH, & + FACX, XXX, REFLEC(4), & + DELX, DELY, DELA, DEPTH, D50, PSIC REAL :: VSioDummy(NSPEC), VDioDummy(NSPEC), VAoldDummy(NSPEC) LOGICAL :: SHAVETOTioDummy +#ifdef W3_IS2 + REAL :: DTI50 +#endif #ifdef W3_SEC1 REAL :: DTGTEMP #endif @@ -628,10 +641,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & ! REAL, ALLOCATABLE :: TAUWX(:), TAUWY(:) ! - LOGICAL :: FLACT, FLZERO, FLFRST, FLMAP, TSTAMP,& - SKIP_O, FLAG_O, FLDDIR, READBC, & - FLAG0 = .FALSE., FLOUTG, FLPFLD, & - FLPART, LOCAL, FLOUTG2 + LOGICAL :: FLACT, FLZERO, FLFRST, FLMAP, TSTAMP, & + SKIP_O, FLAG_O, FLDDIR, READBC, & + FLOUTG, FLPFLD, FLPART, LOCAL, FLOUTG2 ! #ifdef W3_MPI LOGICAL :: FLGMPI(0:8) @@ -645,11 +657,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CHARACTER(LEN=21) :: IDACT CHARACTER(LEN=16) :: OUTID CHARACTER(LEN=23) :: IDTIME - INTEGER eIOBP - INTEGER ITH_F #ifdef W3_PDLIB - REAL :: VS_SPEC(NSPEC) - REAL :: VD_SPEC(NSPEC) + REAL :: VS_SPEC(NSPEC), VD_SPEC(NSPEC) + REAL :: DTGpre + INTEGER :: IP #endif ! #ifdef W3_SBS @@ -3091,13 +3102,14 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3GDATMD, ONLY: NSPEC, NX, NY, NSEA, NSEAL, MAPSF, DMIN + USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF USE W3PARALL, ONLY: INIT_GET_ISEA USE W3WDATMD, ONLY: A => VA #ifdef W3_MPI USE W3ADATMD, ONLY: MPIBUF, BSTAT, IBFLOC, ISPLOC, BISPL, & NSPLOC, NRQSG2, IRQSG2, GSTORE USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NOTYPE + USE W3GDATMD, ONLY: NSEAL, NSPEC #endif !/ ! @@ -3399,7 +3411,7 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: NSEA, NSEAL, MAPSF, NSPEC, NX, NY + USE W3GDATMD, ONLY: NSEA, MAPSF, NX, NY #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -3408,12 +3420,14 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) #ifdef W3_MPI USE W3ADATMD, ONLY: MPIBUF, BSTAT, IBFLOC, ISPLOC, BISPL, & NSPLOC, NRQSG2, IRQSG2, SSTORE + USE W3GDATMD, ONLY: NSEAL, NSPEC #endif +#ifdef W3_MPIT USE W3ODATMD, ONLY: NDST +#endif #ifdef W3_MPI USE W3ODATMD, ONLY: IAPROC, NAPROC #endif - USE CONSTANTS, ONLY : LPDLIB USE W3PARALL, only: INIT_GET_ISEA !/ ! @@ -3699,8 +3713,11 @@ SUBROUTINE W3NMIN ( MAPSTA, FLAG0 ) #endif !/ USE W3GDATMD, ONLY: NSEA, MAPSF, NX, NY - USE W3ODATMD, ONLY: NDST, NAPROC + USE W3ODATMD, ONLY: NAPROC USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC +#ifdef W3_T + USE W3ODATMD, ONLY: NDST +#endif !/ !/ !/ ------------------------------------------------------------------- / From 777b73177e9f50e26764cdc83dce5985213a7303 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Mon, 2 Feb 2026 08:49:55 -0500 Subject: [PATCH 127/136] Silence compiler remarks in modules and programs w3wdasmd ww3_outf ww3_outp ww3_grib ww3_gint (#1561) --- model/src/w3wdasmd.F90 | 9 +++++---- model/src/ww3_gint.F90 | 11 +++-------- model/src/ww3_grib.F90 | 8 ++++---- model/src/ww3_outf.F90 | 12 +++++++----- model/src/ww3_outp.F90 | 37 ++++++++++++++++++++++--------------- 5 files changed, 41 insertions(+), 36 deletions(-) diff --git a/model/src/w3wdasmd.F90 b/model/src/w3wdasmd.F90 index e313f8087d..afab3ce617 100644 --- a/model/src/w3wdasmd.F90 +++ b/model/src/w3wdasmd.F90 @@ -194,12 +194,14 @@ SUBROUTINE W3WDAS ( DASFLAG, RECL, NDAT, DATA0, DATA1, DATA2 ) USE W3GDATMD USE W3WDATMD USE W3ADATMD - USE W3ODATMD, ONLY: NDSO, NDSE, NDST, SCREEN, NAPROC, IAPROC, & - NAPLOG, NAPOUT, NAPERR #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif ! +#ifdef W3_T + USE W3ODATMD, ONLY: NDSO, NDSE, NDST, SCREEN, NAPROC, IAPROC, NAPOUT, NAPERR +#endif + ! #ifdef W3_MPI use mpi_f08 #endif @@ -218,9 +220,8 @@ SUBROUTINE W3WDAS ( DASFLAG, RECL, NDAT, DATA0, DATA1, DATA2 ) !/ ------------------------------------------------------------------- / !/ Local parameters : !/ - INTEGER :: J #ifdef W3_T - INTEGER :: MREC, MDAT, IREC, IDAT + INTEGER :: MREC, MDAT, IREC, IDAT, J #endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index 6eeda59bf2..73d1929c14 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -115,13 +115,11 @@ PROGRAM W3GRID_INTERP USE W3IOGOMD, ONLY : W3IOGO USE W3ADATMD, ONLY : W3DIMA, W3NAUX, W3SETA USE W3GDATMD - USE W3ODATMD, ONLY : FNMPRE, NOGRP, NGRPP, OUTPTS, UNDEF, FLOGRD, & - NAPROC, NOSWLL, IDOUT + USE W3ODATMD, ONLY : FNMPRE, NOGRP, NGRPP, OUTPTS, UNDEF, FLOGRD, IDOUT USE W3ODATMD, ONLY : W3NOUT, W3SETO USE W3IDATMD USE W3WDATMD, ONLY : W3NDAT, W3DIMW, W3SETW - USE W3WDATMD, ONLY : WDATAS, TIME, WLV, ICE, ICEH, ICEF, & - UST, USTDIR, ASF, RHOAIR + USE W3WDATMD, ONLY : WDATAS USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE, EXTOPN, EXTIOF #ifdef W3_S USE W3SERVMD, ONLY : STRACE @@ -129,7 +127,6 @@ PROGRAM W3GRID_INTERP USE W3ARRYMD, ONLY : PRTBLK USE W3GSRUMD USE W3TRIAMD - USE W3WDATMD, ONLY: VA USE W3IORSMD, ONLY: W3IORS !/ IMPLICIT NONE @@ -161,7 +158,7 @@ PROGRAM W3GRID_INTERP INTEGER, ALLOCATABLE :: FIDOUT(:), MAP(:,:), TMP_INDX(:) REAL :: SXT, SYT, XT, YT, XTT DOUBLE PRECISION :: DAREA, SAREA - REAL :: XCRNR(5),YCRNR(5),DT(4),DX,DY,XSUB,YSUB + REAL :: XCRNR(5),YCRNR(5),DT(4) INTEGER :: TOUT(2), NOUT, IOUT REAL :: DTREQ, DTEST INTEGER :: IS(4), JS(4) @@ -175,7 +172,6 @@ PROGRAM W3GRID_INTERP CHARACTER :: COMSTR*1, IDTIME*23, FNAMEWHT*32 REAL :: XXX !< Dummy Value for w3iors call LOGICAL :: OUTorREST !< True interpolate out_grd or False restart - INTEGER :: INTYPE !check if this can be removed INTEGER, ALLOCATABLE :: MAPSTA_NG(:,:),MAPST2_NG(:,:) INTEGER, ALLOCATABLE :: NOINT(:),NOINT2(:),MAPSTATMP(:,:) INTEGER :: iNOINT,iNOINT2,JSEA,iloops @@ -1133,7 +1129,6 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & !variables for restart LOGICAL :: OUTorRESTflag REAL :: VAAUX(NSPEC), SUMRES(NSPEC) - INTEGER :: INTYPE REAL :: XXX INTEGER :: MAPSTA_NG(NY,NX),MAPST2_NG(NY,NX) !/ diff --git a/model/src/ww3_grib.F90 b/model/src/ww3_grib.F90 index 7a4fe135e7..281d9f3eea 100644 --- a/model/src/ww3_grib.F90 +++ b/model/src/ww3_grib.F90 @@ -156,7 +156,7 @@ PROGRAM W3GRIB USE W3WDATMD, ONLY: TIME, WLV, ICE, UST, USTDIR, RHOAIR USE W3ADATMD USE W3ODATMD, ONLY: NDSE, NDST, NDSO, NOGRP, NGRPP, IDOUT, UNDEF,& - FLOGRD, FNMPRE, NOSWLL, NOGE, FLOGD + FLOGRD, NOSWLL, NOGE, FLOGD ! IMPLICIT NONE !/ @@ -218,7 +218,7 @@ END SUBROUTINE GRIBEND !/ Local variables !/ INTEGER :: NDSI, NDSM, NDSOG, NDSDAT, NDSTRC, & - NTRACE, IERR, IOTEST, I,J,K, IFI,IFJ,& + NTRACE, IERR, IOTEST, I, J, IFI, IFJ,& ISEA, IX, IY, TOUT(2), NOUT, TDUM(2),& FTIME(2), CID, PID, GID, GDS, IOUT, & GDTN @@ -244,7 +244,7 @@ END SUBROUTINE GRIBEND INTEGER, SAVE :: IENT = 0 #endif REAL :: DTREQ, DTEST, RFTIME - LOGICAL :: FLREQ(NOGRP,NGRPP), FLGRIB(NOGRP,NGRPP) + LOGICAL :: FLREQ(NOGRP,NGRPP) CHARACTER :: COMSTR*1, IDTIME*23, IDDDAY*11 CHARACTER(LEN=80) :: LINEIN CHARACTER(LEN=8) :: WORDS(5) @@ -1034,7 +1034,7 @@ SUBROUTINE W3EXGB ( NX, NY, NSEA ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: J, IXY, NDATA + INTEGER :: IXY, NDATA INTEGER :: IO #ifdef W3_S INTEGER, SAVE :: IENT = 0 diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index 0adc8d3ffe..f7f1572b4b 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -155,8 +155,7 @@ PROGRAM W3OUTF USE W3IOGOMD, ONLY: W3IOGO, W3READFLGRD !/ USE W3GDATMD - USE W3WDATMD, ONLY: TIME, WLV, ICE, ICEH, ICEF, BERG, UST, & - USTDIR, RHOAIR + USE W3WDATMD, ONLY: TIME, WLV, ICE, BERG, UST, USTDIR, RHOAIR USE W3ADATMD, ONLY: DW, UA, UD, AS, CX, CY, HS, WLM, T0M1, THM, & THS, FP0, THP0, DTDYN, FCUT, & ABA, ABD, UBA, UBD, SXX, SYY, SXY, USERO, & @@ -173,7 +172,10 @@ PROGRAM W3OUTF HCMAXE, HMAXD, HCMAXD, MSSD, MSCD, WBT, & WNMEAN, TAUA, TAUADIR USE W3ODATMD, ONLY: NDSO, NDSE, NDST, NOGRP, NGRPP, IDOUT, & - UNDEF, FLOGRD, FNMPRE, FNMGRD, FNMPNT, FNMRST, NOSWLL, NOGE + UNDEF, FLOGRD, FNMPRE, NOSWLL +#ifdef W3_IS2 + USE W3WDATMD, ONLY: ICEH, ICEF +#endif ! IMPLICIT NONE !/ @@ -192,7 +194,7 @@ PROGRAM W3OUTF CHARACTER :: COMSTR*1, IDTIME*23, IDDDAY*11, & TABNME*9 LOGICAL :: FLREQ(NOGRP,NGRPP), FLOG(NOGRP), & - SCALE, VECTOR, LTEMP(NGRPP) + SCALE, VECTOR !/ !/ ------------------------------------------------------------------- / !/ @@ -632,7 +634,7 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) !/ Local parameters !/ INTEGER :: NXMAX, NXTOT, NBLOK, IH, IM, IS, & - MFILL, J, ISEA, IX, IY, IXB, IB, & + MFILL, ISEA, IX, IY, IXB, IB, & IXA, NINGRD, JJ, IFI, IFJ INTEGER :: MAP(NX+1,NY), MP2(NX+1,NY), & MX1(NX,NY), MXX(NX,NY), MYY(NX,NY), & diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index b18ee26409..9e5facea17 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -224,13 +224,15 @@ PROGRAM W3OUTP USE W3GDATMD USE W3WDATMD, ONLY: TIME USE W3ODATMD, ONLY: NDSE, NDST, NDSO, NOPTS, PTLOC, PTNME, & - DPO, WAO, WDO, ASO, CAO, CDO, SPCO, FNMPRE,& - ICEO, ICEHO, ICEFO, DIMP + DPO, WAO, WDO, ASO, CAO, CDO, SPCO, FNMPRE, DIMP +#ifdef W3_IS2 + USE W3ODATMD, ONLY: ICEO, ICEHO, ICEFO +#endif #ifdef W3_FLX5 USE W3ODATMD, ONLY: TAUAO, TAUDO, DAIRO #endif - USE W3BULLMD, ONLY: NPTAB, NFLD, NPMAX, BHSMIN, BHSDROP, IYY, & - HST, TPT, DMT, ASCBLINE, CSVBLINE + USE W3BULLMD, ONLY: NPTAB, NFLD, NPMAX, BHSMIN, BHSDROP, & + ASCBLINE, CSVBLINE #ifdef W3_NCO USE W3BULLMD, ONLY: CASCBLINE #endif @@ -1417,7 +1419,7 @@ SUBROUTINE W3EXPO !/ INTEGER :: J, I1, I2, ISP, IKM, ITH, & IK, IH, IM, IS, IYR, IMTH, IDY, ITT, & - I, NPART, IP, IX, IY, ISEA + I, NPART, IX, IY INTEGER, SAVE :: IPASS = 0 #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -1430,15 +1432,20 @@ SUBROUTINE W3EXPO SPP, CD, USTAR, FACTOR, UNORM, ESTAR,& FPSTAR, FACF, FACE, FACS, HMAT, WNA, & XYZ, AGE1, AFR, AGE2, FACT, XSTAR, & - YSTAR, FHIGH, ZWND, Z0, USTD, EMEAN, & + YSTAR, ZWND, Z0, USTD, EMEAN, & FMEAN, WNMEAN, UDIRCA, X, Y, CHARN, & - M2KM, ICEF, ICEDMAX, ICETHICK, & - ICECON + M2KM +#if defined(W3_ST0) || defined(W3_ST1) || defined(W3_ST2) || defined(W3_ST6) || defined(W3_LN1) + REAL :: FHIGH +#endif + #ifdef W3_FLX5 - REAL ::TAUA, TAUADIR, RHOAIR + REAL :: TAUA, TAUADIR, RHOAIR #endif #ifdef W3_IS2 - REAL :: WN_R(NK),CG_ICE(NK), ALPHA_LIU(NK) + REAL :: WN_R(NK), CG_ICE(NK), ALPHA_LIU(NK), R(NK) + REAL :: DIA2(NTH,NK) + REAL :: ICEF, ICEDMAX, ICETHICK, ICECON #endif #ifdef W3_ST1 REAL :: AMAX, FH1, FH2 @@ -1448,10 +1455,10 @@ SUBROUTINE W3EXPO #endif #ifdef W3_ST3 REAL :: AMAX, FMEANS, FMEANWS, TAUWX, TAUWY, & - TAUWNX, TAUWNY + TAUWNX, TAUWNY, ICE #endif #ifdef W3_ST4 - REAL :: AMAX, FMEANS, FMEANWS, TAUWX, TAUWY, & + REAL :: AMAX, FMEANWS, TAUWX, TAUWY, & TAUWNX, TAUWNY, FMEAN1, WHITECAP(1:4), DLWMEAN #endif #ifdef W3_ST6 @@ -1461,21 +1468,21 @@ SUBROUTINE W3EXPO REAL :: TAUSCX, TAUSCY #endif #ifdef W3_BT4 + INTEGER :: ISEA REAL :: D50, PSIC, BEDFORM(3), TAUBBL(2) #endif - REAL :: ICE #ifdef W3_STAB2 REAL :: STAB0, STAB, COR1, COR2, ASFAC, & THARG1, THARG2 #endif REAL, SAVE :: HSMIN = 0.05 - REAL :: WN(NK), CG(NK), R(NK) + REAL :: WN(NK), CG(NK) REAL :: E(NK,NTH), E1(NK), APM(NK), & THBND(NK), SPBND(NK), A(NTH,NK), & WN2(NTH,NK) REAL :: DIA(NTH,NK), SWN(NK,NTH), SNL(NK,NTH),& SDS(NK,NTH), SBT(NK,NTH), SIS(NK,NTH),& - STT(NK,NTH), DIA2(NTH,NK) + STT(NK,NTH) REAL :: XLN(NTH,NK), XIN(NTH,NK), XNL(NTH,NK),& XTR(NTH,NK), XDS(NTH,NK), XDB(NTH,NK),& XBT(NTH,NK), XBS(NTH,NK), XXX(NTH,NK),& From bdae9ad75d393681452f4c61e7a4921acceb449b Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Thu, 5 Feb 2026 10:17:36 -0500 Subject: [PATCH 128/136] Fix compiler remarks in modules w3arrymd, w3fldsmd, w3gdatmd, w3idatmd, w3odatmd, w3parall, and w3timemd(#1562) --- model/src/w3arrymd.F90 | 2 +- model/src/w3fldsmd.F90 | 10 +++++++++- model/src/w3gdatmd.F90 | 8 +++++--- model/src/w3idatmd.F90 | 2 ++ model/src/w3odatmd.F90 | 4 +--- model/src/w3parall.F90 | 43 ++++++++++++++++++++++++++++++------------ model/src/w3timemd.F90 | 3 +-- 7 files changed, 50 insertions(+), 22 deletions(-) diff --git a/model/src/w3arrymd.F90 b/model/src/w3arrymd.F90 index b6a983db5c..b2ddaa73cf 100644 --- a/model/src/w3arrymd.F90 +++ b/model/src/w3arrymd.F90 @@ -1697,7 +1697,7 @@ SUBROUTINE PRT1DM (NDS, NFR, NE, E, FR, UFR, NLINES, FTOPI, & #endif REAL, SAVE :: TOPFAC = 1.1 REAL :: FTOP, RLINES, FACFR, FSC, FLINE, & - EMAX, EMIN, EXTR, FLOC + EMAX, EMIN, EXTR LOGICAL :: FLSCLE CHARACTER :: STRA*10, STRA2*2, STRAX*2, PNUM2*2 DIMENSION :: PNUM2(NFM2) diff --git a/model/src/w3fldsmd.F90 b/model/src/w3fldsmd.F90 index 8f0e682bc0..b114d9354c 100644 --- a/model/src/w3fldsmd.F90 +++ b/model/src/w3fldsmd.F90 @@ -805,8 +805,16 @@ SUBROUTINE W3FLDTIDE2 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR ) INTEGER, SAVE :: IENT = 0 #endif LOGICAL :: WRITE - INTEGER :: I, IX, TIDE_MF1 +#ifdef W3_TIDE + INTEGER :: TIDE_MF1 CHARACTER(LEN=100) :: LIST(70) +#endif +#ifdef W3_TIDET + INTEGER :: IX +#endif +#if defined(W3_TIDE) || defined(W3_TIDET) + INTEGER :: I +#endif !/ !/ ------------------------------------------------------------------- / !/ diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index a43a4cd822..3c57ae034f 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -3363,8 +3363,6 @@ SUBROUTINE W3SETREF !/ !/ ------------------------------------------------------------------- / !/ - INTEGER :: IX, IY - INTEGER :: NEIGH1(0:7) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -3372,8 +3370,12 @@ SUBROUTINE W3SETREF REAL :: COSAVG, SINAVG, THAVG, CLAT INTEGER :: J, K #endif - +#if defined(W3_REF1) || defined(W3_REFT) + INTEGER :: IX, IY + INTEGER :: NEIGH1(0:7) REAL :: ANGLES(0:7) +#endif + !/ !/ ------------------------------------------------------------------- / !/ diff --git a/model/src/w3idatmd.F90 b/model/src/w3idatmd.F90 index 5a63588912..5116c4ca8d 100644 --- a/model/src/w3idatmd.F90 +++ b/model/src/w3idatmd.F90 @@ -516,7 +516,9 @@ SUBROUTINE W3DIMI ( IMOD, NDSE, NDST, FLAGSTIDEIN ) !/ Local parameters !/ INTEGER :: JGRID +#ifdef W3_TIDE LOGICAL :: FLAGSTIDE(4)=.FALSE. +#endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 CALL STRACE (IENT, 'W3DIMI') diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index cd2e829f89..66acf4c23a 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -1401,7 +1401,7 @@ SUBROUTINE W3DMO5 ( IMOD, NDSE, NDST, IBLOCK ) ! 10. Source code : ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, ONLY: W3SETG, NGRIDS, IGRID, NX, NY, NSPEC + USE W3GDATMD, ONLY: W3SETG, NGRIDS, NSPEC USE W3SERVMD, ONLY: EXTCDE #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -1417,7 +1417,6 @@ SUBROUTINE W3DMO5 ( IMOD, NDSE, NDST, IBLOCK ) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: JGRID #ifdef W3_S INTEGER, SAVE :: IENT = 0 CALL STRACE (IENT, 'W3DMO5') @@ -1621,7 +1620,6 @@ SUBROUTINE W3SETO ( IMOD, NDSERR, NDSTST ) !/ Local parameters !/ INTEGER :: NLOW - INTEGER :: J #ifdef W3_S INTEGER, SAVE :: IENT = 0 CALL STRACE (IENT, 'W3SETO') diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index e7bc900721..9ed33de8b7 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -1086,9 +1086,13 @@ SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) #ifdef W3_MPI USE W3ADATMD, ONLY: MPI_COMM_WAVE, MPI_COMM_WCMP #endif +#ifdef W3_DIST USE CONSTANTS, ONLY : LPDLIB +#endif USE W3GDATMD, ONLY: NSEA - USE W3ODATMD, ONLY: NAPROC, IAPROC +#if defined(W3_DIST) || defined(W3_PDLIB) + USE W3ODATMD, ONLY: IAPROC, NAPROC +#endif IMPLICIT NONE INTEGER, intent(out) :: NSEALout, NSEALMout !/ Local parameters @@ -1200,12 +1204,14 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3ODATMD, ONLY: IAPROC, NAPROC - USE W3GDATMD, ONLY: UNGTYPE, MAPSF - USE CONSTANTS, ONLY : LPDLIB + USE W3ODATMD, ONLY: NAPROC + USE W3GDATMD, ONLY: UNGTYPE #ifdef W3_PDLIB USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot use yowNodepool, only: ipgl, iplg + USE W3ODATMD, ONLY: IAPROC + USE W3GDATMD, ONLY: MAPSF + USE CONSTANTS, ONLY : LPDLIB #endif IMPLICIT NONE !/ ------------------------------------------------------------------- / @@ -1221,7 +1227,10 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) !/ ------------------------------------------------------------------- / INTEGER, intent(in) :: ISEA INTEGER, intent(out) :: JSEA, ISPROC +#ifdef W3_PDLIB INTEGER IP_glob +#endif + #ifdef W3_S CALL STRACE (IENT, 'INIT_GET_JSEA_ISPROC') #endif @@ -1309,11 +1318,12 @@ SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) #endif !/ USE W3ODATMD, ONLY: IAPROC, NAPROC - USE W3GDATMD, ONLY: GTYPE, UNGTYPE, MAPSF + USE W3GDATMD, ONLY: UNGTYPE USE CONSTANTS, ONLY : LPDLIB #ifdef W3_PDLIB USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot, IPGL_npa use yowNodepool, only: ipgl, iplg + USE W3GDATMD, ONLY: MAPSF, GTYPE #endif IMPLICIT NONE !/ ------------------------------------------------------------------- / @@ -1330,7 +1340,10 @@ SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) !/ INTEGER, intent(in) :: ISEA INTEGER, intent(out) :: JSEA, IBELONG - INTEGER ISPROC, IX, JX + INTEGER ISPROC +#ifdef W3_PDLIB + INTEGER :: IX, JX +#endif #ifdef W3_S CALL STRACE (IENT, 'GET_JSEA_IBELONG') #endif @@ -1435,11 +1448,17 @@ SUBROUTINE INIT_GET_ISEA(ISEA, JSEA) USE W3SERVMD, ONLY: STRACE #endif !/ - USE W3ODATMD, ONLY: IAPROC, NAPROC - USE W3GDATMD, ONLY: GTYPE, UNGTYPE - USE CONSTANTS, ONLY : LPDLIB + USE W3GDATMD, ONLY: UNGTYPE #ifdef W3_PDLIB USE YOWNODEPOOL, ONLY: iplg + USE W3GDATMD, ONLY: GTYPE +#endif +#ifdef W3_DIST + USE CONSTANTS, ONLY : LPDLIB +#endif + !/ +#if defined(W3_DIST) || defined(W3_PDLIB) + USE W3ODATMD, ONLY: IAPROC, NAPROC #endif !/ ------------------------------------------------------------------- / !/ Parameter list @@ -1582,14 +1601,14 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) !/ !/ ------------------------------------------------------------------- / !/ - INTEGER Status(NX), rStatus(NX) - INTEGER IPROC, I, ierr, IP, IP_glob + INTEGER Status(NX) #ifdef W3_PDLIB REAL(rkind), intent(inout) :: TheVar(NX) REAL(rkind) :: rVect(NX) + INTEGER :: IP, IP_glob, IPROC, I, ierr + INTEGER :: rStatus(NX) #else DOUBLE PRECISION, intent(inout) :: TheVar(NX) - DOUBLE PRECISION :: rVect(NX) #endif Status=0 #ifdef W3_S diff --git a/model/src/w3timemd.F90 b/model/src/w3timemd.F90 index 5c989c4545..7f7d52ad10 100644 --- a/model/src/w3timemd.F90 +++ b/model/src/w3timemd.F90 @@ -1419,7 +1419,7 @@ SUBROUTINE J2D(JULIAN,DAT,IERR) !/ Local parameters !/ REAL :: SECDAY=86400.0d0 - INTEGER :: TIMEZONE(8), TZ + INTEGER :: TZ REAL :: SECOND INTEGER :: YEAR, MONTH, DAY, HOUR, MINUTE @@ -2035,7 +2035,6 @@ SUBROUTINE T2ISO(TIME,ISODT) !/ ------------------------------------------------------------------- / !/ USE W3SERVMD, ONLY: EXTIOF - USE W3ODATMD, ONLY: NDSE ! IMPLICIT NONE !/ From 596e11dd0ae9608a4ccbfead4aa884c2320ed4e7 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Thu, 5 Feb 2026 10:21:52 -0500 Subject: [PATCH 129/136] Address compiler remarks in modules w3iogomd, w3iogrmd, w3iorsmd (#1564) w3iosfmd, w3profsmd, w3snl1md, w3src4md, w3srcemd, w3triamd and w3uqckmd --- model/src/w3iogomd.F90 | 2 +- model/src/w3iogrmd.F90 | 26 ++++++++++++++++---------- model/src/w3iorsmd.F90 | 6 +++++- model/src/w3iosfmd.F90 | 4 +++- model/src/w3profsmd.F90 | 10 +++++----- model/src/w3snl1md.F90 | 3 ++- model/src/w3src4md.F90 | 5 ++++- model/src/w3srcemd.F90 | 8 +++++--- model/src/w3triamd.F90 | 3 ++- model/src/w3uqckmd.F90 | 15 ++++++++++++--- 10 files changed, 55 insertions(+), 27 deletions(-) diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 3422b6bf52..f51b77ca99 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -2569,7 +2569,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & !/ Local parameters !/ INTEGER :: IGRD, IERR, I, J, IX, IY, MOGRP, & - MGRPP, ISEA, MOSWLL, IK, IFI, IFJ + MGRPP, ISEA, MOSWLL, IFI, IFJ INTEGER, ALLOCATABLE :: MAPTMP(:,:) #ifdef W3_S INTEGER, SAVE :: IENT = 0 diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index f292c1eb04..55b75c2d95 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -331,11 +331,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IGRD, IERR, I, J, MTH, MK, ISEA, IX, IY + INTEGER :: IGRD, IERR, I, MTH, MK, IX, IY INTEGER :: IEXT, IPRE -#ifdef W3_ST4 - INTEGER :: IK, ITH, IK2, ITH2 -#endif INTEGER, ALLOCATABLE :: MAPTMP(:,:) #ifdef W3_MPI INTEGER :: IERR_MPI, IP @@ -344,12 +341,22 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & INTEGER, SAVE :: IENT = 0 #endif #ifdef W3_T - INTEGER :: K + INTEGER :: K, ISEA +#endif +#if defined(W3_T) || defined(W3_SMC) + INTEGER :: J +#endif + LOGICAL :: WRITE, FLTEST = .FALSE. +#if defined(W3_NL2) || defined(W3_MPI) + LOGICAL :: FLSNL2 = .FALSE. +#endif + LOGICAL, SAVE :: FLDISP = .FALSE. +#if defined(W3_ST2) || defined(W3_ST3) + LOGICAL, SAVE :: FLINP = .FALSE. +#endif +#ifdef W3_IS2 + LOGICAL, SAVE :: FLIS = .FALSE. #endif - LOGICAL :: WRITE, FLTEST = .FALSE., TESTLL, & - FLSNL2 = .FALSE. - LOGICAL, SAVE :: FLINP = .FALSE. , FLDISP = .FALSE., & - FLIS = .FALSE. CHARACTER(LEN=10) :: VERTST CHARACTER(LEN=13) :: TEMPXT CHARACTER(LEN=30) :: TNAME0, TNAME1, TNAME2, TNAME3, & @@ -360,7 +367,6 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT & FNAMEP, FNAMEG, FNAMEF, FNAMEI CHARACTER(LEN=35) :: IDTST CHARACTER(LEN=60) :: MESSAGE(5) - LOGICAL :: GLOBAL REAL, ALLOCATABLE :: XGRD4(:,:), YGRD4(:,:) diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index fad2b98ec2..c07ffd0da9 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -302,7 +302,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) UBA, UBD, PHIBBL, TAUBBL, TAUOCX, TAUOCY, & WNMEAN !/ - USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, NSPEC, MAPSTA, MAPST2, & + USE W3GDATMD, ONLY: NX, NY, NSEA, NSPEC, MAPSTA, MAPST2, & GNAME, FILEXT, GTYPE, UNGTYPE USE W3TRIAMD, ONLY: SET_UG_IOBP USE W3WDATMD, only : DINIT, VA, TIME, TLEV, TICE, TRHO, ICE, UST @@ -323,6 +323,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) VAAUX USE W3ADATMD, ONLY: MPI_COMM_WCMP USE mpi_f08 +#endif + !/ +#if defined(W3_T) || defined(W3_MPI) + USE W3GDATMD, ONLY: NSEAL #endif !/ USE W3SERVMD, ONLY: EXTCDE, EXTIOF diff --git a/model/src/w3iosfmd.F90 b/model/src/w3iosfmd.F90 index e3cdc9bf43..eaf874a165 100644 --- a/model/src/w3iosfmd.F90 +++ b/model/src/w3iosfmd.F90 @@ -441,7 +441,6 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) IPASS => IPASS6, FLFORM, FNMPRE, OUTPTS, & IX0, IXN, IXS, IY0, IYN, IYS, DIMP USE W3ADATMD, ONLY: DW, U10, U10D, CX, CY - USE W3ADATMD, ONLY: NSEALM USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC #ifdef W3_MPI USE W3ADATMD, ONLY: MPI_COMM_WAVE @@ -449,6 +448,9 @@ SUBROUTINE W3IOSF ( NDSPT, IMOD ) #endif #ifdef W3_T USE W3ODATMD, ONLY: NDST +#endif +#if defined(W3_T) || defined(W3_MPI) + USE W3ADATMD, ONLY: NSEALM #endif ! #ifdef W3_MPI diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 63d0108eea..e1118b8b95 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -344,8 +344,8 @@ SUBROUTINE W3CFLUG ( ISEA, NKCFL, FACX, FACY, DT, MAPFS, CFLXYMAX, & ! USE W3TIMEMD, ONLY: DSEC21 ! - USE W3GDATMD, ONLY: NX, NY, NSEA, MAPSF, CLATS, & - NTH, ECOS, ESIN, IEN, INDEX_CELL, & + USE W3GDATMD, ONLY: NX, NY, MAPSF, CLATS, & + NTH, ECOS, ESIN, IEN, INDEX_CELL, & TRIGP, IE_CELL, POS_CELL, SI, IOBP USE W3ADATMD, ONLY: CG, CX, CY @@ -1323,9 +1323,9 @@ SUBROUTINE W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ ------------------------------------------------------------------- / !/ USE W3GDATMD, ONLY : NTH, NTRI, NX, SI, & - IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBPA, IOBDP + IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBDP #ifdef W3_REF1 - USE W3GDATMD, ONLY : REFPARS + USE W3GDATMD, ONLY : REFPARS, IOBPA #endif USE W3ADATMD, ONLY: CG, ITER USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN @@ -1626,7 +1626,7 @@ SUBROUTINE SETDEPTH USE W3SERVMD, ONLY: STRACE #endif ! - USE W3GDATMD, ONLY: DMIN, IOBDP, MAPFS, NX + USE W3GDATMD, ONLY: DMIN, IOBDP, NX USE W3ADATMD, ONLY: DW IMPLICIT NONE diff --git a/model/src/w3snl1md.F90 b/model/src/w3snl1md.F90 index 09f8cee351..11eb954acc 100644 --- a/model/src/w3snl1md.F90 +++ b/model/src/w3snl1md.F90 @@ -836,8 +836,9 @@ SUBROUTINE W3SNLGQM(A,CG,WN,DEPTH,TSTOTn,TSDERn) REAL :: q_dfac, SATVAL(NK), SUME, ACCVAL, ACCMAX, AMPFAC DOUBLE PRECISION :: RAISF, FREQ(NK) DOUBLE PRECISION :: TSTOT(NTH,NK) , TSDER(NTH,NK), F(NTH,NK) +#ifdef W3_TGQM DOUBLE PRECISION :: TEMP - +#endif !.....LOCAL VARIABLES INTEGER JF , JT , JF1 , JT1 , IQ_OM2 & , JFM0 , JFM1 , JFM2 , JFM3 , IXF1 , IXF2 & diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index 3d21d5895f..982014960e 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -229,7 +229,7 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & USE CONSTANTS, ONLY: TPIINV, GRAV, nu_air USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DDEN, WWNMEANP, & WWNMEANPTAIL, FTE, FTF, SSTXFTWN,& - SSTXFTFTAIL, ESIN, ECOS, ZZWND, SSDSC + SSTXFTFTAIL, ESIN, ECOS, SSDSC #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -240,6 +240,7 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & ! #ifdef W3_FLX5 USE W3FLX5MD + USE W3GDATMD, ONLY: ZZWND #endif IMPLICIT NONE !/ @@ -550,8 +551,10 @@ SUBROUTINE W3SIN4 (A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, & REAL :: COSU, SINU, TAUX, TAUY, USDIRP, USTP REAL :: TAUPX, TAUPY, UST2, TAUW, TAUWB REAL , PARAMETER :: EPS1 = 0.00001, EPS2 = 0.000001 +#if defined(W3_T) || defined(W3_STAB3) REAL :: Usigma !standard deviation of U due to gustiness REAL :: USTARsigma !standard deviation of USTAR due to gustiness +#endif REAL :: CM,UCN,ZCN, & Z0VISC, Z0NOZ, EB, & EBX, EBY, AORB, AORB1, FW, UORB, & diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 020786987a..6716175008 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -497,11 +497,13 @@ 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 USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, TH, DMIN, DTMAX, & - DTMIN, FACTI1, FACTI2, FACSD, FACHFA, FACP, & - XFLT, XREL, FXFM, FXPM, DDEN, & - FHMAX, ECOS, ESIN, IICEDISP, & + DTMIN, FACTI1, FACTI2, FACSD, FACHFA, FACP, & + XFLT, XREL, DDEN, FHMAX, ECOS, ESIN, IICEDISP, & ICESCALES, IICESMOOTH USE W3GDATMD, ONLY: IC_NUMERICS +#if defined(W3_ST1) || defined(W3_ST6) + USE W3GDATMD, ONLY: FXFM, FXPM +#endif #if defined(W3_NL5) || defined(W3_NNT) USE W3WDATMD, ONLY: TIME #endif diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index cc38b5fc46..df5a145381 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -2070,11 +2070,12 @@ SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) ! 10. Source code : USE CONSTANTS USE W3GDATMD, ONLY : TRIGP, NTRI, NX, NSEA, MAPFS, CLATIS, & - FLAGLL, IEN, TRIA, NSEAL, NTRI + FLAGLL, IEN, TRIA, NTRI #ifdef W3_PDLIB USE yowElementpool use yowNodepool, only: PDLIB_IEN, PDLIB_TRIA, NPA USE yowExchangeModule, only : PDLIB_exchange1Dreal + USE W3GDATMD, ONLY : NSEAL #endif IMPLICIT NONE diff --git a/model/src/w3uqckmd.F90 b/model/src/w3uqckmd.F90 index edcf0e0dea..d5307bd8a5 100644 --- a/model/src/w3uqckmd.F90 +++ b/model/src/w3uqckmd.F90 @@ -220,7 +220,7 @@ SUBROUTINE W3QCK1 (MX, MY, NX, NY, CFLL, Q, CLOSE, INC, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, & + INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, & IAD00, IAD02, IADN0, IADN1, IADN2 #ifdef W3_S INTEGER, SAVE :: IENT = 0 @@ -238,6 +238,9 @@ SUBROUTINE W3QCK1 (MX, MY, NX, NY, CFLL, Q, CLOSE, INC, & #endif #ifdef W3_T2 REAL :: QOLD +#endif +#if defined(W3_T0) || defined(W3_T1) + INTEGER :: IX #endif !/ !/ ------------------------------------------------------------------- / @@ -615,7 +618,7 @@ SUBROUTINE W3QCK2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q, CLOSE,& !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, & + INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, & IAD00, IAD02, IADN0, IADN1, IADN2 #ifdef W3_S INTEGER, SAVE :: IENT @@ -633,6 +636,9 @@ SUBROUTINE W3QCK2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q, CLOSE,& #endif #ifdef W3_T2 REAL :: QOLD +#endif +#if defined(W3_T0) || defined(W3_T1) + INTEGER :: IX #endif !/ !/ ------------------------------------------------------------------- / @@ -1017,7 +1023,7 @@ SUBROUTINE W3QCK3 (MX, MY, NX, NY, CFLL, TRANS, Q, CLOSE, & !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, & + INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, & IAD00, IAD02, IADN0, IADN1, IADN2, & JN, JP #ifdef W3_S @@ -1036,6 +1042,9 @@ SUBROUTINE W3QCK3 (MX, MY, NX, NY, CFLL, TRANS, Q, CLOSE, & #endif #ifdef W3_T2 REAL :: QOLD +#endif +#if defined(W3_T0) || defined(W3_T1) + INTEGER :: IX #endif !/ !/ ------------------------------------------------------------------- / From e1bea12c746f9def6508c813e06b9546a4893d7e Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Thu, 5 Feb 2026 14:12:10 -0500 Subject: [PATCH 130/136] Remove compiler remarks in PDLIB functions (#1565) --- model/src/PDLIB/yowelementpool.F90 | 3 +-- model/src/PDLIB/yowexchangeModule.F90 | 10 ++++---- model/src/PDLIB/yowfunction.F90 | 14 ++++++----- model/src/PDLIB/yowpdlibmain.F90 | 34 ++++++++++++++------------- model/src/PDLIB/yowrankModule.F90 | 4 ++-- 5 files changed, 34 insertions(+), 31 deletions(-) diff --git a/model/src/PDLIB/yowelementpool.F90 b/model/src/PDLIB/yowelementpool.F90 index f1f06b293a..cbd2cc4d41 100644 --- a/model/src/PDLIB/yowelementpool.F90 +++ b/model/src/PDLIB/yowelementpool.F90 @@ -71,7 +71,7 @@ module yowElementpool !> conversione: If a element is connected to domain 1,2 and 3. It belongs to 1,2 and 3. !> @param[in] rank optional. If not given, datapool:myrank is used function belongTo(ele_in, rank) - use yowDatapool, only: myrank, nTasks + use yowDatapool, only: myrank use yowNodepool, only: t_Node, nodes_global implicit none integer, intent(in) :: ele_in(3) @@ -79,7 +79,6 @@ function belongTo(ele_in, rank) logical :: belongTo integer :: myDomainID - integer :: nodes(3) integer J if(present(rank) .eqv. .true.) then diff --git a/model/src/PDLIB/yowexchangeModule.F90 b/model/src/PDLIB/yowexchangeModule.F90 index 630270d155..1fd4e0539c 100644 --- a/model/src/PDLIB/yowexchangeModule.F90 +++ b/model/src/PDLIB/yowexchangeModule.F90 @@ -151,7 +151,7 @@ subroutine createMPIType(this) use yowerr use mpi_f08 use yowNodepool, only: ghostgl, np, ipgl - use yowDatapool, only: rtype, itype + use yowDatapool, only: rtype implicit none class(t_neighborDomain), intent(inout) :: this @@ -249,7 +249,7 @@ end subroutine createMPITypes !> \note MPI send tag: 10000 + neighbor MPI rank subroutine PDLIB_exchange1Dreal(U) use yowDatapool, only: comm, myrank, rkind - use yowNodepool, only: t_Node, nodes_global, np, ng, ghosts, npa + use yowNodepool, only: t_Node, ghosts, npa use yowerr use mpi_f08 implicit none @@ -302,10 +302,12 @@ end subroutine PDLIB_exchange1Dreal !> \note MPI send tag: 30000 + neighbor MPI rank subroutine PDLIB_exchange2Dreal(U) use yowDatapool, only: comm, myrank, rkind - use yowNodepool, only: t_Node, nodes_global, np, ng, ghosts, npa + use yowNodepool, only: t_Node, ghosts use yowerr use mpi_f08 +#ifdef W3_DEBUGEXCH USE W3ODATMD, only : IAPROC +#endif implicit none real(kind=rkind), intent(inout) :: U(:,:) @@ -417,7 +419,6 @@ subroutine PDLIB_exchange1Dreal_zero(U) integer :: i, ierr, tag type(MPI_REQUEST) :: sendRqst(nConnDomains), recvRqst(nConnDomains) type(MPI_STATUS) :: recvStat(nConnDomains), sendStat(nConnDomains) - character(len=200) errstr ! It is impossible to add these range checks because assumed shape array start vom 1:npa+1 even if you allocate it from 0:npa @@ -487,7 +488,6 @@ subroutine PDLIB_exchange2Dreal_zero(U) integer :: i, ierr, tag type(MPI_REQUEST) :: sendRqst(nConnDomains), recvRqst(nConnDomains) type(MPI_STATUS) :: recvStat(nConnDomains), sendStat(nConnDomains) - character(len=200) errstr ! It is impossible to add these range checks because assumed shape array start vom 1:npa+1 even if you allocate it from 0:npa ! if(size(U,2) /= npa+1) then diff --git a/model/src/PDLIB/yowfunction.F90 b/model/src/PDLIB/yowfunction.F90 index 29bdd78c06..d119a4c587 100644 --- a/model/src/PDLIB/yowfunction.F90 +++ b/model/src/PDLIB/yowfunction.F90 @@ -55,12 +55,15 @@ END SUBROUTINE PDLIB_ABORT !* * !********************************************************************** SUBROUTINE ComputeListNP_ListNPA_ListIPLG_Kernel - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + USE W3ODATMD, only : IAPROC, NAPROC USE W3ADATMD, ONLY: MPI_COMM_WCMP - USE yowDatapool, only: rtype, istatus + USE yowDatapool, only: istatus USE yowNodepool, only: npa, np, iplg USE yowNodepool, only: ListNP, ListNPA, ListIPLG use mpi_f08 +#ifdef W3_DEBUGINIT + USE W3ODATMD, only : NTPROC +#endif IMPLICIT NONE integer IPROC, idx, IP, len, istat, sumNP, ierr integer, allocatable :: iVect(:) @@ -195,8 +198,7 @@ END SUBROUTINE ComputeListNP_ListNPA_ListIPLG_Kernel SUBROUTINE ComputeListNP_ListNPA_ListIPLG USE W3ODATMD, only : IAPROC, NAPROC, NTPROC USE W3ADATMD, ONLY: MPI_COMM_WAVE - USE yowDatapool, only: rtype, istatus - USE yowNodepool, only: npa, np, iplg + USE yowDatapool, only: istatus USE yowNodepool, only: ListNP, ListNPA, ListIPLG use mpi_f08 IMPLICIT NONE @@ -281,9 +283,9 @@ END SUBROUTINE ComputeListNP_ListNPA_ListIPLG !* * !********************************************************************** SUBROUTINE ComputeBoundaryInformation - use yowNodepool, only: ListNP, ListNPA, ListIPLG + use yowNodepool, only: ListNPA, ListIPLG USE W3GDATMD, ONLY: IOBP - USE W3ODATMD, only : IAPROC, NAPROC + USE W3ODATMD, only : NAPROC IMPLICIT NONE integer ListFirst(NAPROC), NbSend(NAPROC) integer IPROC, eSend, IP, IP_glob, NPAloc diff --git a/model/src/PDLIB/yowpdlibmain.F90 b/model/src/PDLIB/yowpdlibmain.F90 index 193c6c17c3..97e934e2fa 100644 --- a/model/src/PDLIB/yowpdlibmain.F90 +++ b/model/src/PDLIB/yowpdlibmain.F90 @@ -65,17 +65,17 @@ module yowpdlibMain subroutine initFromGridDim(MNP, MNE, INE_global, secDim, MPIcomm) use mpi_f08, only: MPI_COMM use yowDatapool, only: myrank, debugPrePartition, debugPostPartition - use yowNodepool, only: np_global, np, np_perProcSum, ng, ipgl, iplg, npa + use yowNodepool, only: np_global, np, np_perProcSum, ng use yowElementpool, only: ne_global,ne use yowSidepool, only: ns, ns_global use yowExchangeModule, only: nConnDomains, setDimSize - use yowRankModule, only: initRankModule, ipgl_npa + use yowRankModule, only: initRankModule integer, intent(in) :: MNP, MNE integer, intent(in) :: INE_global(3,MNE) integer, intent(in) :: secDim type(MPI_COMM), intent(in) :: MPIcomm - integer :: istat, memunit + integer :: memunit ! note: myrank=0 until after initMPI is called, so only rank=0 file ! contains the 'section 1' information @@ -433,12 +433,16 @@ subroutine runParmetis(MNP) ! Parmetis ! Node neighbor information integer :: wgtflag, numflag, ndims, nparts, edgecut, ncon - integer, allocatable :: xadj(:), part(:), vwgt(:), adjwgt(:), vtxdist(:), options(:), adjncy(:), iweights(:) + integer, allocatable :: xadj(:), part(:), vwgt(:), adjwgt(:), vtxdist(:), options(:), adjncy(:) +#ifdef WEIGHTS + integer, allocatable :: iweights(:) + integer :: itmp + logical :: lexist = .false. +#endif ! parmetis need single precision real(4), allocatable :: xyz(:), tpwgts(:), ubvec(:) - integer :: IP_glob, itmp + integer :: IP_glob integer :: ref - logical :: lexist = .false. ! Node to domain mapping. ! np_global long. give the domain number for die global node number integer, allocatable :: node2domain(:) @@ -1018,7 +1022,7 @@ end subroutine findGhostNodes subroutine findConnDomains use yowerr, only: parallel_abort use yowNodepool, only: ghosts, ng, t_Node - use yowDatapool, only: nTasks, myrank + use yowDatapool, only: nTasks use yowExchangeModule, only: neighborDomains, initNbrDomains integer :: i, stat, itemp @@ -1102,7 +1106,7 @@ end subroutine findConnDomains subroutine exchangeGhostIds use yowerr use yowNodepool, only: np, t_node, nodes - use yowDatapool, only: nTasks, myrank, comm + use yowDatapool, only: myrank, comm use yowExchangeModule, only: neighborDomains, nConnDomains, createMPITypes use mpi_f08 @@ -1232,7 +1236,7 @@ subroutine postPartition2(INE_global) use yowElementpool, only: ne, ne_global, INE, belongto, ielg use yowerr, only: parallel_abort use yowDatapool, only: myrank - use yowNodepool, only: np_global, np, nodes_global, iplg, t_Node, ghostlg, ng, npa + use yowNodepool, only: np, nodes_global, iplg, t_Node, ghostlg, ng, npa use yowNodepool, only: x, y, z use w3gdatmd, only: xgrd, ygrd, zb @@ -1352,12 +1356,11 @@ end subroutine postPartition2 !* * !********************************************************************** subroutine ComputeTRIA_IEN_SI_CCON - use yowElementpool, only: ne, ne_global, INE, ielg + use yowElementpool, only: ne, INE use yowExchangeModule, only : PDLIB_exchange1Dreal use yowerr, only: parallel_abort - use yowDatapool, only: myrank - use yowNodepool, only: np_global, np, iplg, t_Node, ghostlg, ng, npa - use yowNodepool, only: x, y, z, PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, PDLIB_CCON, PDLIB_TRIA03 + use yowNodepool, only: t_Node, npa + use yowNodepool, only: x, y, PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, PDLIB_CCON, PDLIB_TRIA03 integer I1, I2, I3, stat, IE, NI(3) real :: DXP1, DXP2, DXP3, DYP1, DYP2, DYP3, DBLTMP, TRIA03 @@ -1452,10 +1455,9 @@ end subroutine CORRECT_DX_GT180 !* * !********************************************************************** subroutine ComputeIA_JA_POSI_NNZ - use yowElementpool, only: ne, ne_global, INE, ielg + use yowElementpool, only: ne, INE use yowerr, only: parallel_abort - use yowDatapool, only: myrank - use yowNodepool, only: np_global, np, nodes_global, iplg, t_Node, ghostlg, ng, npa + use yowNodepool, only: t_Node, npa use yowNodepool, only: PDLIB_CCON, PDLIB_IA, PDLIB_JA, PDLIB_JA_IE, PDLIB_IA_P, PDLIB_JA_P use yowNodepool, only: PDLIB_NNZ, PDLIB_POSI, PDLIB_IE_CELL, PDLIB_POS_CELL, PDLIB_IE_CELL2 use yowNodepool, only: PDLIB_POS_CELL2, PDLIB_I_DIAG diff --git a/model/src/PDLIB/yowrankModule.F90 b/model/src/PDLIB/yowrankModule.F90 index 8674ae6e3b..208cf7ea78 100644 --- a/model/src/PDLIB/yowrankModule.F90 +++ b/model/src/PDLIB/yowrankModule.F90 @@ -73,7 +73,7 @@ module yowRankModule !> allocate and exchange subroutine initRankModule() - use yowDatapool, only: nTasks, myrank + use yowDatapool, only: nTasks implicit none integer :: stat @@ -235,7 +235,7 @@ end subroutine exchangeIPLG !> \internal subroutine calcISTART() - use yowDatapool, only: nTasks, myrank + use yowDatapool, only: nTasks implicit none integer :: ir From 15ef5c98454422bff424f463b24d19f40497ad50 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 6 Feb 2026 16:57:47 -0500 Subject: [PATCH 131/136] Remove remaining compiler remarks in w3initmd, w3iobcmd, w3parall, (#1566) w3strkmd, w3triamd, w3wavemd, and w3wdatmd --- model/src/w3initmd.F90 | 34 ++++++++++++++-------------------- model/src/w3iobcmd.F90 | 2 ++ model/src/w3parall.F90 | 13 ++++--------- model/src/w3strkmd.F90 | 3 +-- model/src/w3triamd.F90 | 7 +------ model/src/w3wavemd.F90 | 23 +++++++++++------------ model/src/w3wdatmd.F90 | 7 +------ 7 files changed, 34 insertions(+), 55 deletions(-) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 629d392b49..2fc3741e88 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -421,16 +421,13 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, USE W3DISPMD, ONLY: WAVNU1, WAVNU3 USE W3PARALL, ONLY: SET_UP_NSEAL_NSEALM #ifdef W3_PDLIB - USE W3PARALL, ONLY: SYNCHRONIZE_IPGL_ETC_ARRAY, ISEA_TO_JSEA - use yowNodepool, only: npa - use yowRankModule, only : rank + USE W3PARALL, ONLY: SYNCHRONIZE_IPGL_ETC_ARRAY #endif USE W3GDATMD, ONLY: GTYPE, UNGTYPE #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, ONLY : PDLIB_MAPSTA_INIT, SET_IOBDP_PDLIB, PDLIB_IOBP_INIT, SET_IOBPA_PDLIB USE PDLIB_W3PROFSMD, ONLY : BLOCK_SOLVER_INIT, BLOCK_SOLVER_EXPLICIT_INIT, PDLIB_INIT, DEALLOCATE_PDLIB_GLOBAL USE W3GDATMD, ONLY : FSREFRACTION, FSFREQSHIFT - use yowDatapool, only: istatus #endif #ifdef W3_SETUP USE W3WAVSET, ONLY : PREPARATION_FD_SCHEME @@ -519,9 +516,6 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #endif CHARACTER(LEN=23) :: DTME21 CHARACTER(LEN=30) :: LFILE, TFILE -#ifdef W3_PDLIB - INTEGER :: IScal(1), IPROC -#endif integer :: memunit !/ !/ ------------------------------------------------------------------- / @@ -2122,7 +2116,7 @@ SUBROUTINE W3MPIO ( IMOD ) #endif !/ #ifdef W3_MPI - USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF, USSPF + USE W3GDATMD, ONLY: NSPEC, E3DF, P2MSF USE W3WDATMD, ONLY: VA, UST, USTDIR, ASF, FPIS, ICEF USE W3ADATMD, ONLY: MPI_COMM_WAVE, WW3_FIELD_VEC, NSEALM USE W3ADATMD, ONLY: HS, WLM, T02 @@ -2131,7 +2125,7 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI USE W3ADATMD, ONLY: T0M1, THM, THS, FP0, THP0, & - DTDYN, FCUT, SPPNT, ABA, ABD, UBA, UBD, & + DTDYN, FCUT, ABA, ABD, UBA, UBD, & SXX, SYY, SXY, USERO, PHS, PTP, PLP, & PDIR, PSI, PWS, PWST, PNR, PHIAW, PHIOC, & TUSX, TUSY, TAUWIX, TAUWIY, TAUOX, & @@ -2150,17 +2144,15 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI USE W3GDATMD, ONLY: NK - USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NTPROC, FLOUT, & - NAPFLD, NAPPNT, NAPRST, NAPBPT, NAPTRK, & + USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, FLOUT, & + NAPFLD, NAPRST, NAPBPT, NAPTRK, & NOGRP, NGRPP, NOGE, FLOGRR USE W3ODATMD, ONLY: OUTPTS, NRQGO, NRQGO2, IRQGO, IRQGO2, & - FLOGRD, NRQPO, NRQPO2, IRQPO1, IRQPO2, & - NOPTS, IPTINT, NRQRS, IRQRS, NBLKRS, & + FLOGRD, NRQRS, IRQRS, NBLKRS, & RSBLKS, IRQRSS, VAAUX, NRQBP, NRQBP2, & IRQBP1, IRQBP2, NFBPO, NBO2, ISBPO, & ABPOS, NRQTR, IRQTR, IT0PNT, IT0TRK, & - IT0PRT, NOSWLL, NOEXTR, NDSE, IOSTYP, & - FLOGR2 + IT0PRT, NOSWLL, NOEXTR, NDSE, IOSTYP, FLOGR2 USE W3PARALL, ONLY : INIT_GET_JSEA_ISPROC USE CONSTANTS, ONLY: LPDLIB #endif @@ -2181,9 +2173,8 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPI INTEGER :: IK, IFJ INTEGER :: IH, IT0, IROOT, IT, IERR, I0, & - IFROM, IX(4), IY(4), IS(4), & - IP(4), I, J, JSEA, ITARG, IB, & - JSEA0, JSEAN, NSEAB, IBOFF, & + IFROM, I, J, JSEA, ITARG, IB, & + JSEA0, JSEAN, NSEAB, IBOFF, & ISEA, ISPROC, K, NRQMAX #endif #ifdef W3_S @@ -5450,13 +5441,16 @@ SUBROUTINE W3MPIP ( IMOD ) #ifdef W3_MPI USE W3SERVMD, ONLY: EXTCDE !/ - USE W3GDATMD, ONLY: NX, NY, NSPEC, MAPFS + USE W3GDATMD, ONLY: NSPEC, MAPFS USE W3WDATMD, ONLY: VA USE W3ADATMD, ONLY: MPI_COMM_WAVE, SPPNT - USE W3ODATMD, ONLY: NDST, NDSE, IAPROC, NAPROC, NAPPNT, FLOUT + USE W3ODATMD, ONLY: NDSE, IAPROC, NAPPNT USE W3ODATMD, ONLY: OUTPTS, NRQPO, NRQPO2, IRQPO1, IRQPO2, & NOPTS, IPTINT, IT0PNT, IT0TRK, O2IRQI USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC +#endif +#ifdef W3_MPIT + USE W3ODATMD, ONLY: NDST #endif !/ #ifdef W3_MPI diff --git a/model/src/w3iobcmd.F90 b/model/src/w3iobcmd.F90 index aa88d7fe05..509241e358 100644 --- a/model/src/w3iobcmd.F90 +++ b/model/src/w3iobcmd.F90 @@ -229,7 +229,9 @@ SUBROUTINE W3IOBC ( INXOUT, NDSB, TIME1, TIME2, IOTST, IMOD ) USE W3GDATMD, ONLY: PoLat, PoLon, AnglD, NX, NY, X0, Y0, SX, SY USE W3SERVMD, ONLY: W3LLTOEQ, W3EQTOLL, W3ACTURN #endif +#ifdef W3_SHRD USE W3WDATMD, ONLY: VA +#endif USE W3ADATMD, ONLY: CG USE W3ODATMD, ONLY: NDSE, NDST, IAPROC, NAPERR, NAPBPT, & NBI, NBI2, NFBPO, NBO, NBO2, NDSL, & diff --git a/model/src/w3parall.F90 b/model/src/w3parall.F90 index 9ed33de8b7..6ce9a7d707 100644 --- a/model/src/w3parall.F90 +++ b/model/src/w3parall.F90 @@ -959,7 +959,7 @@ SUBROUTINE SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) USE yowNodepool, only: np_global USE W3ODATMD, ONLY: NTPROC, NAPROC, IAPROC USE W3GDATMD, ONLY: MAPSF, NSEA - USE W3ADATMD, ONLY: MPI_COMM_WAVE, MPI_COMM_WCMP + USE W3ADATMD, ONLY: MPI_COMM_WAVE USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot USE WMMDATMD, ONLY: MDATAS #endif @@ -1078,14 +1078,9 @@ SUBROUTINE SET_UP_NSEAL_NSEALM(NSEALout, NSEALMout) !/ !/ ------------------------------------------------------------------- / #ifdef W3_PDLIB - use yowDatapool, only: istatus - use yowNodepool, only: npa use yowRankModule, only : rank USE W3GDATMD, ONLY: GTYPE, UNGTYPE #endif -#ifdef W3_MPI - USE W3ADATMD, ONLY: MPI_COMM_WAVE, MPI_COMM_WCMP -#endif #ifdef W3_DIST USE CONSTANTS, ONLY : LPDLIB #endif @@ -1207,7 +1202,7 @@ SUBROUTINE INIT_GET_JSEA_ISPROC(ISEA, JSEA, ISPROC) USE W3ODATMD, ONLY: NAPROC USE W3GDATMD, ONLY: UNGTYPE #ifdef W3_PDLIB - USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot + USE yowRankModule, only : IPGL_TO_PROC use yowNodepool, only: ipgl, iplg USE W3ODATMD, ONLY: IAPROC USE W3GDATMD, ONLY: MAPSF @@ -1321,7 +1316,7 @@ SUBROUTINE GET_JSEA_IBELONG(ISEA, JSEA, IBELONG) USE W3GDATMD, ONLY: UNGTYPE USE CONSTANTS, ONLY : LPDLIB #ifdef W3_PDLIB - USE yowRankModule, only : IPGL_TO_PROC, IPGL_tot, IPGL_npa + USE yowRankModule, only : IPGL_npa use yowNodepool, only: ipgl, iplg USE W3GDATMD, ONLY: MAPSF, GTYPE #endif @@ -1578,7 +1573,7 @@ SUBROUTINE SYNCHRONIZE_GLOBAL_ARRAY(TheVar) ! USE W3GDATMD, ONLY: NX #ifdef W3_PDLIB - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC + USE W3ODATMD, only : IAPROC, NAPROC USE W3ADATMD, ONLY: MPI_COMM_WCMP use yowDatapool, only: rtype, istatus USE yowNodepool, only: npa diff --git a/model/src/w3strkmd.F90 b/model/src/w3strkmd.F90 index c10e02d30f..d5bc4d8b8c 100644 --- a/model/src/w3strkmd.F90 +++ b/model/src/w3strkmd.F90 @@ -432,10 +432,9 @@ SUBROUTINE waveTracking_NWS_V2 (intype ,tmax , & LOGICAL :: endloop #ifdef W3_MPI - INTEGER :: rank, irank, nproc, EXTENT, DOMSIZE, tag1, tag2, ic + INTEGER :: rank, irank, nproc, DOMSIZE, tag1, tag2, ic ! INTEGER :: MPI_INT_DOMARR, MPI_REAL_DOMARR type(MPI_STATUS) :: MPI_STAT - INTEGER :: REQ(16) ! INTEGER :: ISTAT(MPI_STATUS_SIZE,16) REAL :: COMMARR1(44) INTEGER :: COMMARR2(11) diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index df5a145381..7c286ddb4e 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -549,11 +549,6 @@ SUBROUTINE GET_BOUNDARY_STATUS(STATUS) USE W3SERVMD, ONLY: STRACE #endif ! - -#ifdef W3_PDLIB - use yowElementpool, only: ne_global - use yowNodepool, only: np_global -#endif USE W3GDATMD, ONLY : TRIGP, NTRI, NX IMPLICIT NONE !/ @@ -2073,7 +2068,7 @@ SUBROUTINE UG_GRADIENTS (PARAM, DIFFX, DIFFY) FLAGLL, IEN, TRIA, NTRI #ifdef W3_PDLIB USE yowElementpool - use yowNodepool, only: PDLIB_IEN, PDLIB_TRIA, NPA + use yowNodepool, only: PDLIB_IEN, PDLIB_TRIA USE yowExchangeModule, only : PDLIB_exchange1Dreal USE W3GDATMD, ONLY : NSEAL #endif diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 5dc6eb0733..7a2a39189e 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -448,11 +448,13 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USE W3SRCEMD, ONLY : W3SRCE !/ #ifdef W3_MPI - USE W3ODATMD, ONLY : NRQGO, NRQGO2, IRQGO, IRQGO2, NRQPO, NRQPO2, & - IRQPO1, IRQPO2 + USE W3ODATMD, ONLY : NRQGO, NRQGO2, IRQGO, IRQGO2, NRQPO, IRQPO1 USE W3ODATMD, ONLY : NRQRS, IRQRS, IRQPO1, NRQBP, IRQBP1, IRQBP2, & NRQBP2 - USE W3ADATMD, ONLY : NRQSG1, IRQSG1, NRQSG1, MPI_COMM_WAVE + USE W3ADATMD, ONLY : NRQSG1, IRQSG1, NRQSG1 +#endif +#if defined(W3_MPI) && defined(W3_SMC) + USE W3ADATMD, ONLY : MPI_COMM_WAVE #endif #ifdef W3_NL5 USE W3ODATMD, ONLY : TOSNL5 @@ -507,11 +509,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & USE PDLIB_W3PROFSMD, only : APPLY_BOUNDARY_CONDITION_VA USE PDLIB_W3PROFSMD, only : PDLIB_W3XYPUG, PDLIB_W3XYPUG_BLOCK_IMPLICIT, PDLIB_W3XYPUG_BLOCK_EXPLICIT USE PDLIB_W3PROFSMD, only : ALL_VA_INTEGRAL_PRINT, ALL_VAOLD_INTEGRAL_PRINT, ALL_FIELD_INTEGRAL_PRINT - USE W3PARALL, only : PDLIB_NSEAL, PDLIB_NSEALM - USE yowNodepool, only: npa, iplg, np + USE yowNodepool, only: np USE W3WDATMD, ONLY : VAOLD, VSTOT, VDTOT, SHAVETOT USE W3GDATMD, ONLY : FSSOURCE, FSTOTALEXP - USE W3GDATMD, ONLY : IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, ONLY : IOBP_LOC, IOBPA_LOC, IOBDP_LOC #endif !/ USE W3SERVMD, ONLY : EXTCDE, WWTIME @@ -550,7 +551,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PDLIB USE PDLIB_FIELD_VEC, only : DO_OUTPUT_EXCHANGES - USE PDLIB_W3PROFSMD, ONLY: ASPAR_JAC, ASPAR_DIAG_ALL, B_JAC + USE PDLIB_W3PROFSMD, ONLY: ASPAR_JAC, B_JAC USE W3PARALL, only : LSLOC #endif #ifdef W3_TIMINGS @@ -658,7 +659,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CHARACTER(LEN=16) :: OUTID CHARACTER(LEN=23) :: IDTIME #ifdef W3_PDLIB - REAL :: VS_SPEC(NSPEC), VD_SPEC(NSPEC) REAL :: DTGpre INTEGER :: IP #endif @@ -3108,8 +3108,10 @@ SUBROUTINE W3GATH ( ISPEC, FIELD ) #ifdef W3_MPI USE W3ADATMD, ONLY: MPIBUF, BSTAT, IBFLOC, ISPLOC, BISPL, & NSPLOC, NRQSG2, IRQSG2, GSTORE - USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NOTYPE USE W3GDATMD, ONLY: NSEAL, NSPEC +#endif +#ifdef W3_MPIT + USE W3ODATMD, ONLY: NDST #endif !/ ! @@ -3424,9 +3426,6 @@ SUBROUTINE W3SCAT ( ISPEC, MAPSTA, FIELD ) #endif #ifdef W3_MPIT USE W3ODATMD, ONLY: NDST -#endif -#ifdef W3_MPI - USE W3ODATMD, ONLY: IAPROC, NAPROC #endif USE W3PARALL, only: INIT_GET_ISEA !/ diff --git a/model/src/w3wdatmd.F90 b/model/src/w3wdatmd.F90 index a560063152..6d58079e69 100644 --- a/model/src/w3wdatmd.F90 +++ b/model/src/w3wdatmd.F90 @@ -421,9 +421,7 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) USE W3GDATMD, ONLY: QI5NNZ #endif #ifdef W3_PDLIB - use yowNodepool, only: npa, np - use yowRankModule, only : rank - USE W3GDATMD, ONLY: GTYPE, UNGTYPE + USE W3GDATMD, ONLY: UNGTYPE #endif #ifdef W3_S USE W3SERVMD, ONLY: STRACE @@ -443,9 +441,6 @@ SUBROUTINE W3DIMW ( IMOD, NDSE, NDST, F_ONLY ) !/ INTEGER :: JGRID, NSEALM, NSEATM INTEGER :: NSEAL_DUMMY, ISEA -#ifdef W3_PDLIB - INTEGER IRANK -#endif #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif From 57f0705566b97aafcf7ab10c3f698514c641f450 Mon Sep 17 00:00:00 2001 From: mingchen-NOAA Date: Fri, 6 Feb 2026 19:01:07 -0500 Subject: [PATCH 132/136] Fix remaining compiler remarks in w3profsmd_pdlib.F90 and pdlib_field_vec.F90(#1567) --- model/src/pdlib_field_vec.F90 | 57 ++- model/src/w3profsmd_pdlib.F90 | 656 +++++++++++++++++----------------- 2 files changed, 356 insertions(+), 357 deletions(-) diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index 2450fcff69..38c157fc74 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -444,16 +444,15 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) use yowDatapool, only: istatus USE W3GDATMD, only : NSEA, NSPEC - USE W3ODATMD, only : NAPROC, NTPROC, IAPROC + USE W3ODATMD, only : NAPROC, IAPROC USE W3ADATMD, only : MPI_COMM_WAVE USE W3PARALL, only : GET_JSEA_IBELONG USE W3WDATMD, ONLY : VA - USE W3GDATMD, ONLY: NSEAL USE W3ADATMD, ONLY: NSEALM #ifdef W3_TIMINGS USE W3PARALL, ONLY: PRINT_MY_TIME #endif - use yowNodepool, only: ListNP, ListNPA, ListIPLG + use yowNodepool, only: ListNPA, ListIPLG use mpi_f08 IMPLICIT NONE !/ @@ -472,8 +471,8 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) ! INTEGER, intent(in) :: NDREAD INTEGER iBlock, iFirst, iEnd, len, i, IB, iProc - INTEGER NREC, ISEA, JSEA, ierr - INTEGER nbBlock, IBELONG + INTEGER NREC, ISEA, ierr + INTEGER nbBlock INTEGER :: BlockSize REAL, allocatable :: ArrSend(:,:) REAL, allocatable :: DataRead(:,:) @@ -481,8 +480,7 @@ SUBROUTINE UNST_PDLIB_READ_FROM_FILE(NDREAD) integer LRECL INTEGER, PARAMETER :: LRB = 4 INTEGER NBLKRSloc, RSBLKSloc - integer eArr(1) - integer IERR_MPI, istat + integer istat integer IPloc, IPglob, pos integer NbMatch, idx integer ListFirst(NAPROC) @@ -654,14 +652,14 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) #endif ! use yowDatapool, only: istatus - USE yowNodepool, only: ListNP, ListNPA, ListIPLG + USE yowNodepool, only: ListNPA, ListIPLG USE W3PARALL, ONLY: INIT_GET_ISEA USE W3GDATMD, only : NSEA, NSPEC - USE W3ODATMD, only : NAPROC, NTPROC, NAPRST, IAPROC + USE W3ODATMD, only : NAPROC, NAPRST, IAPROC USE W3ADATMD, only : MPI_COMM_WAVE USE W3PARALL, only : GET_JSEA_IBELONG USE W3WDATMD, ONLY : VA - USE W3GDATMD, ONLY: NSEAL, NX, NY + USE W3GDATMD, ONLY: NSEAL use mpi_f08 IMPLICIT NONE !/ @@ -683,8 +681,8 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) REAL :: DATAwrite(NSPEC,BlockSize) REAL, allocatable :: DATArecv(:,:) integer ListFirst(NAPROC) - integer idx, idxB - integer len, i, IS + integer idx + integer len integer iBlock, iFirst, iEnd integer IPglob, IPloc, pos, ISEA, nbBlock, NPAloc integer ierr, istat, JSEA, NREC, iProc @@ -692,7 +690,6 @@ SUBROUTINE UNST_PDLIB_WRITE_TO_FILE(NDWRITE) INTEGER, PARAMETER :: LRB = 4 INTEGER(KIND=8) RPOS INTEGER LRECL - INTEGER IERR_MPI REAL(KIND=LRB) WRITEBUFF(NSPEC) REAL, allocatable :: DATAsend(:,:) #ifdef W3_S @@ -809,12 +806,12 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) ! USE W3ADATMD, ONLY: W3XDMA, W3SETA, W3XETA, WADATS USE W3GDATMD, ONLY: NSEA - USE W3GDATMD, ONLY: NX, NSPEC, MAPFS, E3DF, P2MSF, US3DF - USE W3WDATMD, ONLY: VA, UST, USTDIR, ASF, FPIS - USE W3ADATMD, ONLY: MPI_COMM_WAVE, WW3_FIELD_VEC + USE W3GDATMD, ONLY: NSPEC, E3DF, P2MSF + USE W3WDATMD, ONLY: UST, USTDIR, ASF + USE W3ADATMD, ONLY: MPI_COMM_WAVE USE W3ADATMD, ONLY: HS, WLM, T02 USE W3ADATMD, ONLY: T0M1, THM, THS, FP0, THP0, & - DTDYN, FCUT, SPPNT, ABA, ABD, UBA, UBD,& + DTDYN, FCUT, ABA, ABD, UBA, UBD, & SXX, SYY, SXY, USERO, PHS, PTP, PLP, & PDIR, PSI, PWS, PWST, PNR, PHIAW, & PHIOC, TAUOCX, TAUOCY, WNMEAN, & @@ -826,22 +823,14 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) BEDFORMS, PHIBBL, TAUBBL, T01, & P2SMS, US3D, EF, TH1M, STH1M, TH2M, & STH2M, HSIG, TAUICE, PHICE, PTHP0, PQP,& - PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & + PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & QP, MSSD, MSCD, STMAXE, STMAXD, HMAXE, & HCMAXE, HMAXD, HCMAXD, WBT, USSP USE W3GDATMD, ONLY: NK, NSEAL - USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, NTPROC, FLOUT, & - NAPFLD, NAPPNT, NAPRST, NAPBPT, NAPTRK,& - NOGRP, NGRPP - USE W3ODATMD, ONLY: OUTPTS, NRQGO, NRQGO2, IRQGO, IRQGO2, & - FLOGRD, NRQPO, NRQPO2, IRQPO1, IRQPO2, & - NOPTS, IPTINT, NRQRS, IRQRS, NBLKRS, & - RSBLKS, IRQRSS, VAAUX, NRQBP, NRQBP2, & - IRQBP1, IRQBP2, NFBPO, NBO2, ISBPO, & - ABPOS, NRQTR, IRQTR, IT0PNT, IT0TRK, & - IT0PRT, NOSWLL, NOEXTR, NDSE, IOSTYP, & - FLOGR2 - USE W3ADATMD, ONLY: MPI_COMM_WCMP + USE W3ODATMD, ONLY: NDST, IAPROC, NAPROC, FLOUT, & + NAPFLD, NOGRP, NGRPP + USE W3ODATMD, ONLY: NRQGO, NRQGO2, FLOGRD, & + NOSWLL, NOEXTR, NDSE, FLOGR2 USE W3PARALL, ONLY: INIT_GET_JSEA_ISPROC USE W3PARALL, ONLY: INIT_GET_ISEA use yowDatapool, only: istatus @@ -858,12 +847,8 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IK, IFJ - INTEGER :: IH, IT0, IROOT, IT, IERR, I0, & - IFROM, IX(4), IY(4), IS(4), & - IP(4), I, J, JSEA, ITARG, IB, & - JSEA0, JSEAN, NSEAB, IBOFF, & - ISEA, ISPROC, K, NRQMAX + INTEGER :: IK + INTEGER :: IH, IT0, IROOT, IERR, I, J, JSEA, ISEA, K #ifdef W3_S INTEGER, SAVE :: IENT #endif diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 3d5843d9ca..1f4b17a688 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -191,23 +191,23 @@ SUBROUTINE PDLIB_INIT(IMOD) ! USE W3GDATMD, only: FLCX, FLCY USE CONSTANTS, only : GRAV, TPI - USE W3GDATMD, only: XGRD, YGRD, NX, NSEA, NTRI, TRIGP, NSPEC, NSEAL - USE W3GDATMD, only: MAPSTA, MAPFS, GRIDS, NTH, SIG, NK - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: CCON, COUNTCON, INDEX_CELL, IE_CELL - USE W3GDATMD, only: IOBP, IOBPA, IOBPD, IOBDP, SI - + USE W3GDATMD, only: XGRD, YGRD, NX, NSEA, NTRI, TRIGP, NSPEC + USE W3GDATMD, only: MAPFS, GRIDS, NTH, SIG, NK USE W3ADATMD, only: MPI_COMM_WCMP, MPI_COMM_WAVE USE W3ODATMD, only: IAPROC, NAPROC, NTPROC USE yowDatapool, only: istatus USE yowpdlibMain, only: initFromGridDim - USE YOWNODEPOOL, only: npa, np, iplg + USE YOWNODEPOOL, only: npa, iplg +#ifdef W3_DEBUGSOLVER + USE YOWNODEPOOL, only: np +#endif USE W3PARALL, only : PDLIB_NSEAL, PDLIB_NSEALM USE W3PARALL, only : JX_TO_JSEA, ISEA_TO_JSEA USE yowfunction, only : ComputeListNP_ListNPA_ListIPLG, pdlib_abort - USE W3GDATMD, only: FSTOTALIMP, FSTOTALEXP, FSNIMP, FSN, FSPSI, FSFCT - USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FSSOURCE - + USE W3GDATMD, only: FSTOTALEXP +#ifdef W3_DEBUGSOLVER + USE W3GDATMD, only: NSEAL +#endif !/ use mpi_f08 !/ @@ -225,7 +225,7 @@ SUBROUTINE PDLIB_INIT(IMOD) !/ !! use mpi_f08 INTEGER :: istat - INTEGER :: I, J, IBND_MAP, ISEA, IP, IX, JSEA, nb + INTEGER :: ISEA, IP, IX, JSEA, nb INTEGER :: IP_glob INTEGER :: myrank, ierr, iproc INTEGER, ALLOCATABLE :: NSEAL_arr(:) @@ -233,7 +233,6 @@ SUBROUTINE PDLIB_INIT(IMOD) INTEGER :: IScal(1) INTEGER, INTENT(in) :: IMOD INTEGER :: IK, ISP - INTEGER IK0, ISP0, ITH REAL :: eSIG, eFR REAL, PARAMETER :: COEF4 = 5.0E-7 #ifdef W3_S @@ -448,12 +447,11 @@ SUBROUTINE PDLIB_MAPSTA_INIT(IMOD) USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only : INDEX_MAP, NBND_MAP, NSEA, NSEAL, MAPSTA, GRIDS, NX, NTH - USE W3GDATMD, only : MAPSTA_LOC, NBND_MAP, INDEX_MAP + USE W3GDATMD, only : INDEX_MAP, NBND_MAP, NSEAL, MAPSTA, GRIDS, NX + USE W3GDATMD, only : MAPSTA_LOC USE W3ODATMD, only : IAPROC, NAPROC USE YOWNODEPOOL, only: iplg, npa USE yowfunction, only: pdlib_abort - USE W3ODATMD, only: IAPROC !/ !/ !/ ------------------------------------------------------------------- / @@ -468,10 +466,9 @@ SUBROUTINE PDLIB_MAPSTA_INIT(IMOD) !/ !/ ------------------------------------------------------------------- / !/ - INTEGER :: IBND_MAP, ISEA, JSEA, IX, IP, IP_glob + INTEGER :: IBND_MAP, IX, IP, IP_glob INTEGER, INTENT(in) :: IMOD INTEGER :: Status(NX), istat - REAL :: rtmp(nseal) #ifdef W3_S CALL STRACE (IENT, 'PDLIB_MAPSTA_INIT') #endif @@ -563,13 +560,12 @@ SUBROUTINE PDLIB_IOBP_INIT(IMOD) USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only : INDEX_MAP, NBND_MAP, NSEA, NSEAL, GRIDS, NX, NTH - USE W3GDATMD, only : IOBP, IOBDP, IOBPA, IOBPD, NBND_MAP, INDEX_MAP + USE W3GDATMD, only : NSEAL, GRIDS, NTH + USE W3GDATMD, only : IOBP, IOBPD USE W3GDATMD, only : IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC USE W3ODATMD, only : IAPROC, NAPROC USE YOWNODEPOOL, only: iplg, npa USE yowfunction, only: pdlib_abort - USE W3ODATMD, only: IAPROC !/ !/ !/ ------------------------------------------------------------------- / @@ -584,10 +580,9 @@ SUBROUTINE PDLIB_IOBP_INIT(IMOD) !/ !/ ------------------------------------------------------------------- / !/ - INTEGER :: IBND_MAP, ISEA, JSEA, IX, IP, IP_glob + INTEGER :: IP, IP_glob INTEGER, INTENT(in) :: IMOD - INTEGER :: Status(NX), istat - REAL :: rtmp(nseal) + INTEGER :: istat #ifdef W3_S CALL STRACE (IENT, 'PDLIB_MAPSTA_INIT') #endif @@ -691,21 +686,23 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) ! USE W3TIMEMD, only: DSEC21 ! - USE W3GDATMD, only: NX, NY, MAPFS, CLATS, & - FLCX, FLCY, NK, NTH, DTH, XFR, & - ECOS, ESIN, SIG, PFMOVE, & - IOBP, IOBPD, & - FSN, FSPSI, FSFCT, FSNIMP, & - GTYPE, UNGTYPE, NBND_MAP, INDEX_MAP - USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: MAPFS, CLATS, & + NTH, ECOS, ESIN, FSN, FSPSI, FSFCT, FSNIMP, & + UNGTYPE, NBND_MAP, INDEX_MAP +#ifdef NOCGTABLE + USE W3GDATMD, only: SIG + USE W3ADATMD, only: DW +#endif + USE W3GDATMD, only: IOBP_LOC, IOBDP_LOC USE YOWNODEPOOL, only: iplg, npa USE W3WDATMD, only: TIME, VA USE W3ODATMD, only: TBPI0, TBPIN, FLBPI - USE W3ADATMD, only: CG, CX, CY, ITIME, DW - USE W3IDATMD, only: FLCUR, FLLEV + USE W3ADATMD, only: CG, CX, CY + USE W3IDATMD, only: FLCUR USE W3GDATMD, only: NSEAL +#ifdef W3_DEBUGSOLVER USE W3ODATMD, only: IAPROC +#endif USE W3DISPMD, only : WAVNU_LOCAL !/ ------------------------------------------------------------------- / !/ Parameter list @@ -713,15 +710,17 @@ SUBROUTINE PDLIB_W3XYPUG ( ISP, FACX, FACY, DTG, VGX, VGY, LCALC ) INTEGER, INTENT(IN) :: ISP REAL, INTENT(IN) :: FACX, FACY, DTG, VGX, VGY LOGICAL, INTENT(IN) :: LCALC - LOGICAL :: SCHEME !/ !/ ------------------------------------------------------------------- / !/ Local PARAMETERs !/ INTEGER :: ITH, IK, ISEA - INTEGER :: I, J, IE, IBND_MAP + INTEGER :: IBND_MAP INTEGER :: IP_glob - REAL :: CCOS, CSIN, CCURX, CCURY, WN1, CG1 + REAL :: CCOS, CSIN, CCURX, CCURY +#ifdef NOCGTABLE + REAL :: WN1, CG1 +#endif REAL :: C(npa,2) REAL :: RD1, RD2 !/ @@ -915,22 +914,25 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only: NK, NTH, NX, IEN, CLATS, MAPSF + USE W3GDATMD, only: NTH, CLATS, MAPSF USE W3GDATMD, only: IOBPD_LOC, IOBP_LOC, IOBDP_LOC, IOBPA_LOC, FSBCCFL - USE W3WDATMD, only: TIME - USE W3ADATMD, only: CG, ITER, DW , CFLXYMAX, NSEALM - USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ADATMD, only: CG, ITER, CFLXYMAX + USE W3ODATMD, only: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, only: DSEC21 USE W3ADATMD, only: MPI_COMM_WCMP - USE W3GDATMD, only: NSEAL, DMIN, NSEA #ifdef W3_REF1 USE W3GDATMD, only: REFPARS #endif - USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, ipgl, iplg, npa, np +#if defined(W3_REF1) || defined(W3__DEBUGSOLVER) + USE W3GDATMD, only: NX +#endif + USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, ipgl, iplg, npa, np use yowElementpool, only: ne, INE use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL +#ifdef W3_DEBUGSOLVER USE W3ODATMD, only : IAPROC +#endif use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, ZERO, THR @@ -956,7 +958,7 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) #ifdef W3_REF1 INTEGER(KIND=1) :: IOBPDR(NX) #endif - INTEGER :: IP, IE, POS, IT, I1, I2, I3, I, J, ITH, IK + INTEGER :: IP, IE, IT, I1, I2, I3, ITH, IK INTEGER :: IBI, NI(3) INTEGER :: JX ! @@ -967,8 +969,7 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) ! local double ! REAL :: UTILDE - REAL :: SUMTHETA - REAL :: FT, CFLXY + REAL :: CFLXY REAL :: FL11, FL12, FL21, FL22, FL31, FL32 REAL :: FL111, FL112, FL211, FL212, FL311, FL312 REAL :: DTSI(npa), U(npa) @@ -977,9 +978,11 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) REAL :: KELEM(3,NE), FLALL(3,NE) REAL :: KKSUM(npa), ST(npa) REAL :: NM(NE) - INTEGER :: ISPROC, JSEA, IP_glob, ierr, IX - REAL :: eSumAC, sumAC, sumBPI0, sumBPIN, sumCG, sumCLATS + INTEGER :: IP_glob, ierr +#ifdef W3_DEBUGSOLVER + REAL :: sumAC, sumBPI0, sumBPIN, sumCG, sumCLATS LOGICAL :: testWrite +#endif REAL :: FIN(1), FOUT(1) #ifdef W3_S CALL STRACE (IENT, 'W3XYPFSN') @@ -1243,22 +1246,26 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ ------------------------------------------------------------------- / - USE W3GDATMD, only: NK, NTH, NX, IEN, CLATS, MAPSF + USE W3GDATMD, only: NTH, CLATS, MAPSF USE W3GDATMD, only: IOBPD_LOC, IOBP_LOC, IOBDP_LOC, IOBPA_LOC, FSBCCFL - USE W3WDATMD, only: TIME - USE W3ADATMD, only: CG, ITER, DW , CFLXYMAX, NSEALM - USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ADATMD, only: CG, ITER, CFLXYMAX + USE W3ODATMD, only: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, only: DSEC21 USE W3ADATMD, only: MPI_COMM_WCMP - USE W3GDATMD, only: NSEAL, DMIN, NSEA #ifdef W3_REF1 USE W3GDATMD, only: REFPARS #endif - USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, ipgl, iplg, npa, np +#if defined(W3_REF1) || defined(W3__DEBUGSOLVER) + USE W3GDATMD, only: NX +#endif + + USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, ipgl, iplg, npa use yowElementpool, only: ne, INE use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL +#ifdef W3_DEBUGSOLVER USE W3ODATMD, only : IAPROC +#endif use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, ZERO, THR @@ -1284,23 +1291,25 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) #ifdef W3_REF1 INTEGER(KIND=1) :: IOBPDR(NX) #endif - INTEGER :: IP, IE, POS, IT, I1, I2, I3, I, J, ITH, IK + INTEGER :: IP, IE, IT, I1, I2, I3, ITH, IK INTEGER :: IBI, NI(3), JX - INTEGER :: ISPROC, IP_glob, JSEA, ierr + INTEGER :: IP_glob, ierr REAL :: RD1, RD2 REAL :: UTILDE - REAL :: SUMTHETA - REAL :: FL1, FL2, FL3 REAL :: FT, CFLXY REAL :: FL11, FL12, FL21, FL22, FL31, FL32 REAL :: FL111, FL112, FL211, FL212, FL311, FL312 REAL :: DTSI(npa), U(npa) REAL :: DTMAX, DTMAX_GL, DTMAXEXP, REST - REAL :: LAMBDA(2), KTMP(3), TMP(3) + REAL :: LAMBDA(2), KTMP(3) REAL :: THETA_L(3), BET1(3), BETAHAT(3) REAL :: KELEM(3,NE), FLALL(3,NE) REAL :: KKSUM(npa), ST(npa) REAL :: NM(NE), FIN(1), FOUT(1) +#ifdef W3_DEBUGSOLVER + LOGICAL :: testWrite +#endif + #ifdef W3_S CALL STRACE (IENT, 'W3XYPFSN') #endif @@ -1539,22 +1548,25 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ ------------------------------------------------------------------- / - USE W3GDATMD, only: NK, NTH, NX, IEN, CLATS, MAPSF + USE W3GDATMD, only: NTH, CLATS, MAPSF USE W3GDATMD, only: IOBPD_LOC, IOBP_LOC, IOBDP_LOC, IOBPA_LOC, FSBCCFL - USE W3WDATMD, only: TIME - USE W3ADATMD, only: CG, ITER, DW , CFLXYMAX, NSEALM - USE W3ODATMD, only: NDSE, NDST, FLBPI, NBI, TBPIN, ISBPI, BBPI0, BBPIN + USE W3ADATMD, only: CG, ITER, CFLXYMAX + USE W3ODATMD, only: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3TIMEMD, only: DSEC21 USE W3ADATMD, only: MPI_COMM_WCMP - USE W3GDATMD, only: NSEAL, DMIN, NSEA #ifdef W3_REF1 USE W3GDATMD, only: REFPARS #endif - USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, PDLIB_CCON, PDLIB_IE_CELL2, ipgl, iplg, npa, np +#if defined(W3_REF1) || defined(W3__DEBUGSOLVER) + USE W3GDATMD, only: NX +#endif + USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, ipgl, iplg, npa, np use yowElementpool, only: ne, INE use yowDatapool, only: rtype use yowExchangeModule, only : PDLIB_exchange1DREAL +#ifdef W3_DEBUGSOLVER USE W3ODATMD, only : IAPROC +#endif use mpi_f08, only : MPI_MIN, MPI_ALLREDUCE USE W3PARALL, only : INIT_GET_JSEA_ISPROC USE W3PARALL, only : ONESIXTH, ZERO, THR @@ -1581,7 +1593,7 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) #ifdef W3_REF1 INTEGER(KIND=1) :: IOBPDR(NX) #endif - INTEGER :: IP, IE, POS, IT, I1, I2, I3, I, J, ITH, IK + INTEGER :: IP, IE, IT, I1, I2, I3, ITH, IK INTEGER :: IBI, NI(3) INTEGER :: JX ! @@ -1591,7 +1603,7 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !: ! local double ! - REAL :: SUMTHETA, CFLXY + REAL :: CFLXY REAL*8 :: FT, UTILDE REAL*8 :: FL11, FL12, FL21, FL22, FL31, FL32 REAL*8 :: FL111, FL112, FL211, FL212, FL311, FL312 @@ -1601,11 +1613,13 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) REAL*8 :: KELEM(3,NE), FLALL(3,NE) REAL*8 :: KKSUM(npa), ST(npa) REAL*8 :: NM(NE), BET1(3), BETAHAT(3), TMP(3), TMP1 - INTEGER :: ISPROC, JSEA, IP_glob, ierr, IX - REAL :: eSumAC, sumAC, sumBPI0, sumBPIN, sumCG, sumCLATS + INTEGER :: IP_glob, ierr +#ifdef W3_DEBUGSOLVER + REAL :: sumAC, sumBPI0, sumBPIN, sumCG, sumCLATS LOGICAL :: testWrite +#endif REAL :: FIN(1), FOUT(1) - REAL :: UIP(NE), UIPIP(NPA), UIMIP(NPA), U3(3) + REAL :: UIP(NE) REAL*8 :: THETA_H(3), THETA_ACE(3,NE), THETA_L(3,NE) REAL*8 :: PM(NPA), PP(NPA), UIM(NE), WII(2,NPA) REAL :: USTARI(2,NPA) @@ -1910,9 +1924,9 @@ SUBROUTINE TEST_MPI_STATUS(string) !/ ------------------------------------------------------------------- / USE W3ADATMD, only : MPI_COMM_WCMP - USE W3GDATMD, only : GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus + USE W3GDATMD, only : UNGTYPE + USE W3ODATMD, only : IAPROC, NAPROC + use yowDatapool, only: istatus use mpi_f08 CHARACTER(*), INTENT(in) :: string @@ -1988,12 +2002,11 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintF ! !/ ------------------------------------------------------------------- / ! - USE W3GDATMD, only : NK, NTH, FTE - USE W3GDATMD, only : NSPEC, NX, NY, NSEAL, MAPFS + USE W3GDATMD, only : NX, NSEAL, MAPFS USE W3ADATMD, only : MPI_COMM_WCMP USE W3GDATMD, only : GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus + USE W3ODATMD, only : IAPROC, NAPROC + use yowDatapool, only: istatus USE YOWNODEPOOL, only: npa, iplg USE W3PARALL, only: INIT_GET_ISEA @@ -2012,9 +2025,8 @@ SUBROUTINE SCAL_INTEGRAL_PRINT_GENERAL(V, string, maxidx, CheckUncovered, PrintF INTEGER singV(2) REAL CoherencyError, eVal1, eVal2, eErr INTEGER NSEAL_dist, maxidx_dist - INTEGER JSEA, ISEA, iProc, I, IX, ierr, ISP, IP, IP_glob + INTEGER JSEA, ISEA, iProc, IX, ierr, IP, IP_glob INTEGER nbIncorr, idx - INTEGER ITH, IK IF (IAPROC .gt. NAPROC) THEN RETURN @@ -2264,7 +2276,6 @@ SUBROUTINE ALL_VAOLD_INTEGRAL_PRINT(string, choice) USE W3GDATMD, only : NSEAL USE W3WDATMD, only : VAOLD - USE W3ODATMD, only : IAPROC USE W3GDATMD, only : NSPEC USE YOWNODEPOOL, only: np, npa @@ -2334,10 +2345,10 @@ SUBROUTINE ALL_VA_INTEGRAL_PRINT(IMOD, string, choice) ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, only : NSEAL, NSEA, NX, NY + USE W3GDATMD, only : NSEAL, NX USE W3WDATMD, only : VA USE W3ODATMD, only : IAPROC, NAPROC - USE W3GDATMD, only : NSPEC, GRIDS, GTYPE, UNGTYPE + USE W3GDATMD, only : NSPEC, GRIDS, UNGTYPE USE YOWNODEPOOL, only: npa, np, iplg INTEGER, INTENT(in) :: IMOD @@ -2430,8 +2441,6 @@ SUBROUTINE ALL_FIELD_INTEGRAL_PRINT(FIELD, string) !/ ------------------------------------------------------------------- / USE W3GDATMD, only : NSEAL - USE W3WDATMD, only : VA - USE W3ODATMD, only : IAPROC USE W3GDATMD, only : NSPEC INTEGER maxidx @@ -2492,12 +2501,11 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinI ! !/ ------------------------------------------------------------------- / - USE W3GDATMD, only : NK, NTH - USE W3GDATMD, only : NSPEC, NX, NY, NSEAL, MAPFS + USE W3GDATMD, only : NSPEC, NX, NSEAL, MAPFS USE W3ADATMD, only : MPI_COMM_WCMP USE W3GDATMD, only : GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus + USE W3ODATMD, only : IAPROC, NAPROC + use yowDatapool, only: istatus USE YOWNODEPOOL, only: npa, iplg USE W3PARALL, only: INIT_GET_ISEA @@ -2512,13 +2520,12 @@ SUBROUTINE CHECK_ARRAY_INTEGRAL_NX_R8_MaxFunct(TheARR, string, maxidx, PrintMinI REAL eVal1, eVal2, eErr INTEGER LocateMax_I, LocateMax_ISP INTEGER rStatus(NX), Status(NX) - INTEGER JSEA, ISEA, iProc, I, IX, ierr, ISP, IP, IP_glob + INTEGER ISEA, iProc, I, IX, ierr, ISP, IP, IP_glob REAL :: mval, eVal, eSum REAL :: TheMax, TheSum, TheNb, TheAvg REAL :: eFact, Threshold LOGICAL :: IsFirst INTEGER nbIncorr, n_control - INTEGER ITH, IK INTEGER :: TEST_IP = 46 INTEGER :: TEST_ISP = 370 IF (IAPROC .gt. NAPROC) THEN @@ -2782,7 +2789,9 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_IMPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC ) USE W3SERVMD, only: STRACE #endif ! +#ifdef W3_DEBUGSOLVER USE W3ODATMD, only: IAPROC +#endif USE W3GDATMD, only: B_JGS_USE_JACOBI LOGICAL, INTENT(IN) :: LCALC @@ -2852,8 +2861,6 @@ SUBROUTINE PDLIB_W3XYPUG_BLOCK_EXPLICIT(IMOD, FACX, FACY, DTG, VGX, VGY, LCALC) USE W3SERVMD, only: STRACE #endif ! - USE W3ODATMD, only: IAPROC - USE W3GDATMD, only: B_JGS_USE_JACOBI USE W3TIMEMD, only: DSEC21 USE W3ODATMD, only: TBPI0, TBPIN, FLBPI USE W3WDATMD, only: TIME @@ -2931,11 +2938,10 @@ SUBROUTINE PRINT_WN_STATISTIC(string) USE W3GDATMD, only: NK USE W3ADATMD, only: WN USE W3GDATMD, only: NSEAL - USE YOWNODEPOOL, only: NP CHARACTER(*), INTENT(in) :: string REAL TotalSumDMM, eDMM, sumDMM - INTEGER IP, IK, ISEA + INTEGER IK, ISEA WRITE(740+IAPROC,*) 'PRINT_WN_STATISTIC' TotalSumDMM=0 DO ISEA=1,NSEAL @@ -3007,13 +3013,11 @@ SUBROUTINE WRITE_VAR_TO_TEXT_FILE(TheArr, eFile) USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only : NK, NTH - USE W3WDATMD, only : VA - USE W3GDATMD, only : NSPEC, NX, NY, NSEAL, MAPFS + USE W3GDATMD, only : NSPEC, NX USE W3ADATMD, only : MPI_COMM_WCMP USE W3GDATMD, only : GTYPE, UNGTYPE - USE W3ODATMD, only : IAPROC, NAPROC, NTPROC - use yowDatapool, only: rtype, istatus + USE W3ODATMD, only : IAPROC, NAPROC + use yowDatapool, only: istatus USE YOWNODEPOOL, only: npa, iplg, np USE W3PARALL, only: INIT_GET_ISEA @@ -3024,9 +3028,7 @@ SUBROUTINE WRITE_VAR_TO_TEXT_FILE(TheArr, eFile) REAL Vcoll(NSPEC,NX), VcollExp(NSPEC*NX), rVect(NSPEC*NX) REAL CoherencyError, eVal1, eVal2, eErr INTEGER rStatus(NX), Status(NX) - INTEGER JSEA, ISEA, iProc, I, IX, ierr, ISP, IP, IP_glob - INTEGER nbIncorr - INTEGER ITH, IK + INTEGER iProc, I, IX, ierr, ISP, IP, IP_glob INTEGER fhndl REAL eSum IF (IAPROC .gt. NAPROC) THEN @@ -3349,25 +3351,28 @@ SUBROUTINE calcARRAY_JACOBI(DTG,FACX,FACY,VGX,VGY) USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, FACHFA, DMIN - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: NSEAL, CLATS - USE W3GDATMD, only: MAPSTA + USE W3GDATMD, only: NTH, NSPEC + USE W3GDATMD, only: IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: CLATS +#ifdef W3_REF1 + USE W3GDATMD, only: IOBP_LOC +#endif USE W3WDATMD, only: VA - USE W3ADATMD, only: CG, DW, WN, CX, CY - USE W3IDATMD, only: FLCUR, FLLEV - USE W3GDATMD, only: ECOS, ESIN, MAPFS + USE W3ADATMD, only: CG, CX, CY + USE W3IDATMD, only: FLCUR + USE W3GDATMD, only: ECOS, ESIN USE W3PARALL, only : ONESIXTH, ZERO, THR use yowElementpool, only: ne, INE USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & - PDLIB_CCON, PDLIB_POS_CELL2, PDLIB_IE_CELL2, NP, NPA, & - PDLIB_IA_P, PDLIB_POSI, PDLIB_IA, PDLIB_NNZ, iplg, & - PDLIB_I_DIAG, PDLIB_JA + PDLIB_CCON, PDLIB_POS_CELL2, PDLIB_IE_CELL2, NPA, & + PDLIB_POSI, iplg +#ifdef W3_DEBUGSRC + USE YOWNODEPOOL, only: PDLIB_I_DIAG +#endif USE W3ODATMD, only : IAPROC USE W3PARALL, only : ZERO #ifdef W3_DB1 USE W3SDB1MD - USE W3GDATMD, only: SDBSC #endif #ifdef W3_BT1 USE W3SBT1MD @@ -3394,12 +3399,14 @@ SUBROUTINE calcARRAY_JACOBI(DTG,FACX,FACY,VGX,VGY) USE W3STR1MD #endif REAL, INTENT(in) :: DTG, FACX, FACY, VGX, VGY - INTEGER :: IP, ISP, ISEA, IP_glob - INTEGER :: idx, IS - INTEGER :: I, J, ITH, IK, J2 - INTEGER :: IE, POS, JSEA + INTEGER :: IP, ISP, IP_glob +#ifdef W3_MGP + INTEGER :: ISEA +#endif + INTEGER :: IS + INTEGER :: I, J, ITH, IK + INTEGER :: IE, POS INTEGER :: I1, I2, I3, NI(3) - INTEGER :: counter #ifdef W3_REF1 INTEGER :: eIOBPDR #endif @@ -3411,12 +3418,10 @@ SUBROUTINE calcARRAY_JACOBI(DTG,FACX,FACY,VGX,VGY) REAL :: CRFS(3), CXY(3,2) REAL :: KP(3,NSPEC,NE) REAL :: KM(3), K(3) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 + REAL :: K1 REAL :: DELTAL(3,NSPEC,NE) REAL :: NM(NSPEC,NE) - REAL :: TRIA03, SIDT, CCOS, CSIN - REAL :: SPEC(NSPEC), DEPTH + REAL :: TRIA03, CCOS, CSIN #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'calcARRAY_JACOBI, begin' @@ -3572,26 +3577,33 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, FACHFA, DMIN - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: NSEAL, CLATS - USE W3GDATMD, only: MAPSTA, SIG + USE W3GDATMD, only: NTH, NSPEC + USE W3GDATMD, only: IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: CLATS +#ifdef W3_REF1 + USE W3GDATMD, only: IOBP_LOC +#endif +#ifdef NOCGTABLE + USE W3GDATMD, only: SIG + USE W3ADATMD, only: DW +#endif USE W3WDATMD, only: VA - USE W3ADATMD, only: CG, DW, WN, CX, CY - USE W3IDATMD, only: FLCUR, FLLEV - USE W3GDATMD, only: ECOS, ESIN, MAPFS + USE W3ADATMD, only: CG, CX, CY + USE W3IDATMD, only: FLCUR + USE W3GDATMD, only: ECOS, ESIN USE W3PARALL, only : ONESIXTH, ZERO, THR use yowElementpool, only: ne, INE - USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & - PDLIB_IE_CELL2, PDLIB_POS_CELL2, PDLIB_CCON, NP, NPA, & - PDLIB_IA_P, PDLIB_POSI, PDLIB_IA, PDLIB_NNZ, iplg, & - PDLIB_I_DIAG, PDLIB_JA, PDLIB_TRIA03, PDLIB_SI + USE YOWNODEPOOL, only: PDLIB_IEN, & + PDLIB_IE_CELL2, PDLIB_POS_CELL2, PDLIB_CCON, NP, NPA, & + PDLIB_POSI, iplg, PDLIB_TRIA03 +#ifdef W3_DEBUGSRC + USE YOWNODEPOOL, only: PDLIB_I_DIAG +#endif USE W3ODATMD, only : IAPROC USE W3PARALL, only : ZERO USE W3DISPMD, only : WAVNU_LOCAL #ifdef W3_DB1 USE W3SDB1MD - USE W3GDATMD, only: SDBSC #endif #ifdef W3_BT1 USE W3SBT1MD @@ -3618,12 +3630,17 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) USE W3STR1MD #endif REAL, INTENT(in) :: DTG, FACX, FACY, VGX, VGY - INTEGER :: IP, ISP, ISEA, IP_glob - INTEGER :: idx, IS - INTEGER :: I, J, ITH, IK, J2 - INTEGER :: IE, POS, JSEA + INTEGER :: IP, ISP, IP_glob +#ifdef W3_MGP + INTEGER :: ISEA +#endif + INTEGER :: I, J, ITH, IK + INTEGER :: IE, POS INTEGER :: I1, I2, I3, NI(3) - INTEGER :: counter, IB1, IB2, IBR + INTEGER :: IB1, IB2 +#ifdef W3_REF1 + INTEGER :: IBR +#endif REAL :: DTK, TMP3 REAL :: LAMBDA(2), CXYY(2,3), CXY(2,NPA) REAL :: FL11, FL12 @@ -3631,13 +3648,13 @@ SUBROUTINE calcARRAY_JACOBI_VEC(DTG,FACX,FACY,VGX,VGY) REAL :: FL31, FL32 REAL :: CRFS(3), K(3) REAL :: KP(3,NE) - REAL :: KM(3), DELTAL(3,NE) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 - REAL :: CG1, WN1 - REAL :: TRIA03, SIDT, CCOS, CSIN - REAL :: SPEC(NSPEC), DEPTH, CCOSA(NTH), CSINA(NTH) - INTEGER :: IOBPTH1(NTH), IOBPTH2(NTH) + REAL :: DELTAL(3,NE) +#ifdef NOCGTABLE + REAL :: WN1 +#endif + REAL :: CG1 + REAL :: CCOS, CSIN + REAL :: CCOSA(NTH), CSINA(NTH) #ifdef W3_DEBUGSOLVER WRITE(740+IAPROC,*) 'calcARRAY_JACOBI, begin' @@ -3819,24 +3836,24 @@ SUBROUTINE calcARRAY_JACOBI2(DTG,FACX,FACY,VGX,VGY) #endif ! - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, FACHFA, DMIN - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: NSEAL, CLATS - USE W3GDATMD, only: MAPSTA - USE W3WDATMD, only: VA, VAOLD - USE W3ADATMD, only: CG, DW, WN, CX, CY - USE W3IDATMD, only: FLCUR, FLLEV + USE W3GDATMD, only: NK, NTH, NSPEC + USE W3GDATMD, only: IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: CLATS +#ifdef W3_REF1 + USE W3GDATMD, only: IOBP_LOC +#endif + USE W3WDATMD, only: VA + USE W3ADATMD, only: CG, CX, CY + USE W3IDATMD, only: FLCUR USE W3GDATMD, only: ECOS, ESIN, MAPFS USE W3PARALL, only : ONESIXTH, ZERO, THR, IMEM - use yowElementpool, only: ne, INE + use yowElementpool, only: INE USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & - PDLIB_CCON, PDLIB_POS_CELL2, PDLIB_IE_CELL2, NP, NPA, & - PDLIB_IA_P, PDLIB_POSI, PDLIB_IA, PDLIB_NNZ, iplg, & - PDLIB_I_DIAG, PDLIB_JA + PDLIB_CCON, PDLIB_POS_CELL2, PDLIB_IE_CELL2, NPA, & + PDLIB_POSI, iplg USE W3ODATMD, only : IAPROC #ifdef W3_DB1 USE W3SDB1MD - USE W3GDATMD, only: SDBSC #endif #ifdef W3_BT1 USE W3SBT1MD @@ -3864,11 +3881,9 @@ SUBROUTINE calcARRAY_JACOBI2(DTG,FACX,FACY,VGX,VGY) #endif REAL, INTENT(in) :: DTG, FACX, FACY, VGX, VGY INTEGER :: IP, ISP, ISEA, IP_glob - INTEGER :: idx, IS - INTEGER :: I, J, ITH, IK, J2 - INTEGER :: IE, POS, JSEA + INTEGER :: I, J, ITH, IK + INTEGER :: IE, POS INTEGER :: I1, I2, I3, NI(3), NI_GLOB(3), NI_ISEA(3) - INTEGER :: counter #ifdef W3_REF1 INTEGER :: eIOBPDR #endif @@ -3881,13 +3896,11 @@ SUBROUTINE calcARRAY_JACOBI2(DTG,FACX,FACY,VGX,VGY) REAL :: CRFS(3), K(3) REAL :: KP(3) REAL :: KM(3), CXY(3,2) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 + REAL :: K1 REAL :: DELTAL(3) - REAL :: NM, TRIA03, SIDT - REAL :: IEN_LOCAL(6), CG2(NK,NTH) + REAL :: NM, TRIA03 + REAL :: IEN_LOCAL(6) REAL :: CCOS, CSIN - REAL :: SPEC(NSPEC), DEPTH memunit = 50000+IAPROC @@ -4021,25 +4034,23 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, FACHFA, DMIN - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: NSEAL, CLATS - USE W3GDATMD, only: MAPSTA + USE W3GDATMD, only: NTH, NSPEC + USE W3GDATMD, only: IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: CLATS +#ifdef W3_REF1 + USE W3GDATMD, only: IOBP_LOC +#endif USE W3WDATMD, only: VA, VAOLD - USE W3ADATMD, only: CG, DW, WN, CX, CY - USE W3IDATMD, only: FLCUR, FLLEV + USE W3ADATMD, only: CG, CX, CY + USE W3IDATMD, only: FLCUR USE W3GDATMD, only: ECOS, ESIN, MAPFS USE W3PARALL, only : ONESIXTH, ZERO, THR, ONETHIRD - use yowElementpool, only: ne, INE - USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & - PDLIB_CCON, NP, NPA, PDLIB_POS_CELL2, PDLIB_IE_CELL2, & - PDLIB_IA_P, PDLIB_POSI, PDLIB_IA, PDLIB_NNZ, iplg, & - PDLIB_I_DIAG, PDLIB_JA - USE W3GDATMD, only: IOBP - USE W3ODATMD, only : IAPROC + use yowElementpool, only: INE + USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & + PDLIB_CCON, PDLIB_POS_CELL2, PDLIB_IE_CELL2, & + PDLIB_POSI, iplg #ifdef W3_DB1 USE W3SDB1MD - USE W3GDATMD, only: SDBSC #endif #ifdef W3_BT1 USE W3SBT1MD @@ -4069,14 +4080,17 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O INTEGER, INTENT(INOUT) :: J REAL, INTENT(in) :: DTG, FACX, FACY, VGX, VGY REAL, INTENT(out) :: ASPAR_DIAG_LOCAL(NSPEC), B_JAC_LOCAL(NSPEC), ASPAR_OFF_DIAG_LOCAL(NSPEC) - INTEGER :: ISP, ISEA, IP_glob, IPP1, IPP2 - INTEGER :: idx, IS, IP1, IP2 - INTEGER :: I, ITH, IK, J2 - INTEGER :: IE, POS, JSEA + INTEGER :: ISP, IP_glob, IPP1, IPP2 +#ifdef W3_MGP + INTEGER :: ISEA +#endif + INTEGER :: IP1, IP2 + INTEGER :: I, ITH, IK + INTEGER :: IE, POS INTEGER :: I1, I2, I3, NI(3), NI_GLOB(3), NI_ISEA(3) - INTEGER :: counter #ifdef W3_REF1 INTEGER :: eIOBPDR + REAL :: K1 #endif REAL :: DTK, TMP3 REAL :: LAMBDA(2) @@ -4086,13 +4100,10 @@ SUBROUTINE calcARRAY_JACOBI3(IP,J,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_O REAL :: CRFS(3), K(3) REAL :: KP(3) REAL :: KM(3), CXY(3,2) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 REAL :: ien_local(6) REAL :: DELTAL(3) REAL :: NM - REAL :: TRIA03, SIDT, CCOS, CSIN - REAL :: DEPTH + REAL :: TRIA03, CCOS, CSIN ASPAR_DIAG_LOCAL = 0.d0 B_JAC_LOCAL = 0.d0 @@ -4222,24 +4233,20 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF USE W3SERVMD, only: STRACE #endif ! - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, FACHFA, DMIN - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3GDATMD, only: NSEAL,CLATS - USE W3GDATMD, only: MAPSTA, NK + USE W3GDATMD, only: NK, NTH, NSPEC + USE W3GDATMD, only: IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: CLATS USE W3WDATMD, only: VA, VAOLD - USE W3ADATMD, only: CG, DW, WN, CX, CY - USE W3IDATMD, only: FLCUR, FLLEV + USE W3ADATMD, only: CG, CX, CY + USE W3IDATMD, only: FLCUR USE W3GDATMD, only: ECOS, ESIN, MAPFS USE W3PARALL, only : ONESIXTH, ZERO, THR, ONETHIRD - use yowElementpool, only: ne, INE + use yowElementpool, only: INE USE YOWNODEPOOL, only: PDLIB_IEN, PDLIB_TRIA, & - PDLIB_IE_CELL2, PDLIB_POS_CELL2, PDLIB_CCON, NP, NPA, & - PDLIB_IA_P, PDLIB_POSI, PDLIB_IA, PDLIB_NNZ, iplg, & - PDLIB_I_DIAG, PDLIB_JA - USE W3ODATMD, only : IAPROC + PDLIB_IE_CELL2, PDLIB_POS_CELL2, PDLIB_CCON, & + iplg #ifdef W3_DB1 USE W3SDB1MD - USE W3GDATMD, only: SDBSC #endif #ifdef W3_BT1 USE W3SBT1MD @@ -4271,10 +4278,9 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF ! INTEGER :: IP1, IP2 INTEGER :: ITH, IK - INTEGER :: IE, POS, JSEA - INTEGER :: I, I1, I2, I3, NI(3), NI_GLOB(3), NI_ISEA(3) + INTEGER :: IE, POS + INTEGER :: I, NI(3), NI_GLOB(3), NI_ISEA(3) INTEGER :: ISP, IP_glob, IPP1, IPP2, IOBPTH1(NTH), IOBPTH2(NTH) - INTEGER :: counter #ifdef W3_REF1 INTEGER :: eIOBPDR #endif @@ -4282,14 +4288,12 @@ SUBROUTINE calcARRAY_JACOBI4(IP,DTG,FACX,FACY,VGX,VGY,ASPAR_DIAG_LOCAL,ASPAR_OFF REAL :: LAMBDA(2) REAL :: CRFS(3), K(3) REAL :: KP(3), UV_CUR(3,2) - REAL :: KM(3), CSX(3), CSY(3) - REAL :: K1, eSI, eVS, eVD - REAL :: eVal1, eVal2, eVal3 + REAL :: CSX(3), CSY(3) REAL :: ien_local(6) REAL :: DELTAL(3), K_X(3,NK), K_Y(3,NK), K_U(3) REAL :: CRFS_X(3,NK), CRFS_Y(3,NK), CRFS_U(3) - REAL :: NM, CGFAK(3,NK), CSINA(NTH), CCOSA(NTH) - REAL :: TRIA03, SIDT, CCOS, CSIN + REAL :: CSINA(NTH), CCOSA(NTH) + REAL :: TRIA03 REAL :: FL11_X, FL12_X, FL21_X, FL22_X, FL31_X, FL32_X REAL :: FL11_Y, FL12_Y, FL21_Y, FL22_Y, FL31_Y, FL32_Y REAL :: FL11_U, FL12_U, FL21_U, FL22_U, FL31_U, FL32_U @@ -4456,13 +4460,14 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) #endif ! USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FACHFA +#if defined(W3_DEBUGFREQSHIFT) || defined(W3_DEBUGREFRACTION) USE W3ODATMD, only : IAPROC +#endif USE YOWNODEPOOL, only: np, iplg, PDLIB_SI, PDLIB_I_DIAG - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: IOBP_LOC, IOBPA_LOC, IOBDP_LOC USE W3IDATMD, only: FLLEV, FLCUR - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, MAPFS, DMIN, DSIP, NSEAL + USE W3GDATMD, only: NK, NK2, NTH, NSPEC, MAPFS USE W3PARALL, only : PROP_REFRACTION_PR3, PROP_REFRACTION_PR1, PROP_FREQ_SHIFT, PROP_FREQ_SHIFT_M2, ZERO, IMEM - USE W3ADATMD, only: CG, DW REAL, INTENT(in) :: DTG INTEGER IP, IP_glob, ITH, IK @@ -4475,7 +4480,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_1(DTG) REAL :: DMM(0:NK2), eVal REAL :: DWNI_M2(NK), CWNB_M2(1-NTH:NSPEC) LOGICAL :: DoLimiterRefraction = .FALSE. - LOGICAL :: DoLimiterFreqShit = .FALSE. !AR: This one is missing ... INTEGER :: ITH0 LOGICAL :: LSIG = .FALSE. @@ -4605,13 +4609,14 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) #endif ! USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FACHFA +#if defined(W3_DEBUGFREQSHIFT) || defined(W3_DEBUGREFRACTION) USE W3ODATMD, only : IAPROC +#endif USE YOWNODEPOOL, only: np, iplg, PDLIB_SI, PDLIB_I_DIAG - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: IOBP_LOC, IOBPA_LOC, IOBDP_LOC USE W3IDATMD, only: FLLEV, FLCUR - USE W3GDATMD, only: NK, NK2, NTH, NSPEC, MAPFS, DMIN, DSIP, NSEAL, MAPSTA + USE W3GDATMD, only: NK, NK2, NTH, NSPEC, MAPFS, NSEAL USE W3PARALL, only : PROP_REFRACTION_PR3, PROP_REFRACTION_PR1, PROP_FREQ_SHIFT, PROP_FREQ_SHIFT_M2, ZERO, IMEM - USE W3ADATMD, only: CG, DW REAL, INTENT(in) :: DTG REAL, INTENT(inout) :: ASPAR_DIAG_LOCAL(nspec,NSEAL) @@ -4625,7 +4630,6 @@ SUBROUTINE calcARRAY_JACOBI_SPECTRAL_2(DTG,ASPAR_DIAG_LOCAL) REAL :: DMM(0:NK2), eVal REAL :: DWNI_M2(NK), CWNB_M2(1-NTH:NSPEC) LOGICAL :: DoLimiterRefraction = .FALSE. - LOGICAL :: DoLimiterFreqShit = .FALSE. !AR: This one is missing ... INTEGER :: ITH0 LOGICAL :: LSIG = .FALSE. @@ -4759,15 +4763,13 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) USE W3SERVMD, only: STRACE #endif ! - USE W3ODATMD, only : IAPROC - USE YOWNODEPOOL, only: iplg, PDLIB_SI, PDLIB_I_DIAG, NPA, NP + USE YOWNODEPOOL, only: iplg, PDLIB_SI, PDLIB_I_DIAG, NP USE W3ADATMD, only: CG, DW, WN - USE W3WDATMD, only: UST, USTDIR - USE W3GDATMD, only: NK, NTH, NSPEC, MAPFS, optionCall, DMIN - USE W3GDATMD, only: MAPSTA, FACP, SIG - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: NK, NTH, NSPEC, MAPFS + USE W3GDATMD, only: FACP, SIG + USE W3GDATMD, only: IOBP_LOC, IOBPA_LOC, IOBDP_LOC USE W3PARALL, only: IMEM - USE W3GDATMD, only: NSEAL, CLATS + USE W3GDATMD, only: CLATS #ifdef W3_DB1 USE W3SDB1MD USE W3GDATMD, only: SDBSC @@ -4785,8 +4787,8 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_1(DTG) INTEGER IK, ITH, ISP, IS0 LOGICAL :: LBREAK REAL :: eSI, eVS, eVD, SIDT - REAL :: DEPTH, DAM(NSPEC), RATIO, MAXDAC, VSDB(NSPEC), VDDB(NSPEC) - REAL :: PreVS, eDam, DVS, FREQ, EMEAN, FMEAN, WNMEAN, AMAX, CG1(NK),WN1(NK),SPEC_VA(NSPEC) + REAL :: DEPTH, DAM(NSPEC), MAXDAC, VSDB(NSPEC), VDDB(NSPEC) + REAL :: PreVS, DVS, EMEAN, FMEAN, WNMEAN, AMAX, CG1(NK),WN1(NK),SPEC_VA(NSPEC) REAL TheFactor DO JSEA = 1, NP @@ -4922,14 +4924,12 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) USE W3SERVMD, only: STRACE #endif ! - USE W3ODATMD, only : IAPROC - USE YOWNODEPOOL, only: iplg, PDLIB_SI, PDLIB_I_DIAG, NPA, NP + USE YOWNODEPOOL, only: iplg, PDLIB_SI, NP USE W3ADATMD, only: CG, DW, WN - USE W3WDATMD, only: UST, USTDIR - USE W3GDATMD, only: NK, NTH, NSPEC, MAPFS, optionCall, DMIN - USE W3GDATMD, only: IOBP, MAPSTA, FACP, SIG, IOBPD, IOBPA, IOBDP + USE W3GDATMD, only: NK, NTH, NSPEC, MAPFS + USE W3GDATMD, only: IOBP, FACP, SIG, IOBPA, IOBDP USE W3PARALL, only: IMEM - USE W3GDATMD, only: NSEAL, CLATS + USE W3GDATMD, only: CLATS #ifdef W3_DB1 USE W3SDB1MD USE W3GDATMD, only: SDBSC @@ -4948,8 +4948,8 @@ SUBROUTINE CALCARRAY_JACOBI_SOURCE_2(DTG,ASPAR_DIAG_LOCAL) INTEGER IK, ITH, ISP, IS0 LOGICAL :: LBREAK REAL :: eSI, eVS, eVD, SIDT - REAL :: DEPTH, DAM(NSPEC), RATIO, MAXDAC, VSDB(NSPEC), VDDB(NSPEC) - REAL :: PreVS, eDam, DVS, FREQ, EMEAN, FMEAN, WNMEAN, AMAX, CG1(NK),WN1(NK),SPEC_VA(NSPEC) + REAL :: DEPTH, DAM(NSPEC), MAXDAC, VSDB(NSPEC), VDDB(NSPEC) + REAL :: PreVS, DVS, EMEAN, FMEAN, WNMEAN, AMAX, CG1(NK),WN1(NK),SPEC_VA(NSPEC) REAL TheFactor DO JSEA = 1, NP @@ -5082,13 +5082,12 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION_VA #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE yowRankModule, only : IPGL_npa - USE W3GDATMD, only: NSEAL, CLATS, GTYPE, UNGTYPE + USE W3GDATMD, only: CLATS, GTYPE, UNGTYPE USE W3WDATMD, only: TIME USE W3TIMEMD, only: DSEC21 - USE W3ADATMD, only: CG, CX, CY + USE W3ADATMD, only: CG USE W3WDATMD, only: VA - USE W3GDATMD, only: NK, NK2, NTH, ECOS, ESIN, NSPEC + USE W3GDATMD, only: NK, NTH USE W3ODATMD, only: TBPI0, TBPIN, FLBPI, IAPROC, NAPROC, BBPI0, BBPIN, ISBPI, NBI USE W3PARALL, only : ISEA_TO_JSEA !/ @@ -5197,18 +5196,23 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION(IMOD) #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE YOWNODEPOOL, only: npa, np USE yowRankModule, only : IPGL_npa - USE W3GDATMD, only: NSEAL, CLATS, MAPSF + USE W3GDATMD, only: CLATS, MAPSF USE W3WDATMD, only: TIME USE W3TIMEMD, only: DSEC21 USE W3WDATMD, only : VA - USE W3ADATMD, only: CG, CX, CY - USE W3GDATMD, only: NK, NK2, NTH, NSPEC - USE W3ODATMD, only: TBPI0, TBPIN, FLBPI, IAPROC, BBPI0, BBPIN, ISBPI, NBI - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC + USE W3ADATMD, only: CG + USE W3GDATMD, only: NK, NTH + USE W3ODATMD, only: TBPI0, TBPIN, FLBPI, BBPI0, BBPIN, ISBPI, NBI + USE W3GDATMD, only: IOBDP_LOC +#if defined(W3_DEBUGSOLVER) || defined(W3_DEBUGIOBC) || defined(W3_DEBUGSOLVERALL) + USE W3ODATMD, only: IAPROC +#endif #ifdef W3_DEBUGIOBC USE W3GDATMD, only: DDEN +#endif +#if defined(W3_DEBUGSOLVER) || defined(W3_DEBUGSOLVERALL) + USE W3GDATMD, only: NSPEC #endif !/ INTEGER, INTENT(IN) :: IMOD @@ -5506,42 +5510,51 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL #endif !/ USE CONSTANTS, only : TPI, TPIINV, GRAV - USE W3GDATMD, only: MAPSTA USE W3GDATMD, only: FSREFRACTION, FSFREQSHIFT, FSSOURCE, NX, DSIP USE W3GDATMD, only: B_JGS_NORM_THR, B_JGS_TERMINATE_NORM, B_JGS_PMIN USE W3GDATMD, only: B_JGS_TERMINATE_DIFFERENCE, B_JGS_MAXITER, B_JGS_LIMITER USE W3GDATMD, only: B_JGS_TERMINATE_MAXITER, B_JGS_BLOCK_GAUSS_SEIDEL, B_JGS_DIFF_THR - USE W3GDATMD, only: MAPWN #ifdef W3_DEBUGSRC USE W3GDATMD, only: optionCall - USE W3WDATMD, only: SHAVETOT + USE W3WDATMD, only: SHAVETOT, VSTOT, VDTOT #endif USE YOWNODEPOOL, only: PDLIB_I_DIAG, PDLIB_IA_P, PDLIB_JA, np - USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_NNZ, PDLIB_CCON + USE YOWNODEPOOL, only: PDLIB_SI use yowDatapool, only: rtype use YOWNODEPOOL, only: npa, iplg use yowExchangeModule, only : PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal use mpi_f08, only : MPI_SUM, MPI_INT, MPI_ALLREDUCE, MPI_COMM_RANK USE W3ADATMD, only: MPI_COMM_WCMP - USE W3GDATMD, only: NSEA, SIG, FACP, FLSOU - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBDP_LOC, IOBPA_LOC - USE W3GDATMD, only: NK, NK2, NTH, ECOS, ESIN, NSPEC, MAPFS, NSEA, SIG - USE W3WDATMD, only: TIME - USE W3ODATMD, only: NBI + USE W3GDATMD, only: SIG, FLSOU + USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBDP_LOC +#ifdef W3_REF1 + USE W3GDATMD, only: IOBPA_LOC +#endif + USE W3GDATMD, only: NK, NK2, NTH, NSPEC, MAPFS USE W3TIMEMD, only: DSEC21 - USE W3GDATMD, only: NSEAL, CLATS, FACHFA + USE W3GDATMD, only: NSEAL, CLATS +#ifdef W3_DEBUGFREQSHIFT + USE W3GDATMD, only: FACHFA + USE W3GDATMD, only: MAPWN +#endif USE W3IDATMD, only: FLCUR, FLLEV - USE W3WDATMD, only: VA, VAOLD, VSTOT, VDTOT, UST - USE W3ADATMD, only: CG, CX, CY, WN, DW - USE W3ODATMD, only: TBPIN, FLBPI, IAPROC + USE W3WDATMD, only: VA, VAOLD + USE W3ADATMD, only: CG, WN +#ifdef NOCGTABLE + USE W3ADATMD, only: DW +#endif +#ifdef W3_DEBUGSOLVER + USE W3ODATMD, only: NBI, FLBPI +#endif + USE W3ODATMD, only: IAPROC USE W3PARALL, only : IMEM USE W3PARALL, only : INIT_GET_JSEA_ISPROC, ZERO, THR8, LSLOC USE W3PARALL, only : ListISPprevDir, ListISPnextDir USE W3PARALL, only : JX_TO_JSEA - USE W3GDATMD, only: B_JGS_NLEVEL, B_JGS_SOURCE_NONLINEAR - USE yowfunction, only : pdlib_abort +#ifdef WEIGHTS USE yowNodepool, only: np_global +#endif USE W3DISPMD, only : WAVNU_LOCAL USE W3ADATMD, ONLY: U10, U10D #ifdef W3_ST4 @@ -5555,6 +5568,10 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL USE W3GDATMD, only: B_JGS_TRUNK_DIGITS #endif +#ifdef W3_DEBUGSOLVER + USE W3GDATMD, only: NSEA +#endif + implicit none LOGICAL, INTENT(IN) :: LCALC INTEGER, INTENT(IN) :: IMOD @@ -5563,9 +5580,9 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL INTEGER :: IP, ISP, ITH, IK, JSEA, ISEA, IP_glob, IS0 INTEGER :: myrank INTEGER :: nbIter, ISPnextDir, ISPprevDir - INTEGER :: ISPp1, ISPm1, JP, ICOUNT1, ICOUNT2 + INTEGER :: ISPp1, ISPm1, JP ! for the exchange - REAL*8 :: CCOS, CSIN, CCURX, CCURY + REAL*8 :: CCURX, CCURY REAL*8 :: eSum(NSPEC), FRLOCAL REAL*8 :: eA_THE, eC_THE, eA_SIG, eC_SIG, eSI REAL*8 :: CAD(NSPEC), CAS(NSPEC), ACLOC(NSPEC) @@ -5574,21 +5591,28 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL REAL*8 :: Sum_Prev, Sum_New, p_is_converged, DiffNew, prop_conv REAL*8 :: Sum_L2, Sum_L2_GL REAL :: DMM(0:NK2), DAM(NSPEC), DAM2(NSPEC), SPEC(NSPEC) - REAL*8 :: eDiff(NSPEC), eProd(NSPEC), eDiffB(NSPEC) + REAL*8 :: eProd(NSPEC) REAL*8 :: DWNI_M2(NK), CWNB_M2(1-NTH:NSPEC) - REAL :: VAnew(NSPEC), VFLWN(1-NTH:NSPEC), JAC, JAC2 - REAL :: VAAnew(1-NTH:NSPEC+NTH), VAAacloc(1-NTH:NSPEC+NTH) - REAL :: VAinput(NSPEC), VAacloc(NSPEC), ASPAR_DIAG(NSPEC) + REAL :: JAC2 + REAL :: ASPAR_DIAG(NSPEC) REAL :: aspar_diag_local(nspec), aspar_off_diag_local(nspec), b_jac_local(nspec) - REAL*8 :: eDiffSing, eSumPart - REAL :: EMEAN, FMEAN, FMEAN1, WNMEAN, AMAX, U10ABS, U10DIR, TAUA, TAUADIR + REAL :: EMEAN, FMEAN, FMEAN1, WNMEAN, AMAX +#ifdef W3_FLX5 + REAL :: TAUA, TAUADIR +#endif REAL :: USTAR, USTDIR, TAUWX, TAUWY, CD, Z0, CHARN, FMEANWS, DLWMEAN - REAL*8 :: eVal1, eVal2 - REAL*8 :: eVA, eVO, CG2, NEWDAC, NEWAC, OLDAC, MAXDAC +#ifdef W3_DEBUGFREQSHIFT + REAL*8 :: eVal1, eVal2, eSumPart + REAL*8 :: eDiff(NSPEC), eDiffB(NSPEC) + REAL :: VAnew(NSPEC), VAinput(NSPEC), VAacloc(NSPEC) + REAL :: VFLWN(1-NTH:NSPEC), VAAnew(1-NTH:NSPEC+NTH), VAAacloc(1-NTH:NSPEC+NTH) +#endif + REAL*8 :: eVA, eVO, NEWDAC, MAXDAC REAL :: CG1(0:NK+1), WN1(0:NK+1) - LOGICAL :: LCONVERGED(NSEAL), lexist, LLWS(NSPEC) + LOGICAL :: LCONVERGED(NSEAL), LLWS(NSPEC) #ifdef WEIGHTS INTEGER :: ipiter(nseal), ipitergl(np_global), ipiterout(np_global) + LOGICAL :: lexist #endif #ifdef W3_DEBUGSRC REAL :: IntDiff, eVA_w3srce, eVAsolve, SumACout @@ -5603,10 +5627,9 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL REAL :: OffDIAG(NSPEC, npa) REAL*8 :: eOff(NSPEC) REAL*8 :: eSum1(NSPEC), eSum2(NSPEC) -#endif CHARACTER(len=128) eFile +#endif INTEGER ierr, i - INTEGER JP_glob INTEGER is_converged, itmp #ifdef W3_TRNK @@ -5614,7 +5637,9 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL real :: trVA #endif +#ifdef W3_DEBUGSRC INTEGER :: TESTNODE = 923 +#endif LOGICAL :: LSIG = .FALSE. @@ -6422,17 +6447,16 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, RD10, RD20, DTG, VGX, VGY, LCA #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE W3GDATMD, ONLY: NK, NTH, NSPEC, SIG, DTH, ESIN, ECOS, NSEAL, FSBCCFL, CLATS, MAPFS - USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC, MAPSF, NSEA - USE W3ODATMD, ONLY: NDSE, NDST, FLBPI, NBI, TBPI0, TBPIN, ISBPI, BBPI0, BBPIN + USE W3GDATMD, ONLY: NK, NTH, SIG, ESIN, ECOS, FSBCCFL, CLATS + USE W3GDATMD, ONLY: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC, MAPSF + USE W3ODATMD, ONLY: FLBPI, NBI, ISBPI, BBPI0, BBPIN USE W3ADATMD, ONLY: DW, CX, CY, MPI_COMM_WCMP - USE W3IDATMD, ONLY: FLCUR, FLLEV + USE W3IDATMD, ONLY: FLCUR USE W3WDATMD, ONLY: VA USE W3DISPMD, ONLY: WAVNU3 - USE W3ODATMD, ONLY : IAPROC #ifdef W3_PDLIB USE yowElementpool, only: ne, ine - USE yowNodepool, only: np, npa, pdlib_ien, pdlib_si, iplg + USE yowNodepool, only: npa, pdlib_ien, pdlib_si, iplg use yowDatapool, only: rtype use yowExchangeModule, only: PDLIB_exchange2Dreal_zero, PDLIB_exchange2Dreal use yowRankModule, only: ipgl_npa @@ -6458,8 +6482,10 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, RD10, RD20, DTG, VGX, VGY, LCA REAL :: LAMBDAX(NTH), LAMBDAY(NTH) REAL :: DTMAX(NTH), DTMAXEXP(NTH), DTMAXOUT, DTMAXGL REAL :: FIN(1), FOUT(1), REST, CFLXY, RD1, RD2 - REAL :: UOLD(NTH,NPA), U(NTH,NPA) - + REAL :: U(NTH,NPA) +#ifdef W3_REF1 + REAL :: UOLD(NTH,NPA) +#endif REAL, PARAMETER :: ONESIXTH = 1.0/6.0 REAL, PARAMETER :: ZERO = 0.0 REAL, PARAMETER :: THR = 1.0E-12 @@ -6702,7 +6728,7 @@ SUBROUTINE BLOCK_SOLVER_EXPLICIT_INIT() #endif USE W3GDATMD, only: NTH, NK #ifdef W3_PDLIB - USE YOWNODEPOOL, only: np, npa + USE YOWNODEPOOL, only: npa USE YOWELEMENTPOOL, only: ne #endif IMPLICIT NONE @@ -6766,19 +6792,18 @@ SUBROUTINE BLOCK_SOLVER_INIT(IMOD) USE W3SERVMD, only: STRACE #endif ! - USE CONSTANTS, only : LPDLIB, TPI, TPIINV - USE W3GDATMD, only: MAPSF, NSEAL, DMIN, IOBDP, MAPSTA, IOBP, MAPFS, NX - USE W3ADATMD, only: DW + USE CONSTANTS, only : TPI, TPIINV USE W3PARALL, only: INIT_GET_ISEA - USE YOWNODEPOOL, only: iplg, np + USE YOWNODEPOOL, only: iplg USE yowfunction, only: pdlib_abort - use YOWNODEPOOL, only: npa USE W3GDATMD, only: B_JGS_USE_JACOBI USE W3PARALL, only : ListISPprevDir, ListISPnextDir USE W3PARALL, only : ListISPprevFreq, ListISPnextFreq USE W3GDATMD, only: NSPEC, NTH, NK USE W3GDATMD, only: FSTOTALIMP +#ifdef W3_DEBUGINIT USE W3ODATMD, only: IAPROC +#endif !/ INTEGER, INTENT(IN) :: IMOD ! @@ -6904,12 +6929,11 @@ SUBROUTINE SET_IOBDP_PDLIB #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE CONSTANTS, only : LPDLIB - USE W3GDATMD, only: MAPSF, NSEAL, DMIN, MAPSTA, NX - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC + USE W3GDATMD, only: DMIN + USE W3GDATMD, only: IOBDP_LOC USE W3ADATMD, only: DW USE W3PARALL, only: INIT_GET_ISEA - USE YOWNODEPOOL, only: iplg, np, npa + USE YOWNODEPOOL, only: iplg, npa !/ !/ !/ ------------------------------------------------------------------- / @@ -6925,7 +6949,7 @@ SUBROUTINE SET_IOBDP_PDLIB !/ ------------------------------------------------------------------- / !/ ! - INTEGER :: JSEA, ISEA, IX, IP, IP_glob + INTEGER :: JSEA, IP, IP_glob REAL*8, PARAMETER :: DTHR = 10E-6 #ifdef W3_S CALL STRACE (IENT, 'SETDEPTH_PDLIB') @@ -6993,12 +7017,10 @@ SUBROUTINE SET_IOBPA_PDLIB #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE CONSTANTS, only : LPDLIB - USE W3GDATMD, only: MAPSF, NSEAL, DMIN, MAPSTA, NX - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3ADATMD, only: DW + USE W3GDATMD, only: NSEAL, MAPSTA + USE W3GDATMD, only: IOBPA_LOC USE W3PARALL, only: INIT_GET_ISEA - USE YOWNODEPOOL, only: iplg, np + USE YOWNODEPOOL, only: iplg !/ !/ !/ ------------------------------------------------------------------- / @@ -7014,7 +7036,7 @@ SUBROUTINE SET_IOBPA_PDLIB !/ ------------------------------------------------------------------- / !/ ! - INTEGER :: JSEA, ISEA, IX, IP, IP_glob + INTEGER :: JSEA, IP_glob REAL*8, PARAMETER :: DTHR = 10E-6 #ifdef W3_S CALL STRACE (IENT, 'SETDEPTH_PDLIB') @@ -7097,21 +7119,15 @@ SUBROUTINE SET_UG_IOBP_PDLIB_INIT() USE CONSTANTS ! ! - USE W3GDATMD, only: NX, NY, NSEA, MAPFS, & - NK, NTH, DTH, XFR, MAPSTA, COUNTRI, & - ECOS, ESIN, IEN, NTRI, TRIGP, & - IOBP,IOBPD, IOBPA, & + USE W3GDATMD, only: NX, NTH, ECOS, ESIN #ifdef W3_REF1 - REFPARS, REFLC, REFLD, & + USE W3GDATMD, only: REFPARS, REFLC, REFLD, MAPSTA, MAPFS, IOBP, IOBPD, DTH #endif - ANGLE0, ANGLE, NSEAL - - USE W3ODATMD, only: TBPI0, TBPIN, FLBPI - USE W3ADATMD, only: CG, CX, CY, ATRNX, ATRNY, ITIME, CFLXYMAX - USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC, IOBDP_LOC - USE W3IDATMD, only: FLCUR + USE W3GDATMD, only: IOBP_LOC, IOBPD_LOC, IOBPA_LOC +#ifdef W3_DEBUGSETUGIOBP USE W3ODATMD, only : IAPROC - USE YOWNODEPOOL, only: PDLIB_SI, PDLIB_IEN, PDLIB_TRIA, ipgl, iplg, npa, np +#endif + USE YOWNODEPOOL, only: PDLIB_IEN, ipgl, iplg, npa use yowElementpool, only: NE, INE use yowExchangeModule, only : PDLIB_exchange1DREAL #ifdef W3_S @@ -7124,17 +7140,17 @@ SUBROUTINE SET_UG_IOBP_PDLIB_INIT() !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: ITH, IX, I, J, IP, IE, NDIRSUM - REAL (KIND = 8) :: COSSUM, SINSUM - REAL (KIND = 8) :: DIRMIN, DIRMAX, SHIFT, TEMPO, DIRCOAST + INTEGER :: ITH, I, IP, IE +#ifdef W3_REF1 + INTEGER :: NDIRSUM + REAL (KIND = 8) :: COSSUM, SINSUM, DIRCOAST +#endif REAL (KIND = 8) :: X1, X2, Y1, Y2, DXP1, DXP2, DXP3 REAL (KIND = 8) :: DYP1, DYP2, DYP3, eDet1, eDet2, EVX, EVY REAL(KIND=8), PARAMETER :: THR = TINY(1.) INTEGER :: I1, I2, I3 - INTEGER :: ITMP(NX), NEXTVERT(NX), PREVVERT(NX) INTEGER :: MAX_IOBPD, MIN_IOBPD REAL :: rtmp(NPA) - CHARACTER(60) :: FNAME #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -7368,10 +7384,8 @@ SUBROUTINE DEALLOCATE_PDLIB_GLOBAL(IMOD) #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE W3GDATMD, only: NSPEC, B_JGS_BLOCK_GAUSS_SEIDEL, GRIDS - use YOWNODEPOOL, only: PDLIB_NNZ, npa, np + USE W3GDATMD, only: GRIDS USE yowfunction, only: pdlib_abort - USE W3GDATMD, only: NTH, NK, NSEAL USE W3PARALL, only: IMEM #ifdef W3_DEBUGINIT USE W3ODATMD, only : IAPROC @@ -7467,8 +7481,8 @@ SUBROUTINE ERGOUT(FHNDL, ERGNAME) #ifdef W3_S USE W3SERVMD, only: STRACE #endif - USE W3GDATMD, only: NSPEC, NTH, NK, NSEAL - USE W3WDATMD, only: VA, VAOLD + USE W3GDATMD, only: NSEAL + USE W3WDATMD, only: VA IMPLICIT NONE INTEGER, INTENT(IN) :: FHNDL @@ -7541,9 +7555,9 @@ SUBROUTINE JACOBI_INIT(IMOD) USE W3SERVMD, only: STRACE #endif USE W3GDATMD, only: NSPEC, B_JGS_BLOCK_GAUSS_SEIDEL, GRIDS - use YOWNODEPOOL, only: PDLIB_NNZ, npa, np + use YOWNODEPOOL, only: PDLIB_NNZ, npa USE yowfunction, only: pdlib_abort - USE W3GDATMD, only: NTH, NK, NSEAL + USE W3GDATMD, only: NTH, NSEAL USE W3PARALL, only: IMEM #ifdef W3_DEBUGINIT USE W3ODATMD, only : IAPROC From dccf4b97ddd07ac13e991beadd6556d5a9146c69 Mon Sep 17 00:00:00 2001 From: kestonsmith-noaa <107580916+kestonsmith-noaa@users.noreply.github.com> Date: Thu, 26 Mar 2026 14:43:30 -0400 Subject: [PATCH 133/136] Communication is added after boundary conditions are applied in PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK to enable bit for bit reproducibility across different numbers of MPI processes. (#1538) --- model/bin/ww3_from_ftp.sh | 1 + model/src/w3profsmd_pdlib.F90 | 4 + regtests/bin/matrix.base | 10 + regtests/ww3_tp2.17/info | 29 +- regtests/ww3_tp2.17/input_ice/switch_PDLIB | 1 + regtests/ww3_tp2.17/input_ice/ww3_bounc.inp | 25 ++ regtests/ww3_tp2.17/input_ice/ww3_grib.inp | 10 + regtests/ww3_tp2.17/input_ice/ww3_grid_d.inp | 322 ++++++++++++++++++ regtests/ww3_tp2.17/input_ice/ww3_ounf.inp | 84 +++++ regtests/ww3_tp2.17/input_ice/ww3_ounp.inp | 118 +++++++ regtests/ww3_tp2.17/input_ice/ww3_outp.inp | 112 ++++++ .../ww3_tp2.17/input_ice/ww3_prnc_current.inp | 51 +++ .../ww3_tp2.17/input_ice/ww3_prnc_ice.inp | 51 +++ .../ww3_tp2.17/input_ice/ww3_prnc_level.inp | 51 +++ .../ww3_tp2.17/input_ice/ww3_prnc_wind.inp | 51 +++ regtests/ww3_tp2.17/input_ice/ww3_shel.inp | 140 ++++++++ .../ww3_tp2.17/input_ice_restart/switch_PDLIB | 1 + .../input_ice_restart/ww3_bounc.inp | 25 ++ .../ww3_tp2.17/input_ice_restart/ww3_grib.inp | 10 + .../input_ice_restart/ww3_grid_d.inp | 322 ++++++++++++++++++ .../ww3_tp2.17/input_ice_restart/ww3_ounf.inp | 83 +++++ .../ww3_tp2.17/input_ice_restart/ww3_ounp.inp | 118 +++++++ .../ww3_tp2.17/input_ice_restart/ww3_outp.inp | 112 ++++++ .../input_ice_restart/ww3_prnc_current.inp | 51 +++ .../input_ice_restart/ww3_prnc_ice.inp | 51 +++ .../input_ice_restart/ww3_prnc_level.inp | 51 +++ .../input_ice_restart/ww3_prnc_wind.inp | 51 +++ .../ww3_tp2.17/input_ice_restart/ww3_shel.inp | 140 ++++++++ 28 files changed, 2074 insertions(+), 1 deletion(-) create mode 100644 regtests/ww3_tp2.17/input_ice/switch_PDLIB create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.17/input_ice/ww3_grib.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_grid_d.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_ounf.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.17/input_ice/ww3_outp.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_prnc_current.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_prnc_ice.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_prnc_level.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_prnc_wind.inp create mode 100755 regtests/ww3_tp2.17/input_ice/ww3_shel.inp create mode 100644 regtests/ww3_tp2.17/input_ice_restart/switch_PDLIB create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.17/input_ice_restart/ww3_grib.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_grid_d.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_ounf.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.17/input_ice_restart/ww3_outp.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_current.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_ice.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_level.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_wind.inp create mode 100755 regtests/ww3_tp2.17/input_ice_restart/ww3_shel.inp diff --git a/model/bin/ww3_from_ftp.sh b/model/bin/ww3_from_ftp.sh index ca404deefe..53edeab9ac 100755 --- a/model/bin/ww3_from_ftp.sh +++ b/model/bin/ww3_from_ftp.sh @@ -105,6 +105,7 @@ cp -r data_regtests/ww3_tp2.14/input/toy/toy_coupled_field.nc.OASACM regtests/ww cp -r data_regtests/ww3_tp2.14/input/toy/toy_coupled_field.nc.OASACM regtests/ww3_tp2.14/input/toy/toy_coupled_field.nc.OASACM6 cp -r data_regtests/ww3_tp2.14/input/toy/*.nc regtests/ww3_tp2.14/input/toy/ cp -r data_regtests/ww3_tp2.17/input/* regtests/ww3_tp2.17/input/ +cp -r data_regtests/ww3_tp2.17/input_ice/* regtests/ww3_tp2.17/input_ice/ cp -r data_regtests/ww3_tp2.19/input/* regtests/ww3_tp2.19/input/ cp -r data_regtests/ww3_tp2.21/input/* regtests/ww3_tp2.21/input/ cp -r data_regtests/mww3_test_09/input/* regtests/mww3_test_09/input/ diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 1f4b17a688..0508bb669d 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -5785,6 +5785,10 @@ SUBROUTINE PDLIB_JACOBI_GAUSS_SEIDEL_BLOCK(IMOD, FACX, FACY, DTG, VGX, VGY, LCAL ENDIF END IF CALL APPLY_BOUNDARY_CONDITION(IMOD) + ! + ! for reproducability state must be communicated after BC application + ! + CALL PDLIB_exchange2DREAL_zero(VA) call print_memcheck(memunit, 'memcheck_____:'//' WW3_PROP SECTION 6') ! #ifdef W3_DEBUGSOLVERCOH diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 4a56edb676..364d827ffc 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -2019,6 +2019,8 @@ if [ "$pdlib" = 'y' ] && [ "$dist" = 'y' ] then echo ' ' >> matrix.body + + echo "$rtst -s MPI -s NO_PDLIB -w work_a -g a -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s NO_PDLIB -w work_ma -m grdset_a -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_b -g b -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body @@ -2026,6 +2028,9 @@ echo "$rtst -s MPI -s PDLIB -w work_pdlib -g pdlib -f -p $mpi -n $np $ww3 ww3_tp2.6" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mb -m grdset_b -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mc -m grdset_c -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body + echo "$rtst -s MPI -s PDLIB -i input_ice -w work_ice -g d -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body + echo "$rtst -s MPI -s PDLIB -i input_ice -w work_iceB -g d -f -p $mpi -n $(( $np -1 )) $ww3 ww3_tp2.17" >> matrix.body + echo "./bin/test.comp ww3_tp2.17 work_ice work_iceB" >> matrix.body if [ "$rstrt_b4b" = 'y' ] then echo "mkdir -p ww3_tp2.17/work_ma1" >> matrix.body @@ -2036,6 +2041,11 @@ echo "cp ww3_tp2.17/work_mc/restart001.inlc ww3_tp2.17/work_mc1/restart.inlc" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mc1 -m grdset_c1 -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "./bin/test.comp ww3_tp2.17 work_mc work_mc1" >> matrix.body + + echo "mkdir -p ww3_tp2.17/work_ice_restart" >> matrix.body + echo "cp ww3_tp2.17/work_ice/20151214.120000.restart.ww3 ww3_tp2.17/work_ice_restart/restart.ww3" >> matrix.body + echo "$rtst -s MPI -s PDLIB -i input_ice_restart -w work_ice_restart -g d -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body + echo "./bin/test.comp ww3_tp2.17 work_ice work_ice_restart" >> matrix.body fi fi diff --git a/regtests/ww3_tp2.17/info b/regtests/ww3_tp2.17/info index e6a713deec..26f22abc32 100644 --- a/regtests/ww3_tp2.17/info +++ b/regtests/ww3_tp2.17/info @@ -48,4 +48,31 @@ # Ali Abdolali, Aron Roland, Jessica Meixner, May 2018 # # Last Mod : May 2018 # # # -############################################################################# +# +#---------------------------------------------------------------------------# +# +#---------------------------------------------------------------------------# +# Addendum Keston Smith, Jessica Meixner, November 2025 +# A test is added with ice forcing in addition to currents, water level, # +# and boundary forcing. This test exhibits failure to restart reproduce bit # +# for bit when both boundary forcing and water level are present. # +# +# The full: ice, wind, water level, currents and boundary forcing can be run +# with the following script: +# +#mkdir ww3_tp2.17/work_ice_restart24 +# +# ./bin/run_cmake_test -b slurm -o all -S -T -s MPI -s PDLIB -i input_ice -w work_ice -g d -f -p srun -n 24 ../model ww3_tp2.17 +# +# cp ww3_tp2.17/work_ice/20151214.120000.restart.ww3 ww3_tp2.17/work_ice_restart24/restart.ww3 +# +# ./bin/run_cmake_test -b slurm -o all -S -T -s MPI -s PDLIB -i input_ice_restart -w work_ice_restart24 -g d -f -p srun -n 24 ../model ww3_tp2.17 +# ./bin/run_cmake_test -b slurm -o all -S -T -s MPI -s PDLIB -i input_ice -w work_ice20 -g d -f -p srun -n 20 ../model ww3_tp2.17 +# +# Bit for bit reproducability for different numbers of MPI processes # +# is evident in comparison of solutions in work_ice and work_ice20 # +# (cold starts) with 24 and 20 MPI processes respectivly. Restart # +# reproducability can be checked by comparing solution in work_ice/ to # +# work_ice_restart24. # +#---------------------------------------------------------------------------# +############################################################################ diff --git a/regtests/ww3_tp2.17/input_ice/switch_PDLIB b/regtests/ww3_tp2.17/input_ice/switch_PDLIB new file mode 100644 index 0000000000..5c584f6d80 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/switch_PDLIB @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT4 DB1 TR0 BS0 IS0 IC0 REF0 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_ice/ww3_bounc.inp b/regtests/ww3_tp2.17/input_ice/ww3_bounc.inp new file mode 100755 index 0000000000..1b29c0b881 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/bound.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice/ww3_grib.inp b/regtests/ww3_tp2.17/input_ice/ww3_grib.inp new file mode 100644 index 0000000000..c4b9226183 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_grib.inp @@ -0,0 +1,10 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH-III gridded output input file +$ ---------------------------------------- +20151214 000000 3600 9 +N +WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR UST +$ +20151214 000000 7 11 255 0 0 +$ +$ end of input file diff --git a/regtests/ww3_tp2.17/input_ice/ww3_grid_d.inp b/regtests/ww3_tp2.17/input_ice/ww3_grid_d.inp new file mode 100755 index 0000000000..27cb1fe131 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_grid_d.inp @@ -0,0 +1,322 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Inlet' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.10 0.05 32 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 150. 150. 150. 150. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ JGS_NORM_THR = 1.E-20 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, + WHITECAPWIDTH = 0.30 / +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32 / +&MISC CICE0 = 0.500, CICEN = 0.500, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 5, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +$&REF1 REFCOAST=0.1 / +$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T F +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/inlet.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ + 1 1 F + 75 1 T +$ 1 1 F +$ 292 1 T +$ 154 1 T +$ 239 1 T +$ 2 1 F +$ 59 1 T +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice/ww3_ounf.inp b/regtests/ww3_tp2.17/input_ice/ww3_ounf.inp new file mode 100755 index 0000000000..c564893c83 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_ounf.inp @@ -0,0 +1,84 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ +$ 20151214 000000 3600. 9999 + 20151214 130000 3600. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS PDP +$ PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR UST CHA CGE FAW TAW TWA WCC +$ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED +$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 3070 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice/ww3_ounp.inp b/regtests/ww3_tp2.17/input_ice/ww3_ounp.inp new file mode 100755 index 0000000000..a8c1a565bf --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_ounp.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 000000 3600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 1 + 2 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ +$ 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output + 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice/ww3_outp.inp b/regtests/ww3_tp2.17/input_ice/ww3_outp.inp new file mode 100644 index 0000000000..5e90ea1366 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_outp.inp @@ -0,0 +1,112 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 000000 600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ Define points for which output is to be generated. +$ +$ mandatory end of list + -1 +$ +$ Output type ITYPE [0,1,2,3] +$ + 2 +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. +$ +$ 3 1. 0. 33 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ - Unit number for file, also used in file name. +$ + 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. +$ +$ 1 0. 0. 50 T T T T T T 0 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, nubmer of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice/ww3_prnc_current.inp b/regtests/ww3_tp2.17/input_ice/ww3_prnc_current.inp new file mode 100755 index 0000000000..f9de2d4959 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_prnc_current.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'CUR' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ucur vcur +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/current.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice/ww3_prnc_ice.inp b/regtests/ww3_tp2.17/input_ice/ww3_prnc_ice.inp new file mode 100755 index 0000000000..6b7077572c --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_prnc_ice.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'ICE' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ice +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/ice.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice/ww3_prnc_level.inp b/regtests/ww3_tp2.17/input_ice/ww3_prnc_level.inp new file mode 100755 index 0000000000..6ff15c0879 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_prnc_level.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'LEV' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + wlv +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/levelNoNaN.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice/ww3_prnc_wind.inp b/regtests/ww3_tp2.17/input_ice/ww3_prnc_wind.inp new file mode 100755 index 0000000000..c0330bc5b7 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_prnc_wind.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'WND' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + uwnd vwnd +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/wind.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice/ww3_shel.inp b/regtests/ww3_tp2.17/input_ice/ww3_shel.inp new file mode 100755 index 0000000000..846d6d3126 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice/ww3_shel.inp @@ -0,0 +1,140 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ Define input to be used with flag for use and flag for definition +$ as a homogeneous field (first three only); seven input lines. +$ + T F Water levels + T F Currents + T F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ +$ Time frame of calculations ----------------------------------------- $ +$ - Starting time in yyyymmdd hhmmss format. +$ - Ending time in yyyymmdd hhmmss format. +$ + 20151214 000000 + 20151215 000000 +$ +$ Define output data ------------------------------------------------- $ +$ +$ Define output server mode. This is used only in the parallel version +$ of the model. To keep the input file consistent, it is always needed. +$ IOSTYP = 1 is generally recommended. IOSTYP > 2 may be more efficient +$ for massively parallel computations. Only IOSTYP = 0 requires a true +$ parallel file system like GPFS. +$ +$ IOSTYP = 0 : No data server processes, direct access output from +$ each process (requirese true parallel file system). +$ 1 : No data server process. All output for each type +$ performed by process that performes computations too. +$ 2 : Last process is reserved for all output, and does no +$ computing. +$ 3 : Multiple dedicated output processes. +$ + 0 +$ +$ Five output types are available (see below). All output types share +$ a similar format for the first input line: +$ - first time in yyyymmdd hhmmss format, output interval (s), and +$ last time in yyyymmdd hhmmss format (all integers). +$ Output is disabled by setting the output interval to 0. +$ +$ Type 1 : Fields of mean wave parameters +$ Standard line and line with flags to activate output fields +$ as defined in section 2.4 of the manual. The second line is +$ not supplied if no output is requested. +$ The raw data file is out_grd.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ +$ + 20151214 130000 3600 20151215 000000 + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$ +$ +$ Type 2 : Point output +$ Standard line and a number of lines identifying the +$ longitude, latitude and name (C*40) of output points. +$ The list is closed by defining a point with the name +$ 'STOPSTRING'. No point info read if no point output is +$ requested (i.e., no 'STOPSTRING' needed). +$ Example for spherical grid. +$ The raw data file is out_pnt.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ NOTE : Spaces may be included in the name, but this is not +$ advised, because it will break the GrADS utility to +$ plots spectra and source terms, and will make it more +$ difficult to use point names in data files. +$ + 20151214 000000 3600 20151215 000000 +$ +$output points for Inlet +$ +-72.31 40.44 a01 +-72.34 40.50 a02 +-72.38 40.55 a03 +-72.40 40.59 a04 +-72.42 40.63 a05 +-72.44 40.67 a06 +-72.46 40.72 a07 +-72.47 40.76 a08 +-72.49 40.81 a09 +-72.51 40.84 a10 +$ + 0.0 0.0 'STOPSTRING' +$ +$ Type 3 : Output along track. +$ Flag for formatted input file. +$ The data files are track_i.ww3 and +$ track_o.ww3, see w3iotr.ftn for ad. doc. +$ + 20060101 000000 0 20040101 000000 +$ +$ Type 4 : Restart files (no additional data required). +$ The data file is restartN.ww3, see +$ w3iors.ftn for additional doc. +$ + 20151214 000000 0 20151215 000000 T + 20151214 000000 3600 20151215 000000 +$ +$ Type 5 : Boundary data (no additional data required). +$ The data file is nestN.ww3, see +$ w3iobp.ftn for additional doc. +$ + 20040601 000000 0 20040103 000000 +$ +$ Type 6 : Separated wave field data (dummy for now). +$ First, last step IX and IY, flag for formatted file +$ + 20060101 000000 0 20040603 000000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ Homogeneous fields can be defined by a list of lines containing an ID +$ string 'LEV' 'CUR' 'WND', date and time information (yyyymmdd +$ hhmmss), value (S.I. units), direction (current and wind, oceanographic +$ convention degrees)) and air-sea temparature difference (degrees C). +$ 'STP' is mandatory stop string. +$ +$ 'WND' 20080101 000000 20. 315. 0.0 +$ + 'the_end' 0 +$ + 'STP' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice_restart/switch_PDLIB b/regtests/ww3_tp2.17/input_ice_restart/switch_PDLIB new file mode 100644 index 0000000000..5c584f6d80 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/switch_PDLIB @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT4 DB1 TR0 BS0 IS0 IC0 REF0 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_bounc.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_bounc.inp new file mode 100755 index 0000000000..1b29c0b881 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/bound.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_grib.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_grib.inp new file mode 100644 index 0000000000..4a4d86515a --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_grib.inp @@ -0,0 +1,10 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH-III gridded output input file +$ ---------------------------------------- +20151214 120000 3600 9 +N +WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR UST +$ +20151214 120000 7 11 255 0 0 +$ +$ end of input file diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_grid_d.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_grid_d.inp new file mode 100755 index 0000000000..27cb1fe131 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_grid_d.inp @@ -0,0 +1,322 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Inlet' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.10 0.05 32 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 150. 150. 150. 150. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ JGS_NORM_THR = 1.E-20 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, + WHITECAPWIDTH = 0.30 / +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32 / +&MISC CICE0 = 0.500, CICEN = 0.500, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 5, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +$&REF1 REFCOAST=0.1 / +$&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&REF1 REFCOAST=0.10, REFSLOPE=0.1, REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00 / +&SIN4 BETAMAX = 1.33 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T F +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/inlet.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ + 1 1 F + 75 1 T +$ 1 1 F +$ 292 1 T +$ 154 1 T +$ 239 1 T +$ 2 1 F +$ 59 1 T +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_ounf.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_ounf.inp new file mode 100755 index 0000000000..5d93e7acf3 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_ounf.inp @@ -0,0 +1,83 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ + 20151214 130000 3600. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS PDP +$ PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR UST CHA CGE FAW TAW TWA WCC +$ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED +$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 3070 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_ounp.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_ounp.inp new file mode 100755 index 0000000000..f0809c7532 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_ounp.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 120000 3600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 1 + 2 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ +$ 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output + 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_outp.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_outp.inp new file mode 100644 index 0000000000..0e9986f828 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_outp.inp @@ -0,0 +1,112 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 120000 600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ Define points for which output is to be generated. +$ +$ mandatory end of list + -1 +$ +$ Output type ITYPE [0,1,2,3] +$ + 2 +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. +$ +$ 3 1. 0. 33 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ - Unit number for file, also used in file name. +$ + 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. +$ +$ 1 0. 0. 50 T T T T T T 0 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, nubmer of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_current.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_current.inp new file mode 100755 index 0000000000..f9de2d4959 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_current.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'CUR' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ucur vcur +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/current.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_ice.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_ice.inp new file mode 100755 index 0000000000..6b7077572c --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_ice.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'ICE' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ice +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/ice.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_level.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_level.inp new file mode 100755 index 0000000000..6ff15c0879 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_level.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'LEV' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + wlv +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/levelNoNaN.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_wind.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_wind.inp new file mode 100755 index 0000000000..c0330bc5b7 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_prnc_wind.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'WND' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + uwnd vwnd +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/wind.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_ice_restart/ww3_shel.inp b/regtests/ww3_tp2.17/input_ice_restart/ww3_shel.inp new file mode 100755 index 0000000000..b7c172e204 --- /dev/null +++ b/regtests/ww3_tp2.17/input_ice_restart/ww3_shel.inp @@ -0,0 +1,140 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ Define input to be used with flag for use and flag for definition +$ as a homogeneous field (first three only); seven input lines. +$ + T F Water levels + T F Currents + T F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ +$ Time frame of calculations ----------------------------------------- $ +$ - Starting time in yyyymmdd hhmmss format. +$ - Ending time in yyyymmdd hhmmss format. +$ + 20151214 120000 + 20151215 000000 +$ +$ Define output data ------------------------------------------------- $ +$ +$ Define output server mode. This is used only in the parallel version +$ of the model. To keep the input file consistent, it is always needed. +$ IOSTYP = 1 is generally recommended. IOSTYP > 2 may be more efficient +$ for massively parallel computations. Only IOSTYP = 0 requires a true +$ parallel file system like GPFS. +$ +$ IOSTYP = 0 : No data server processes, direct access output from +$ each process (requirese true parallel file system). +$ 1 : No data server process. All output for each type +$ performed by process that performes computations too. +$ 2 : Last process is reserved for all output, and does no +$ computing. +$ 3 : Multiple dedicated output processes. +$ + 0 +$ +$ Five output types are available (see below). All output types share +$ a similar format for the first input line: +$ - first time in yyyymmdd hhmmss format, output interval (s), and +$ last time in yyyymmdd hhmmss format (all integers). +$ Output is disabled by setting the output interval to 0. +$ +$ Type 1 : Fields of mean wave parameters +$ Standard line and line with flags to activate output fields +$ as defined in section 2.4 of the manual. The second line is +$ not supplied if no output is requested. +$ The raw data file is out_grd.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ +$ + 20151214 130000 3600 20151215 000000 + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$ +$ +$ Type 2 : Point output +$ Standard line and a number of lines identifying the +$ longitude, latitude and name (C*40) of output points. +$ The list is closed by defining a point with the name +$ 'STOPSTRING'. No point info read if no point output is +$ requested (i.e., no 'STOPSTRING' needed). +$ Example for spherical grid. +$ The raw data file is out_pnt.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ NOTE : Spaces may be included in the name, but this is not +$ advised, because it will break the GrADS utility to +$ plots spectra and source terms, and will make it more +$ difficult to use point names in data files. +$ + 20151214 120000 3600 20151215 000000 +$ +$output points for Inlet +$ +-72.31 40.44 a01 +-72.34 40.50 a02 +-72.38 40.55 a03 +-72.40 40.59 a04 +-72.42 40.63 a05 +-72.44 40.67 a06 +-72.46 40.72 a07 +-72.47 40.76 a08 +-72.49 40.81 a09 +-72.51 40.84 a10 +$ + 0.0 0.0 'STOPSTRING' +$ +$ Type 3 : Output along track. +$ Flag for formatted input file. +$ The data files are track_i.ww3 and +$ track_o.ww3, see w3iotr.ftn for ad. doc. +$ + 20060101 000000 0 20040101 000000 +$ +$ Type 4 : Restart files (no additional data required). +$ The data file is restartN.ww3, see +$ w3iors.ftn for additional doc. +$ + 20151214 120000 0 20151215 000000 T + 20151214 120000 3600 20151215 000000 +$ +$ Type 5 : Boundary data (no additional data required). +$ The data file is nestN.ww3, see +$ w3iobp.ftn for additional doc. +$ + 20040601 000000 0 20040103 000000 +$ +$ Type 6 : Separated wave field data (dummy for now). +$ First, last step IX and IY, flag for formatted file +$ + 20060101 000000 0 20040603 000000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ Homogeneous fields can be defined by a list of lines containing an ID +$ string 'LEV' 'CUR' 'WND', date and time information (yyyymmdd +$ hhmmss), value (S.I. units), direction (current and wind, oceanographic +$ convention degrees)) and air-sea temparature difference (degrees C). +$ 'STP' is mandatory stop string. +$ +$ 'WND' 20080101 000000 20. 315. 0.0 +$ + 'the_end' 0 +$ + 'STP' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ From ace2d3728a182e06b48da893073f180dfa2ad62d Mon Sep 17 00:00:00 2001 From: kestonsmith-noaa <107580916+kestonsmith-noaa@users.noreply.github.com> Date: Thu, 16 Apr 2026 11:49:16 -0400 Subject: [PATCH 134/136] Scaling of lateral boundary conditions by group velocity are simplified for cases with switch PDLIB (#1588) --- model/src/w3pro1md.F90 | 7 ++++++- model/src/w3pro2md.F90 | 4 ++++ model/src/w3pro3md.F90 | 4 ++++ model/src/w3profsmd.F90 | 14 +++++++++++++- model/src/w3profsmd_pdlib.F90 | 34 +++++++++++++++------------------- model/src/w3psmcmd.F90 | 4 ++++ model/src/w3updtmd.F90 | 21 ++++++++++++++++++++- model/src/w3wavemd.F90 | 8 +++++++- 8 files changed, 73 insertions(+), 23 deletions(-) diff --git a/model/src/w3pro1md.F90 b/model/src/w3pro1md.F90 index 35e7b0e247..40affc23e7 100644 --- a/model/src/w3pro1md.F90 +++ b/model/src/w3pro1md.F90 @@ -817,7 +817,12 @@ SUBROUTINE W3XYP1 ( ISP, DTG, MAPSTA, FIELD, VGX, VGY ) DO IBI=1, NBI IX = MAPSF(ISBPI(IBI),1) IY = MAPSF(ISBPI(IBI),2) - FLD2D(IY,IX) = RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) +#ifdef W3_PDLIB + ISEA = ISBPI(IBI) + FLD2D(IY,IX) = CG(IK,ISEA) * ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) +#else + FLD2D(IY,IX) = RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) +#endif END DO END IF ! diff --git a/model/src/w3pro2md.F90 b/model/src/w3pro2md.F90 index 0a26c8c944..e48f0408c9 100644 --- a/model/src/w3pro2md.F90 +++ b/model/src/w3pro2md.F90 @@ -1084,8 +1084,12 @@ SUBROUTINE W3XYP2 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) DO IBI=1, NBI ISEA = ISBPI(IBI) IXY = MAPSF(ISBPI(IBI),3) +#ifdef W3_PDLIB + VQ(IXY) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISEA) +#else VQ(IXY) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & / CG(IK,ISEA) * CLATS(ISEA) +#endif END DO END IF ! diff --git a/model/src/w3pro3md.F90 b/model/src/w3pro3md.F90 index 41b1337e33..51c487b000 100644 --- a/model/src/w3pro3md.F90 +++ b/model/src/w3pro3md.F90 @@ -1405,8 +1405,12 @@ SUBROUTINE W3XYP3 ( ISP, DTG, MAPSTA, MAPFS, VQ, VGX, VGY ) END IF DO IBI=1, NBI IXY = MAPSF(ISBPI(IBI),3) +#ifdef W3_PDLIB + VQ(IXY) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) +#else VQ(IXY) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) +#endif END DO END IF ! diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index e1118b8b95..e9d0af038b 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -706,8 +706,12 @@ SUBROUTINE W3XYPFSN2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! DO IBI=1, NBI IP = MAPSF(ISBPI(IBI),1) +#ifdef W3_PDLIB + AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) +#else AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) +#endif END DO ENDIF @@ -957,8 +961,12 @@ SUBROUTINE W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! DO IBI=1, NBI IP = MAPSF(ISBPI(IBI),1) +#ifdef W3_PDLIB + AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) +#else AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) +#endif END DO ENDIF @@ -1261,7 +1269,7 @@ SUBROUTINE W3XYPFSNIMP ( ISP, C, LCALC, RD10, RD20, DT, AC) DO IBI=1, NBI IP = MAPSF(ISBPI(IBI),1) AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - *IOBPA(IP)*IOBPD(ITH,IP) / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) + * IOBPA(IP) * IOBPD(ITH,IP) * CLATS(ISBPI(IBI)) END DO END IF @@ -1564,8 +1572,12 @@ SUBROUTINE W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) ! DO IBI=1, NBI IP = MAPSF(ISBPI(IBI),1) +#ifdef W3_PDLIB + AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) +#else AC(IP) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) +#endif END DO ENDIF diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 0508bb669d..9e355a228b 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -1162,12 +1162,11 @@ SUBROUTINE PDLIB_W3XYPFSN2(ISP, C, LCALC, RD10, RD20, DT, AC) IP_glob = MAPSF(ISBPI(IBI),1) JX=IPGL_npa(IP_glob) IF (JX .gt. 0) THEN - AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) + AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) #ifdef W3_DEBUGSOLVER sumAC=sumAC + AC(JX) - sumBPI0=sumBPI0 + BBPI0(ISP,IBI) - sumBPIN=sumBPIN + BBPIN(ISP,IBI) + sumBPI0=sumBPI0 + BBPI0(ISP,IBI) * CG(IK,ISBPI(IBI)) + sumBPIN=sumBPIN + BBPIN(ISP,IBI) * CG(IK,ISBPI(IBI)) sumCG=sumCG + CG(IK,ISBPI(IBI)) sumCLATS=sumCLATS + CLATS(ISBPI(IBI)) #endif @@ -1462,12 +1461,11 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) IP_glob = MAPSF(ISBPI(IBI),1) JX=IPGL_npa(IP_glob) IF (JX .gt. 0) THEN - AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) + AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) #ifdef W3_DEBUGSOLVER sumAC=sumAC + AC(JX) - sumBPI0=sumBPI0 + BBPI0(ISP,IBI) - sumBPIN=sumBPIN + BBPIN(ISP,IBI) + sumBPI0=sumBPI0 + BBPI0(ISP,IBI) * CG(IK,ISBPI(IBI)) + sumBPIN=sumBPIN + BBPIN(ISP,IBI) * CG(IK,ISBPI(IBI)) sumCG=sumCG + CG(IK,ISBPI(IBI)) sumCLATS=sumCLATS + CLATS(ISBPI(IBI)) #endif @@ -1837,12 +1835,11 @@ SUBROUTINE PDLIB_W3XYPFSFCT2 ( ISP, C, LCALC, RD10, RD20, DT, AC) IP_glob = MAPSF(ISBPI(IBI),1) JX=IPGL_npa(IP_glob) IF (JX .gt. 0) THEN - AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) + AC(JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) #ifdef W3_DEBUGSOLVER sumAC=sumAC + AC(JX) - sumBPI0=sumBPI0 + BBPI0(ISP,IBI) - sumBPIN=sumBPIN + BBPIN(ISP,IBI) + sumBPI0=sumBPI0 + BBPI0(ISP,IBI) * CG(IK,ISBPI(IBI)) + sumBPIN=sumBPIN + BBPIN(ISP,IBI) * CG(IK,ISBPI(IBI)) sumCG=sumCG + CG(IK,ISBPI(IBI)) sumCLATS=sumCLATS + CLATS(ISBPI(IBI)) #endif @@ -5136,9 +5133,8 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION_VA DO ITH=1,NTH DO IK=1,NK ISP=ITH + (IK-1)*NTH - eAC = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI)) - eVA = MAX(0., CG(IK,ISEA)/CLATS(ISEA)*eAC) + eAC = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) + eVA = MAX(0., CG(IK,ISEA) * eAC) VA(ISP,JSEA) = eVA END DO END DO @@ -5283,7 +5279,7 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION(IMOD) DO IK=1,NK ISP=ITH + (IK-1)*NTH VA(ISP,JX) = (( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) & - / CG(IK,ISBPI(IBI)) * CLATS(ISBPI(IBI))) * IOBDP_LOC(JX) + * CLATS(ISBPI(IBI))) * IOBDP_LOC(JX) END DO END DO #ifdef W3_DEBUGIOBC @@ -5303,8 +5299,8 @@ SUBROUTINE APPLY_BOUNDARY_CONDITION(IMOD) #ifdef W3_DEBUGSOLVER sumAC=sumAC + VA(:,JX) - sumBPI0=sumBPI0 + BBPI0(:,IBI) - sumBPIN=sumBPIN + BBPIN(:,IBI) + sumBPI0=sumBPI0 + BBPI0(:,IBI) * CG(IK,ISBPI(IBI)) + sumBPIN=sumBPIN + BBPIN(:,IBI) * CG(IK,ISBPI(IBI)) sumCG=sumCG + CG(IK,ISBPI(IBI)) sumCLATS=sumCLATS + CLATS(ISBPI(IBI)) #endif @@ -6659,7 +6655,7 @@ SUBROUTINE PDLIB_EXPLICIT_BLOCK(IMOD, FACX, FACY, RD10, RD20, DTG, VGX, VGY, LCA IP_glob = MAPSF(ISBPI(IBI),1) JX = IPGL_npa(IP_glob) IF (JX .gt. 0) THEN - U(ITH,JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) / CGSIG(ISBPI(IBI)) * CLATS(ISBPI(IBI)) + U(ITH,JX) = ( RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI) ) * CLATS(ISBPI(IBI)) END IF END DO ENDDO diff --git a/model/src/w3psmcmd.F90 b/model/src/w3psmcmd.F90 index 72d6a5bbb3..ca5d7e90f1 100644 --- a/model/src/w3psmcmd.F90 +++ b/model/src/w3psmcmd.F90 @@ -881,8 +881,12 @@ SUBROUTINE W3PSMC ( ISP, DTG, VQ ) END IF DO IBI=1, NBI ISEA = ISBPI(IBI) +#ifdef W3_PDLIB + CQ(ISEA) = (RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI)) +#else CQ(ISEA) = (RD1*BBPI0(ISP,IBI) + RD2*BBPIN(ISP,IBI)) & /CG(IK,ISEA) +#endif END DO ENDIF ! diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index d426349808..9d11228371 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -1447,11 +1447,18 @@ SUBROUTINE W3UBPT DO IBI=1, NBI ISEA = ISBPI(IBI) DO ISP=1, NSPEC +#ifdef W3_PDLIB + BBPI0(ISP,IBI) = ( RDBPI(IBI,1) * ABPI0(ISP,IPBPI(IBI,1)) & + + RDBPI(IBI,2) * ABPI0(ISP,IPBPI(IBI,2)) & + + RDBPI(IBI,3) * ABPI0(ISP,IPBPI(IBI,3)) & + + RDBPI(IBI,4) * ABPI0(ISP,IPBPI(IBI,4)) ) / SIG2(ISP) +#else BBPI0(ISP,IBI) = CG(MAPWN(ISP),ISEA) / SIG2(ISP) * & ( RDBPI(IBI,1) * ABPI0(ISP,IPBPI(IBI,1)) & + RDBPI(IBI,2) * ABPI0(ISP,IPBPI(IBI,2)) & + RDBPI(IBI,3) * ABPI0(ISP,IPBPI(IBI,3)) & + RDBPI(IBI,4) * ABPI0(ISP,IPBPI(IBI,4)) ) +#endif END DO END DO ! @@ -1466,11 +1473,18 @@ SUBROUTINE W3UBPT DO IBI=1, NBI ISEA = ISBPI(IBI) DO ISP=1, NSPEC - BBPIN(ISP,IBI) = CG(MAPWN(ISP),ISEA) / SIG2(ISP) * & +#ifdef W3_PDLIB + BBPIN(ISP,IBI) = ( RDBPI(IBI,1) * ABPIN(ISP,IPBPI(IBI,1)) & + + RDBPI(IBI,2) * ABPIN(ISP,IPBPI(IBI,2)) & + + RDBPI(IBI,3) * ABPIN(ISP,IPBPI(IBI,3)) & + + RDBPI(IBI,4) * ABPIN(ISP,IPBPI(IBI,4)) ) / SIG2(ISP) +#else + BBPIN(ISP,IBI) = CG(MAPWN(ISP),ISEA) / SIG2(ISP) * & ( RDBPI(IBI,1) * ABPIN(ISP,IPBPI(IBI,1)) & + RDBPI(IBI,2) * ABPIN(ISP,IPBPI(IBI,2)) & + RDBPI(IBI,3) * ABPIN(ISP,IPBPI(IBI,3)) & + RDBPI(IBI,4) * ABPIN(ISP,IPBPI(IBI,4)) ) +#endif END DO ! #ifdef W3_RTD @@ -1495,10 +1509,15 @@ SUBROUTINE W3UBPT HS1 = 0. HS2 = 0. DO ISP=1, NSPEC +#ifdef W3_PDLIB + HS1 = HS1 + BBPI0(ISP,IBI) * DDEN(MAPWN(ISP)) + HS2 = HS2 + BBPIN(ISP,IBI) * DDEN(MAPWN(ISP)) +#else HS1 = HS1 + BBPI0(ISP,IBI) * DDEN(MAPWN(ISP)) / & CG(MAPWN(ISP),ISBPI(IBI)) HS2 = HS2 + BBPIN(ISP,IBI) * DDEN(MAPWN(ISP)) / & CG(MAPWN(ISP),ISBPI(IBI)) +#endif END DO HS1 = 4. * SQRT ( HS1 ) HS2 = 4. * SQRT ( HS2 ) diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 7a2a39189e..880d3d2c97 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -566,6 +566,9 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #endif #if defined(W3_T) || defined(W3_SBS) USE W3GDATMD, ONLY : FILEXT +#endif +#ifdef W3_PDLIB + USE yowExchangeModule, only : PDLIB_exchange2Dreal_zero #endif ! #ifdef W3_MPI @@ -1314,7 +1317,10 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & call print_memcheck(memunit, 'memcheck_____:'//' WW3_WAVE TIME LOOP 7') #ifdef W3_PDLIB - CALL APPLY_BOUNDARY_CONDITION_VA + IF ( FLBPI ) THEN + CALL APPLY_BOUNDARY_CONDITION_VA + CALL PDLIB_exchange2DREAL_zero(VA) + END IF #ifdef W3_DEBUGCOH CALL ALL_VA_INTEGRAL_PRINT(IMOD, "After FLBPI and LOCAL", 1) #endif From ed516b88288bbb94d6295a21bc745d3f14f654ac Mon Sep 17 00:00:00 2001 From: kestonsmith-noaa <107580916+kestonsmith-noaa@users.noreply.github.com> Date: Wed, 22 Apr 2026 22:19:58 -0400 Subject: [PATCH 135/136] Added a test within regtest ww3_tp2.17 to illustrate a failure of restart reproducibility when variable water level is present and the domain has deep bathymetry. (#1589) --- regtests/bin/matrix.base | 15 + .../ww3_tp2.17/input_deep/DeepInlet425m.msh | 8909 +++++++++++++++++ regtests/ww3_tp2.17/input_deep/switch_PDLIB | 1 + regtests/ww3_tp2.17/input_deep/ww3_bounc.inp | 25 + regtests/ww3_tp2.17/input_deep/ww3_grib.inp | 10 + regtests/ww3_tp2.17/input_deep/ww3_grid_d.inp | 322 + regtests/ww3_tp2.17/input_deep/ww3_grid_e.inp | 322 + regtests/ww3_tp2.17/input_deep/ww3_ounf.inp | 84 + regtests/ww3_tp2.17/input_deep/ww3_ounp.inp | 118 + regtests/ww3_tp2.17/input_deep/ww3_outp.inp | 112 + .../input_deep/ww3_prnc_current.inp | 51 + .../ww3_tp2.17/input_deep/ww3_prnc_ice.inp | 51 + .../ww3_tp2.17/input_deep/ww3_prnc_level.inp | 51 + .../ww3_tp2.17/input_deep/ww3_prnc_wind.inp | 51 + regtests/ww3_tp2.17/input_deep/ww3_shel.inp | 148 + .../input_deep_restart/switch_PDLIB | 1 + .../ww3_tp2.17/input_deep_restart/switch_RWPS | 1 + .../input_deep_restart/switch_RWPSBS1 | 1 + .../input_deep_restart/switch_RWPSBT1 | 1 + .../input_deep_restart/ww3_bounc.inp | 25 + .../input_deep_restart/ww3_grib.inp | 10 + .../input_deep_restart/ww3_grid_d.inp | 322 + .../input_deep_restart/ww3_grid_e.inp | 322 + .../input_deep_restart/ww3_ounf.inp | 83 + .../input_deep_restart/ww3_ounp.inp | 118 + .../input_deep_restart/ww3_outp.inp | 112 + .../input_deep_restart/ww3_prnc_current.inp | 51 + .../input_deep_restart/ww3_prnc_ice.inp | 51 + .../input_deep_restart/ww3_prnc_level.inp | 51 + .../input_deep_restart/ww3_prnc_wind.inp | 51 + .../input_deep_restart/ww3_shel.inp | 148 + 31 files changed, 11618 insertions(+) create mode 100644 regtests/ww3_tp2.17/input_deep/DeepInlet425m.msh create mode 100644 regtests/ww3_tp2.17/input_deep/switch_PDLIB create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.17/input_deep/ww3_grib.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_grid_d.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_grid_e.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_ounf.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.17/input_deep/ww3_outp.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_prnc_current.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_prnc_ice.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_prnc_level.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_prnc_wind.inp create mode 100755 regtests/ww3_tp2.17/input_deep/ww3_shel.inp create mode 100644 regtests/ww3_tp2.17/input_deep_restart/switch_PDLIB create mode 100644 regtests/ww3_tp2.17/input_deep_restart/switch_RWPS create mode 100644 regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBS1 create mode 100644 regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBT1 create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_bounc.inp create mode 100644 regtests/ww3_tp2.17/input_deep_restart/ww3_grib.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_grid_d.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_grid_e.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_ounf.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_ounp.inp create mode 100644 regtests/ww3_tp2.17/input_deep_restart/ww3_outp.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_current.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_ice.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_level.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_wind.inp create mode 100755 regtests/ww3_tp2.17/input_deep_restart/ww3_shel.inp diff --git a/regtests/bin/matrix.base b/regtests/bin/matrix.base index 364d827ffc..b78bb09ba5 100755 --- a/regtests/bin/matrix.base +++ b/regtests/bin/matrix.base @@ -2028,9 +2028,17 @@ echo "$rtst -s MPI -s PDLIB -w work_pdlib -g pdlib -f -p $mpi -n $np $ww3 ww3_tp2.6" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mb -m grdset_b -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -w work_mc -m grdset_c -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body + echo "$rtst -s MPI -s PDLIB -i input_ice -w work_ice -g d -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "$rtst -s MPI -s PDLIB -i input_ice -w work_iceB -g d -f -p $mpi -n $(( $np -1 )) $ww3 ww3_tp2.17" >> matrix.body echo "./bin/test.comp ww3_tp2.17 work_ice work_iceB" >> matrix.body + + echo "$rtst -s MPI -s PDLIB -i input_deep -w work_deep -g e -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body + echo "$rtst -s MPI -s PDLIB -i input_deep -w work_deepB -g e -f -p $mpi -n $(( $np -1 )) $ww3 ww3_tp2.17" >> matrix.body + echo "./bin/test.comp ww3_tp2.17 work_deep work_deepB" >> matrix.body + + + if [ "$rstrt_b4b" = 'y' ] then echo "mkdir -p ww3_tp2.17/work_ma1" >> matrix.body @@ -2046,6 +2054,13 @@ echo "cp ww3_tp2.17/work_ice/20151214.120000.restart.ww3 ww3_tp2.17/work_ice_restart/restart.ww3" >> matrix.body echo "$rtst -s MPI -s PDLIB -i input_ice_restart -w work_ice_restart -g d -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body echo "./bin/test.comp ww3_tp2.17 work_ice work_ice_restart" >> matrix.body + + echo "mkdir -p ww3_tp2.17/work_deep_restart" >> matrix.body + echo "cp ww3_tp2.17/work_deep/20151214.120000.restart.ww3 ww3_tp2.17/work_deep_restart/restart.ww3" >> matrix.body + echo "$rtst -s MPI -s PDLIB -i input_deep_restart -w work_deep_restart -g e -f -p $mpi -n $np $ww3 ww3_tp2.17" >> matrix.body + echo "./bin/test.comp ww3_tp2.17 work_deep work_deep_restart" >> matrix.body + + fi fi diff --git a/regtests/ww3_tp2.17/input_deep/DeepInlet425m.msh b/regtests/ww3_tp2.17/input_deep/DeepInlet425m.msh new file mode 100644 index 0000000000..1b3144b120 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/DeepInlet425m.msh @@ -0,0 +1,8909 @@ +$MeshFormat +2 0 8 +$EndMeshFormat +$Nodes +3070 +1 -72.057678 40.990232 4.287804 +2 -72.052194 40.971343 13.825031 +3 -72.046969 40.952381 20.936428 +4 -72.041922 40.933371 28.505615 +5 -72.038364 40.914063 33.539403 +6 -72.035648 40.894596 40.582754 +7 -72.033377 40.875078 49.232434 +8 -72.032787 40.855419 57.068309 +9 -72.032512 40.835752 69.283520 +10 -72.033415 40.816117 77.533114 +11 -72.034686 40.796492 83.315992 +12 -72.037113 40.776990 95.447227 +13 -72.041410 40.757803 108.798059 +14 -72.043321 40.738290 124.372429 +15 -72.047722 40.719225 140.919868 +16 -72.053479 40.700422 157.899848 +17 -72.059887 40.681830 176.397252 +18 -72.068364 40.664099 193.199496 +19 -72.075969 40.645973 213.948041 +20 -72.084150 40.628092 237.964758 +21 -72.093376 40.610723 256.828144 +22 -72.103079 40.593616 275.595907 +23 -72.114488 40.577607 296.901886 +24 -72.126571 40.562087 316.595800 +25 -72.138668 40.546578 337.815981 +26 -72.150991 40.531253 360.064340 +27 -72.165740 40.518269 375.549700 +28 -72.179732 40.504450 394.855619 +29 -72.194064 40.490983 415.912157 +30 -72.209423 40.478703 425.314107 +31 -72.225647 40.467587 246.492445 +32 -72.241569 40.456039 246.492445 +33 -72.257990 40.445218 246.492445 +34 -72.275188 40.435679 246.492445 +35 -72.292839 40.427015 246.492445 +36 -72.311270 40.420155 246.492445 +37 -72.329368 40.412460 246.492445 +38 -72.348040 40.406307 246.492445 +39 -72.367179 40.401852 246.492445 +40 -72.385521 40.394787 246.492445 +41 -72.404704 40.390507 246.492445 +42 -72.424274 40.388586 246.492445 +43 -72.443883 40.387172 246.492445 +44 -72.463368 40.384627 246.492445 +45 -72.483036 40.384465 246.492445 +46 -72.502703 40.384549 246.492445 +47 -72.522329 40.385726 246.492445 +48 -72.541840 40.388204 246.492445 +49 -72.561389 40.390374 246.492445 +50 -72.580766 40.393613 246.492445 +51 -72.599806 40.398531 150.614542 +52 -72.618917 40.403169 147.180699 +53 -72.637591 40.409312 140.730558 +54 -72.655664 40.417066 132.598186 +55 -72.673754 40.424759 125.067200 +56 -72.691418 40.433260 117.821047 +57 -72.708749 40.442422 110.908372 +58 -72.726191 40.451362 104.560470 +59 -72.742316 40.462624 98.896492 +60 -72.758310 40.474072 96.523332 +61 -72.773822 40.486159 88.514445 +62 -72.788334 40.499423 81.093069 +63 -72.803300 40.512145 73.380475 +64 -72.817227 40.525934 66.634453 +65 -72.830439 40.540490 59.968157 +66 -72.843113 40.555511 53.646228 +67 -72.854776 40.571348 48.000536 +68 -72.866023 40.587485 43.630021 +69 -72.876573 40.604082 41.398066 +70 -72.886727 40.620928 38.632520 +71 -72.896092 40.638220 33.294225 +72 -72.903645 40.656368 28.225346 +73 -72.911610 40.674343 20.091558 +74 -72.918220 40.692864 17.741705 +75 -72.924093 40.711635 2.184524 +76 -72.069097 40.972053 12.277857 +77 -72.082624 40.981371 4.698896 +78 -72.070015 40.952217 20.507110 +79 -72.059546 40.936521 26.872387 +80 -72.057402 40.916820 32.349495 +81 -72.052253 40.892337 42.972008 +82 -72.050700 40.867549 54.244211 +83 -72.048129 40.843933 63.871477 +84 -72.048015 40.818256 75.761632 +85 -72.052601 40.794750 83.573909 +86 -72.054938 40.772645 97.238829 +87 -72.057778 40.750803 111.924035 +88 -72.061920 40.730744 128.004108 +89 -72.064939 40.712861 142.942021 +90 -72.075549 40.695781 155.913500 +91 -72.079325 40.671741 179.240928 +92 -72.096567 40.658910 186.102856 +93 -72.098346 40.638314 211.764068 +94 -72.103510 40.617443 237.579684 +95 -72.119741 40.605650 242.451252 +96 -72.125805 40.586414 272.104120 +97 -72.143822 40.577401 274.187198 +98 -72.151324 40.559227 300.807260 +99 -72.160409 40.540126 331.018817 +100 -72.179092 40.529820 338.243995 +101 -72.196882 40.521213 344.886999 +102 -72.204730 40.502332 379.526273 +103 -72.224631 40.495566 373.793442 +104 -72.234825 40.478142 395.859582 +105 -72.255465 40.471919 384.558397 +106 -72.266467 40.455540 246.492445 +107 -72.286719 40.447632 246.492445 +108 -72.307814 40.440760 246.492445 +109 -72.323813 40.429171 246.492445 +110 -72.341548 40.426598 246.492445 +111 -72.360150 40.422495 246.492445 +112 -72.381368 40.422134 246.492445 +113 -72.393538 40.408146 246.492445 +114 -72.416012 40.406801 246.492445 +115 -72.439572 40.404209 246.492445 +116 -72.463955 40.400104 246.492445 +117 -72.489829 40.400722 246.492445 +118 -72.513101 40.402764 246.492445 +119 -72.538735 40.403572 150.225999 +120 -72.563230 40.406820 146.106139 +121 -72.584137 40.408233 144.756820 +122 -72.600607 40.418647 138.088939 +123 -72.622095 40.423811 134.083958 +124 -72.640962 40.428903 129.691866 +125 -72.659423 40.432723 124.648654 +126 -72.674401 40.445420 116.271359 +127 -72.694813 40.456890 108.068816 +128 -72.717347 40.461596 102.518614 +129 -72.729478 40.477121 100.757724 +130 -72.750019 40.483102 94.516518 +131 -72.757033 40.501666 85.887532 +132 -72.778937 40.507581 79.944046 +133 -72.786122 40.526668 71.152812 +134 -72.806858 40.533775 65.434242 +135 -72.810842 40.553031 58.100580 +136 -72.828082 40.560627 53.443087 +137 -72.840759 40.573403 48.924325 +138 -72.852404 40.585260 46.039862 +139 -72.858642 40.600917 44.289197 +140 -72.865089 40.618543 41.460823 +141 -72.878046 40.635154 35.595415 +142 -72.885745 40.652837 29.902767 +143 -72.893030 40.669619 25.964467 +144 -72.901085 40.686030 20.359444 +145 -72.905633 40.703321 14.608801 +146 -72.903324 40.719164 1.616114 +147 -72.085871 40.964933 14.367728 +148 -72.106394 40.974268 5.131725 +149 -72.094098 40.948550 18.991327 +150 -72.077857 40.928418 27.608755 +151 -72.071305 40.903029 36.969222 +152 -72.069876 40.877986 49.857605 +153 -72.064371 40.853844 57.932406 +154 -72.061327 40.832551 70.008220 +155 -72.067306 40.812438 77.154428 +156 -72.070239 40.786816 87.579874 +157 -72.070306 40.763763 101.207842 +158 -72.074805 40.741741 116.655767 +159 -72.081585 40.720152 132.025230 +160 -72.094471 40.703390 142.389382 +161 -72.092656 40.682813 162.034485 +162 -72.107097 40.674386 164.241255 +163 -72.118056 40.662143 171.286083 +164 -72.116184 40.645751 189.964419 +165 -72.116695 40.626978 214.050315 +166 -72.131737 40.616916 217.784115 +167 -72.140718 40.599676 238.682694 +168 -72.156946 40.589296 245.775528 +169 -72.166689 40.572709 269.548987 +170 -72.172473 40.551416 301.533448 +171 -72.193524 40.544660 302.916084 +172 -72.209773 40.534353 310.935814 +173 -72.219497 40.517547 336.101592 +174 -72.236926 40.508478 338.619243 +175 -72.248130 40.492651 354.425575 +176 -72.266827 40.483888 350.753664 +177 -72.279829 40.468619 359.752208 +178 -72.298134 40.458546 338.281498 +179 -72.315903 40.458559 304.606215 +180 -72.329719 40.443765 298.960508 +181 -72.351216 40.444077 260.506536 +182 -72.370222 40.437093 244.590577 +183 -72.388923 40.442303 216.992224 +184 -72.405019 40.425732 219.739668 +185 -72.430012 40.420311 198.753459 +186 -72.454788 40.419720 180.413330 +187 -72.476317 40.413669 171.682838 +188 -72.497898 40.418529 158.270154 +189 -72.524091 40.419730 146.445494 +190 -72.550344 40.421751 138.375912 +191 -72.575265 40.421499 136.939660 +192 -72.588142 40.435103 129.043407 +193 -72.608638 40.437907 127.029334 +194 -72.628918 40.445267 121.628986 +195 -72.650501 40.445104 120.236144 +196 -72.660827 40.457758 113.266410 +197 -72.675990 40.465592 108.773661 +198 -72.689531 40.477860 102.913978 +199 -72.708292 40.475972 102.493742 +200 -72.720374 40.492373 95.650964 +201 -72.738428 40.493022 92.555752 +202 -72.734431 40.508413 86.993948 +203 -72.750547 40.520329 80.361991 +204 -72.767690 40.517810 78.399796 +205 -72.765601 40.533228 72.941385 +206 -72.778441 40.545733 66.406872 +207 -72.794698 40.543499 63.929358 +208 -72.791173 40.559293 60.565605 +209 -72.802420 40.572352 55.680292 +210 -72.816551 40.570198 53.258131 +211 -72.828434 40.580434 50.262930 +212 -72.842026 40.591955 47.124583 +213 -72.845728 40.609368 44.871521 +214 -72.845828 40.626804 40.269152 +215 -72.861866 40.634280 36.714210 +216 -72.869169 40.649237 31.803033 +217 -72.873697 40.667454 27.949728 +218 -72.883393 40.682902 23.944312 +219 -72.890981 40.696270 19.544485 +220 -72.888378 40.710319 13.521416 +221 -72.883386 40.725560 1.191722 +222 -72.114277 40.955678 14.303042 +223 -72.128265 40.966360 5.293334 +224 -72.113800 40.939199 19.358643 +225 -72.098670 40.927660 25.381932 +226 -72.089685 40.909601 31.804482 +227 -72.085452 40.890986 41.361465 +228 -72.092467 40.873736 47.548086 +229 -72.079450 40.859370 54.674835 +230 -72.077693 40.836987 65.702449 +231 -72.085878 40.819077 72.734148 +232 -72.081539 40.802164 79.874432 +233 -72.089098 40.788039 86.309578 +234 -72.084798 40.771909 94.510391 +235 -72.084023 40.754347 106.044804 +236 -72.093382 40.738289 116.522638 +237 -72.102296 40.721465 126.155016 +238 -72.113397 40.708003 134.225935 +239 -72.109112 40.691330 147.555106 +240 -72.122192 40.679569 152.733508 +241 -72.133443 40.668525 157.907168 +242 -72.136328 40.652517 172.347079 +243 -72.133493 40.634323 193.691447 +244 -72.147523 40.619552 205.727896 +245 -72.160550 40.605967 217.719159 +246 -72.174127 40.592311 231.174271 +247 -72.187240 40.579132 245.611461 +248 -72.184105 40.562544 277.701835 +249 -72.200884 40.565211 261.989566 +250 -72.213620 40.551767 279.186797 +251 -72.226968 40.538203 293.580108 +252 -72.240037 40.525426 307.634185 +253 -72.254092 40.512555 316.276414 +254 -72.267821 40.499992 323.256598 +255 -72.284017 40.487589 321.158905 +256 -72.300959 40.475539 314.370605 +257 -72.322038 40.474069 279.455562 +258 -72.335883 40.459945 270.174451 +259 -72.353524 40.464724 240.852237 +260 -72.369456 40.454048 226.964008 +261 -72.384016 40.462944 202.540894 +262 -72.397970 40.458629 196.332431 +263 -72.409660 40.446657 196.336123 +264 -72.422444 40.434879 194.507052 +265 -72.441437 40.435016 180.250326 +266 -72.459589 40.439567 165.392466 +267 -72.475936 40.429293 161.377890 +268 -72.492048 40.437430 148.840051 +269 -72.508326 40.432280 145.329711 +270 -72.521440 40.439481 136.220427 +271 -72.536112 40.433671 135.456034 +272 -72.550088 40.440764 129.729982 +273 -72.567116 40.436158 128.872343 +274 -72.577824 40.450424 121.255653 +275 -72.595673 40.451140 120.585608 +276 -72.612427 40.457168 116.662431 +277 -72.626916 40.466630 111.179272 +278 -72.643275 40.460655 112.985812 +279 -72.657772 40.473155 105.981150 +280 -72.671150 40.484357 100.611492 +281 -72.683389 40.495898 95.944831 +282 -72.701291 40.493157 96.451635 +283 -72.712849 40.507277 90.730246 +284 -72.720906 40.520134 84.503465 +285 -72.734111 40.526698 80.233435 +286 -72.747414 40.538503 74.378304 +287 -72.761459 40.549961 68.576034 +288 -72.773139 40.563930 62.422080 +289 -72.786457 40.576358 57.392243 +290 -72.798113 40.590733 52.839760 +291 -72.814091 40.586763 51.570395 +292 -72.828656 40.598154 47.939878 +293 -72.830308 40.614388 44.827200 +294 -72.827574 40.629645 41.306660 +295 -72.836406 40.642027 36.962413 +296 -72.851838 40.644539 34.791672 +297 -72.858473 40.658771 30.918634 +298 -72.854640 40.672683 28.602596 +299 -72.867288 40.684819 25.561834 +300 -72.875786 40.698772 20.458703 +301 -72.870782 40.714810 13.905058 +302 -72.864512 40.731692 1.103547 +303 -72.133199 40.947365 15.050189 +304 -72.148677 40.958722 5.360612 +305 -72.130253 40.931511 20.062391 +306 -72.117664 40.921837 24.315569 +307 -72.106190 40.910919 30.999067 +308 -72.104237 40.892805 38.883270 +309 -72.112549 40.875867 44.134266 +310 -72.106800 40.861788 51.335903 +311 -72.093373 40.852100 57.031468 +312 -72.095409 40.835125 65.014707 +313 -72.102188 40.820185 71.612396 +314 -72.098296 40.804671 79.243552 +315 -72.103530 40.790283 85.736967 +316 -72.101899 40.774975 92.861591 +317 -72.097281 40.758517 101.425303 +318 -72.107961 40.748929 106.474129 +319 -72.112387 40.736318 114.290339 +320 -72.123452 40.724290 120.845967 +321 -72.129363 40.711335 128.952434 +322 -72.127116 40.695720 138.814294 +323 -72.138798 40.682155 145.094788 +324 -72.150405 40.669708 150.793850 +325 -72.153731 40.654876 163.193801 +326 -72.151716 40.638059 181.309140 +327 -72.164826 40.622795 193.096017 +328 -72.179610 40.611017 201.036878 +329 -72.191961 40.596160 216.038278 +330 -72.206451 40.584441 226.049534 +331 -72.218533 40.569348 243.771170 +332 -72.232823 40.557702 255.624120 +333 -72.244880 40.542867 275.685542 +334 -72.259418 40.531601 284.531143 +335 -72.271513 40.517010 292.578929 +336 -72.285224 40.505829 291.973396 +337 -72.299642 40.495652 289.090839 +338 -72.313011 40.487801 281.546259 +339 -72.327851 40.490159 256.726147 +340 -72.339571 40.477520 250.142450 +341 -72.354458 40.484049 224.400546 +342 -72.369140 40.473711 212.131536 +343 -72.383912 40.479021 190.001286 +344 -72.397631 40.476962 181.465654 +345 -72.410396 40.467038 181.091737 +346 -72.421726 40.460944 177.915458 +347 -72.429638 40.448643 180.038371 +348 -72.446416 40.452225 166.508092 +349 -72.461098 40.458596 154.238208 +350 -72.475961 40.448174 151.429001 +351 -72.491204 40.452915 141.223927 +352 -72.505918 40.449909 136.261209 +353 -72.519600 40.454965 128.861971 +354 -72.534270 40.450968 128.046203 +355 -72.547869 40.455876 123.668923 +356 -72.561911 40.453119 122.489633 +357 -72.569623 40.468191 115.343795 +358 -72.584634 40.463592 114.809216 +359 -72.598129 40.468051 112.294045 +360 -72.611483 40.477372 106.922058 +361 -72.625447 40.485427 102.252548 +362 -72.640877 40.478179 104.663674 +363 -72.653895 40.490081 98.479310 +364 -72.664943 40.503176 92.944290 +365 -72.677556 40.510477 90.283340 +366 -72.694215 40.510566 90.372913 +367 -72.705592 40.523220 84.982727 +368 -72.716525 40.535995 79.092904 +369 -72.730046 40.540683 75.775411 +370 -72.734563 40.550723 71.935149 +371 -72.745798 40.555543 68.831305 +372 -72.755565 40.565242 64.619210 +373 -72.760416 40.576422 61.274415 +374 -72.771287 40.581751 58.567503 +375 -72.781330 40.592288 54.830043 +376 -72.786658 40.603742 51.928116 +377 -72.797714 40.607072 49.987023 +378 -72.812946 40.604106 48.743375 +379 -72.816795 40.619256 45.216927 +380 -72.810643 40.631446 42.869750 +381 -72.819319 40.642940 39.213089 +382 -72.827254 40.653296 35.960515 +383 -72.842317 40.658153 33.031891 +384 -72.838309 40.671548 30.510245 +385 -72.840633 40.683521 27.786674 +386 -72.853752 40.687683 25.657478 +387 -72.858680 40.702435 21.172471 +388 -72.854190 40.719414 15.264800 +389 -72.846542 40.737242 1.241602 +390 -72.152197 40.945123 12.980511 +391 -72.148134 40.930821 18.691002 +392 -72.167840 40.951650 5.004758 +393 -72.135797 40.916461 25.627303 +394 -72.121667 40.904639 31.512147 +395 -72.124159 40.888912 36.815530 +396 -72.129013 40.874023 42.545659 +397 -72.124810 40.859715 50.272083 +398 -72.111294 40.846618 58.118005 +399 -72.109492 40.832545 64.691086 +400 -72.116485 40.823322 68.259210 +401 -72.115482 40.811455 74.534684 +402 -72.115066 40.798916 81.810177 +403 -72.115845 40.784996 88.419736 +404 -72.118301 40.773815 93.832287 +405 -72.113329 40.762337 99.336944 +406 -72.124831 40.752116 104.636336 +407 -72.127854 40.738789 111.570236 +408 -72.141837 40.735663 112.697413 +409 -72.142646 40.721802 120.460063 +410 -72.141672 40.706106 129.540362 +411 -72.143740 40.694207 136.437473 +412 -72.155531 40.686475 139.272306 +413 -72.167322 40.679804 140.851496 +414 -72.167540 40.664967 149.845959 +415 -72.166570 40.649185 163.851960 +416 -72.169059 40.636621 175.590091 +417 -72.181655 40.629160 178.317864 +418 -72.194695 40.623789 180.210254 +419 -72.196725 40.610598 193.858693 +420 -72.208946 40.603148 197.981068 +421 -72.221718 40.597724 199.226099 +422 -72.223442 40.584175 217.409799 +423 -72.235514 40.576680 222.451447 +424 -72.248242 40.571261 224.062111 +425 -72.249917 40.557675 245.302404 +426 -72.262109 40.550259 250.689886 +427 -72.275004 40.544600 249.600407 +428 -72.276702 40.531081 267.450257 +429 -72.288951 40.522875 264.680080 +430 -72.301082 40.513394 263.682271 +431 -72.315984 40.504148 259.453357 +432 -72.331592 40.504371 240.328153 +433 -72.343236 40.495277 231.581596 +434 -72.357361 40.505216 204.511180 +435 -72.365450 40.490967 204.360956 +436 -72.377459 40.490720 189.894720 +437 -72.391255 40.493232 173.142994 +438 -72.404812 40.495671 163.385390 +439 -72.411361 40.482726 168.740741 +440 -72.424691 40.478420 164.113428 +441 -72.435510 40.464709 166.394035 +442 -72.450125 40.469969 154.497322 +443 -72.463865 40.479638 142.172224 +444 -72.472012 40.465360 145.046432 +445 -72.484085 40.464782 139.271516 +446 -72.497968 40.466542 131.941122 +447 -72.511368 40.468102 125.218633 +448 -72.525411 40.467614 122.516544 +449 -72.539354 40.467273 120.421339 +450 -72.553920 40.468620 117.591446 +451 -72.556984 40.483169 109.894593 +452 -72.569304 40.483624 108.081909 +453 -72.582983 40.479309 108.415226 +454 -72.595899 40.482773 105.746976 +455 -72.601056 40.492926 101.131864 +456 -72.612249 40.496440 98.509539 +457 -72.624060 40.503015 94.822352 +458 -72.637954 40.494856 97.332174 +459 -72.647808 40.506452 91.983982 +460 -72.653671 40.517857 87.433489 +461 -72.665882 40.523062 85.328699 +462 -72.680462 40.522376 85.554480 +463 -72.690660 40.528454 82.640718 +464 -72.700125 40.538921 77.976306 +465 -72.706398 40.549670 73.569064 +466 -72.719212 40.554063 71.820309 +467 -72.730139 40.564324 68.202861 +468 -72.741113 40.569544 65.451367 +469 -72.746091 40.580399 62.131023 +470 -72.755064 40.591155 58.486296 +471 -72.768217 40.595488 55.926265 +472 -72.772713 40.609131 52.003562 +473 -72.785459 40.619155 48.221832 +474 -72.802536 40.618943 46.826682 +475 -72.794651 40.632035 44.217166 +476 -72.803659 40.644072 40.732006 +477 -72.811753 40.657549 36.822046 +478 -72.825686 40.665617 33.407106 +479 -72.825749 40.679790 30.421665 +480 -72.828841 40.694388 26.966594 +481 -72.844150 40.696094 24.798754 +482 -72.840144 40.708775 21.545533 +483 -72.840306 40.722732 15.505800 +484 -72.832379 40.731045 10.904699 +485 -72.829432 40.742246 1.009313 +486 -72.167209 40.938322 13.644261 +487 -72.166633 40.925515 18.621433 +488 -72.153701 40.913912 23.961547 +489 -72.185743 40.944873 5.112281 +490 -72.139867 40.899614 31.137287 +491 -72.140665 40.882371 37.223764 +492 -72.143039 40.865063 47.825430 +493 -72.142126 40.849431 54.878725 +494 -72.128696 40.844953 57.360389 +495 -72.123850 40.833893 62.528861 +496 -72.129885 40.820463 69.276822 +497 -72.131422 40.805608 77.791211 +498 -72.127266 40.792735 84.221219 +499 -72.131170 40.780876 90.164472 +500 -72.130566 40.767267 96.922805 +501 -72.143273 40.760870 99.701506 +502 -72.139358 40.748008 106.374610 +503 -72.155705 40.750392 104.344052 +504 -72.158061 40.734739 112.015050 +505 -72.157825 40.721423 119.109395 +506 -72.153561 40.712067 124.458958 +507 -72.157032 40.700628 130.474999 +508 -72.172126 40.696260 130.770502 +509 -72.181892 40.687159 134.788544 +510 -72.181565 40.675685 141.502481 +511 -72.183518 40.664950 148.119299 +512 -72.179073 40.655830 155.237957 +513 -72.182554 40.644461 163.795649 +514 -72.197194 40.640734 165.348456 +515 -72.207652 40.631105 172.657521 +516 -72.210401 40.619096 180.583329 +517 -72.224777 40.615276 180.592828 +518 -72.234754 40.605279 185.823087 +519 -72.237186 40.592933 198.377415 +520 -72.251461 40.589020 196.689700 +521 -72.261383 40.578870 205.414567 +522 -72.263814 40.566450 222.471051 +523 -72.278242 40.562290 219.730655 +524 -72.288252 40.551599 226.520240 +525 -72.290723 40.538910 241.133302 +526 -72.304909 40.532894 234.627634 +527 -72.313716 40.519743 243.086254 +528 -72.328086 40.518474 230.226246 +529 -72.343806 40.512163 217.301322 +530 -72.356084 40.524289 186.812043 +531 -72.371261 40.519161 177.714599 +532 -72.370740 40.503551 189.360829 +533 -72.382768 40.506070 174.508809 +534 -72.397084 40.509268 158.539932 +535 -72.411995 40.512682 148.411171 +536 -72.419212 40.495682 155.522625 +537 -72.434460 40.494411 148.443367 +538 -72.438831 40.479384 155.724653 +539 -72.450305 40.486899 144.629610 +540 -72.462599 40.498160 131.128077 +541 -72.477558 40.493893 126.812316 +542 -72.477120 40.477938 136.246657 +543 -72.489018 40.480084 129.091821 +544 -72.503037 40.482414 121.359234 +545 -72.517500 40.484550 115.455617 +546 -72.531170 40.479446 115.255865 +547 -72.543641 40.482193 112.144828 +548 -72.545972 40.498296 104.087359 +549 -72.561582 40.496968 102.806648 +550 -72.574864 40.493732 102.884741 +551 -72.586774 40.497300 100.754818 +552 -72.597962 40.508525 95.737960 +553 -72.611784 40.512971 92.694717 +554 -72.623816 40.520124 89.074300 +555 -72.634515 40.510176 91.255703 +556 -72.638403 40.524328 86.302153 +557 -72.650705 40.532596 82.514644 +558 -72.661071 40.539409 78.872937 +559 -72.674474 40.537407 78.776574 +560 -72.686947 40.542358 76.610964 +561 -72.691558 40.555548 71.373424 +562 -72.704413 40.563801 68.524010 +563 -72.716592 40.571517 66.226914 +564 -72.729404 40.581229 63.126735 +565 -72.738583 40.594309 59.203025 +566 -72.746554 40.606124 54.539600 +567 -72.759589 40.604240 54.343155 +568 -72.756884 40.617296 50.314730 +569 -72.768774 40.624665 47.700483 +570 -72.779425 40.634254 44.634144 +571 -72.787836 40.645694 41.791757 +572 -72.796678 40.655253 38.762396 +573 -72.798156 40.667349 35.594966 +574 -72.811788 40.673085 33.394141 +575 -72.812598 40.687458 30.013664 +576 -72.813854 40.699393 26.873030 +577 -72.823915 40.706977 24.096864 +578 -72.825145 40.719257 19.151329 +579 -72.819345 40.733820 12.286455 +580 -72.813358 40.747434 1.664184 +581 -72.183898 40.932882 13.691480 +582 -72.183308 40.920905 18.204844 +583 -72.171397 40.914275 21.470695 +584 -72.169263 40.903969 24.823349 +585 -72.155872 40.900412 27.786973 +586 -72.202686 40.938980 4.343882 +587 -72.154254 40.888393 32.324815 +588 -72.155321 40.875684 38.420484 +589 -72.158720 40.864066 44.739581 +590 -72.157458 40.852897 52.140359 +591 -72.156961 40.839278 58.453763 +592 -72.141202 40.832823 62.780425 +593 -72.144119 40.816819 70.840572 +594 -72.146593 40.803374 77.686138 +595 -72.141242 40.791714 84.330593 +596 -72.146905 40.777313 91.446675 +597 -72.159163 40.766871 95.882719 +598 -72.172383 40.760182 98.454836 +599 -72.171434 40.746214 105.093642 +600 -72.174603 40.733933 111.055149 +601 -72.168180 40.724548 116.374143 +602 -72.168656 40.711015 123.173560 +603 -72.184426 40.709031 121.346779 +604 -72.190558 40.697753 126.917625 +605 -72.197107 40.683930 134.983047 +606 -72.194176 40.670704 143.159440 +607 -72.195235 40.656638 153.110480 +608 -72.210779 40.654534 153.422097 +609 -72.212208 40.641268 163.716788 +610 -72.223649 40.631786 169.685654 +611 -72.238953 40.629622 168.468003 +612 -72.239626 40.615768 177.533687 +613 -72.250605 40.605845 183.001202 +614 -72.265807 40.603437 177.985464 +615 -72.266347 40.589416 188.667157 +616 -72.277367 40.579276 196.379716 +617 -72.292677 40.576444 190.309903 +618 -72.293243 40.562070 207.854267 +619 -72.304359 40.551009 212.788514 +620 -72.319657 40.547122 203.859664 +621 -72.319341 40.531466 222.374826 +622 -72.331064 40.534810 204.883096 +623 -72.341060 40.525408 202.126798 +624 -72.344883 40.537788 181.819895 +625 -72.355998 40.540184 166.961524 +626 -72.369054 40.536876 158.886797 +627 -72.383447 40.531750 152.068752 +628 -72.386732 40.518983 163.122722 +629 -72.399277 40.526526 145.371354 +630 -72.413231 40.528511 136.752602 +631 -72.426373 40.524203 132.717770 +632 -72.426061 40.508324 143.403586 +633 -72.438640 40.512371 133.910423 +634 -72.447267 40.499925 137.443375 +635 -72.452017 40.509414 128.988268 +636 -72.461504 40.513448 122.373907 +637 -72.474544 40.512113 117.859404 +638 -72.489247 40.507339 114.689805 +639 -72.492713 40.493329 120.240876 +640 -72.505405 40.499610 112.393488 +641 -72.519881 40.499816 108.328635 +642 -72.531848 40.493161 108.270292 +643 -72.530934 40.509472 101.706439 +644 -72.543084 40.513825 97.577309 +645 -72.555788 40.510083 97.781251 +646 -72.571525 40.508403 97.479804 +647 -72.583781 40.512838 95.160979 +648 -72.588777 40.524919 90.693547 +649 -72.600986 40.522932 90.474700 +650 -72.611193 40.529005 87.484505 +651 -72.623701 40.536297 84.042508 +652 -72.637861 40.540942 81.398361 +653 -72.649672 40.549233 77.907028 +654 -72.663549 40.554352 74.459629 +655 -72.677755 40.551658 73.115633 +656 -72.675850 40.565609 69.923851 +657 -72.690301 40.570924 66.858947 +658 -72.702060 40.579319 64.267787 +659 -72.713773 40.586985 61.952041 +660 -72.723883 40.597638 58.551845 +661 -72.731549 40.609980 54.840319 +662 -72.741917 40.620603 50.550492 +663 -72.752532 40.633193 46.413322 +664 -72.765190 40.638410 44.321991 +665 -72.773004 40.648407 41.270048 +666 -72.782698 40.660646 38.002533 +667 -72.786266 40.674350 34.445325 +668 -72.798212 40.682004 32.327379 +669 -72.798440 40.697150 28.207084 +670 -72.808518 40.711558 21.671251 +671 -72.811571 40.724691 19.159616 +672 -72.805274 40.737173 12.866923 +673 -72.798092 40.752232 1.578114 +674 -72.199406 40.927656 13.597709 +675 -72.195026 40.916521 18.478363 +676 -72.185133 40.906664 23.552878 +677 -72.180783 40.893641 27.741454 +678 -72.166834 40.893066 28.747476 +679 -72.218451 40.933134 5.425054 +680 -72.171348 40.881587 33.640642 +681 -72.168395 40.870048 39.460661 +682 -72.172312 40.858294 46.251848 +683 -72.173229 40.845205 52.892228 +684 -72.171924 40.831447 59.579830 +685 -72.157172 40.824821 65.163884 +686 -72.158144 40.809857 72.526551 +687 -72.157747 40.793281 82.013687 +688 -72.163077 40.780936 89.061039 +689 -72.175316 40.774968 90.930257 +690 -72.188497 40.767978 93.167755 +691 -72.186216 40.754263 100.286707 +692 -72.186220 40.741641 106.482431 +693 -72.187088 40.730324 111.393789 +694 -72.180021 40.720939 116.386337 +695 -72.194964 40.721025 113.819996 +696 -72.201112 40.710462 117.620930 +697 -72.205388 40.697702 124.676622 +698 -72.212310 40.685355 131.675301 +699 -72.207665 40.670204 142.366436 +700 -72.222802 40.665802 144.377421 +701 -72.226803 40.655192 151.768725 +702 -72.222900 40.645487 159.497433 +703 -72.237567 40.645935 158.029260 +704 -72.251316 40.642005 158.892562 +705 -72.254462 40.630089 166.346682 +706 -72.250333 40.619993 173.318038 +707 -72.264757 40.619985 171.778843 +708 -72.278350 40.615823 168.663151 +709 -72.281322 40.603727 171.760701 +710 -72.277125 40.593575 178.414781 +711 -72.291637 40.593361 172.144235 +712 -72.305225 40.588788 166.623953 +713 -72.308241 40.576198 179.786836 +714 -72.304063 40.565854 194.888373 +715 -72.318639 40.565042 185.156659 +716 -72.332509 40.560279 173.086943 +717 -72.334934 40.547289 184.222853 +718 -72.347605 40.553483 162.091260 +719 -72.361117 40.550722 150.873543 +720 -72.372353 40.554933 137.987650 +721 -72.381169 40.545651 140.084882 +722 -72.393769 40.543366 135.678188 +723 -72.406960 40.541041 131.601626 +724 -72.421523 40.540174 125.244040 +725 -72.434863 40.539987 119.238762 +726 -72.439871 40.527516 124.085620 +727 -72.450603 40.522072 122.211307 +728 -72.462715 40.526166 114.830215 +729 -72.474219 40.528017 109.607465 +730 -72.487020 40.524577 107.039019 +731 -72.500791 40.516389 106.580875 +732 -72.514740 40.512542 104.619953 +733 -72.522986 40.522518 98.574254 +734 -72.535161 40.526881 94.118527 +735 -72.549602 40.524877 92.884196 +736 -72.562431 40.520470 93.656690 +737 -72.574069 40.525515 91.280148 +738 -72.581382 40.538734 86.619350 +739 -72.596223 40.538061 86.036871 +740 -72.608623 40.542258 83.657764 +741 -72.614439 40.552127 80.281569 +742 -72.626961 40.550014 79.786447 +743 -72.637033 40.556792 77.083809 +744 -72.648140 40.566127 73.637323 +745 -72.661305 40.569059 71.064515 +746 -72.666259 40.580659 67.453373 +747 -72.678593 40.579253 66.172073 +748 -72.688303 40.586014 63.496001 +749 -72.698603 40.595578 60.904295 +750 -72.710939 40.600475 58.521246 +751 -72.715589 40.613546 54.834391 +752 -72.725862 40.625672 50.792589 +753 -72.738255 40.632981 47.587862 +754 -72.740911 40.646360 44.076254 +755 -72.755417 40.650596 41.479413 +756 -72.767691 40.659905 38.646060 +757 -72.772084 40.673257 35.189143 +758 -72.782531 40.687850 31.707227 +759 -72.783731 40.701295 28.819222 +760 -72.792499 40.711538 25.619860 +761 -72.798896 40.723864 20.587041 +762 -72.792622 40.736422 15.638937 +763 -72.786062 40.745892 10.671032 +764 -72.783556 40.756577 1.024488 +765 -72.208715 40.919010 15.811978 +766 -72.199924 40.907823 21.096147 +767 -72.196930 40.895316 25.995936 +768 -72.188224 40.881974 31.690295 +769 -72.221235 40.919044 14.613447 +770 -72.233129 40.927400 4.493190 +771 -72.181613 40.869079 39.143644 +772 -72.187826 40.854269 45.701625 +773 -72.188528 40.837195 53.665582 +774 -72.183868 40.823008 61.317861 +775 -72.171259 40.816921 66.606870 +776 -72.170196 40.803352 74.781544 +777 -72.176273 40.791141 81.474932 +778 -72.190071 40.782137 83.790675 +779 -72.204559 40.774831 85.672561 +780 -72.200882 40.759997 95.607619 +781 -72.198992 40.746776 103.467883 +782 -72.198912 40.733610 109.081682 +783 -72.211611 40.724631 110.625569 +784 -72.216370 40.710722 115.833193 +785 -72.217657 40.696741 123.840056 +786 -72.228760 40.688693 128.248243 +787 -72.221204 40.677344 136.556304 +788 -72.234512 40.675564 136.729081 +789 -72.238273 40.662145 145.731321 +790 -72.252668 40.657975 146.806736 +791 -72.263163 40.648848 151.150170 +792 -72.266070 40.636131 160.500274 +793 -72.280179 40.631938 158.795782 +794 -72.290259 40.622662 157.079476 +795 -72.292957 40.609690 161.867033 +796 -72.307194 40.605469 152.307313 +797 -72.317071 40.595320 150.199974 +798 -72.319917 40.581965 162.794269 +799 -72.334226 40.577214 154.342878 +800 -72.344963 40.567365 151.969679 +801 -72.359332 40.565026 139.649590 +802 -72.374083 40.568977 126.968561 +803 -72.387537 40.559575 127.472923 +804 -72.402082 40.556240 123.798869 +805 -72.414894 40.551803 121.498122 +806 -72.428407 40.555416 113.611904 +807 -72.443243 40.551672 109.487510 +808 -72.450691 40.537581 113.725283 +809 -72.465557 40.539742 107.088194 +810 -72.479290 40.539722 102.900563 +811 -72.492247 40.541643 98.369307 +812 -72.499354 40.531032 100.594057 +813 -72.510816 40.527558 99.286426 +814 -72.520876 40.536410 93.500532 +815 -72.531675 40.540704 90.284160 +816 -72.545492 40.539657 88.918348 +817 -72.559430 40.533517 89.603136 +818 -72.569182 40.540093 87.053648 +819 -72.572137 40.553693 83.150242 +820 -72.586115 40.550650 83.073815 +821 -72.598366 40.554451 80.972316 +822 -72.607766 40.564568 77.346421 +823 -72.622585 40.563785 76.396805 +824 -72.634090 40.569933 73.898661 +825 -72.637330 40.582893 70.188635 +826 -72.652244 40.580746 69.320114 +827 -72.658036 40.594015 64.579513 +828 -72.672822 40.593182 63.659970 +829 -72.684970 40.598482 61.036949 +830 -72.687885 40.611396 57.620186 +831 -72.701847 40.609241 57.045731 +832 -72.698636 40.622652 53.900780 +833 -72.711814 40.627283 51.787276 +834 -72.715028 40.640786 48.077314 +835 -72.728482 40.640038 46.976650 +836 -72.725897 40.653392 44.080936 +837 -72.740675 40.662050 40.472239 +838 -72.756072 40.666014 37.954323 +839 -72.758948 40.678314 35.483588 +840 -72.767825 40.686296 33.017768 +841 -72.768860 40.699259 30.428088 +842 -72.777051 40.712714 26.434358 +843 -72.784768 40.724095 22.216398 +844 -72.779191 40.735913 18.647383 +845 -72.774374 40.748336 11.169808 +846 -72.769715 40.760429 1.343061 +847 -72.212579 40.905282 19.997040 +848 -72.211280 40.892685 24.995341 +849 -72.203208 40.881895 30.150180 +850 -72.195622 40.869418 36.158377 +851 -72.233699 40.917209 11.878295 +852 -72.225708 40.908561 17.961500 +853 -72.247047 40.922461 5.586777 +854 -72.202722 40.859559 39.537808 +855 -72.202135 40.847433 45.605086 +856 -72.203355 40.834751 51.631588 +857 -72.198495 40.821034 58.947732 +858 -72.185262 40.808145 68.885195 +859 -72.191207 40.795550 75.801890 +860 -72.204116 40.790148 76.365263 +861 -72.218560 40.785401 77.162697 +862 -72.219041 40.772433 85.394692 +863 -72.214826 40.762304 91.533597 +864 -72.212331 40.749639 100.038675 +865 -72.210110 40.738166 106.411536 +866 -72.224408 40.737747 104.301891 +867 -72.228324 40.723596 108.838955 +868 -72.229622 40.710498 114.560740 +869 -72.226804 40.701187 120.275714 +870 -72.239507 40.700143 120.205218 +871 -72.243448 40.686453 128.857336 +872 -72.248764 40.673051 137.319546 +873 -72.262973 40.672012 135.598603 +874 -72.269615 40.659994 142.008925 +875 -72.276606 40.646872 149.980203 +876 -72.291195 40.646095 142.595185 +877 -72.296934 40.634070 146.814101 +878 -72.303409 40.620336 149.267882 +879 -72.318546 40.620967 137.412974 +880 -72.323413 40.606522 138.863337 +881 -72.330421 40.592803 143.421279 +882 -72.345093 40.592088 131.353693 +883 -72.351181 40.579561 135.575074 +884 -72.364187 40.578461 127.015158 +885 -72.375418 40.584515 118.419551 +886 -72.385560 40.574093 119.580053 +887 -72.399592 40.572134 115.314448 +888 -72.414271 40.564799 114.238902 +889 -72.427290 40.571097 106.119278 +890 -72.439956 40.566418 103.687613 +891 -72.451590 40.562011 101.888190 +892 -72.457685 40.551086 104.592152 +893 -72.471419 40.552821 99.720712 +894 -72.483630 40.552243 96.573676 +895 -72.495214 40.557291 91.603219 +896 -72.507080 40.543881 93.573587 +897 -72.521482 40.551941 88.364789 +898 -72.535424 40.550462 87.138884 +899 -72.546089 40.555345 84.630558 +900 -72.558055 40.547789 85.650812 +901 -72.558136 40.561623 81.945857 +902 -72.569180 40.567851 79.571861 +903 -72.582744 40.565518 79.109072 +904 -72.595249 40.568266 77.328018 +905 -72.601629 40.577995 74.235815 +906 -72.613534 40.574400 74.277502 +907 -72.623928 40.578904 72.361075 +908 -72.622478 40.592536 68.888305 +909 -72.633502 40.599087 65.348250 +910 -72.645438 40.593058 65.771584 +911 -72.646791 40.606879 61.433963 +912 -72.662505 40.606831 60.474510 +913 -72.675429 40.606472 59.790418 +914 -72.670784 40.619606 56.453387 +915 -72.683885 40.624887 54.319650 +916 -72.688235 40.637425 50.994669 +917 -72.702072 40.635816 50.485837 +918 -72.698989 40.649071 47.453750 +919 -72.711135 40.653923 45.389626 +920 -72.714164 40.665177 42.662009 +921 -72.726696 40.666454 41.166088 +922 -72.731137 40.678284 38.338351 +923 -72.746113 40.676360 37.251497 +924 -72.754067 40.690559 33.533055 +925 -72.754061 40.703940 29.438633 +926 -72.763910 40.713049 26.125735 +927 -72.769594 40.726142 22.691505 +928 -72.767605 40.739060 18.560028 +929 -72.761716 40.750117 11.866426 +930 -72.756424 40.763400 4.231180 +931 -72.225523 40.896625 21.473695 +932 -72.218193 40.882800 28.557050 +933 -72.211217 40.870466 34.044867 +934 -72.238196 40.907495 17.219841 +935 -72.251183 40.906704 14.732720 +936 -72.259859 40.917223 5.174624 +937 -72.216743 40.857241 38.912952 +938 -72.215653 40.842294 45.715974 +939 -72.214233 40.827894 52.550832 +940 -72.213735 40.814291 59.611939 +941 -72.201454 40.805525 67.136359 +942 -72.215595 40.799983 67.943712 +943 -72.229342 40.796288 68.798904 +944 -72.234054 40.784253 78.802483 +945 -72.229580 40.775272 85.577955 +946 -72.230449 40.762920 91.380727 +947 -72.224004 40.752055 98.110586 +948 -72.236057 40.748400 98.586338 +949 -72.241743 40.735185 100.648156 +950 -72.243041 40.722080 105.484986 +951 -72.239003 40.713098 112.512097 +952 -72.251728 40.709742 111.949932 +953 -72.252076 40.696669 120.997451 +954 -72.257894 40.685429 128.229052 +955 -72.271600 40.685320 125.529172 +956 -72.277793 40.672033 132.496894 +957 -72.284568 40.659215 138.106706 +958 -72.299344 40.659135 128.005009 +959 -72.307900 40.646138 132.369897 +960 -72.310094 40.632191 139.603264 +961 -72.322204 40.637964 127.339488 +962 -72.333565 40.629476 121.864552 +963 -72.331757 40.616569 128.875593 +964 -72.338395 40.605213 128.184888 +965 -72.352778 40.606252 119.820623 +966 -72.361775 40.592940 121.355643 +967 -72.378355 40.599349 110.450345 +968 -72.389350 40.586249 112.302244 +969 -72.403291 40.587261 106.888794 +970 -72.413859 40.578663 106.965498 +971 -72.425808 40.583098 101.363226 +972 -72.440236 40.581542 97.407830 +973 -72.453049 40.574795 96.310726 +974 -72.464182 40.564706 97.006655 +975 -72.479471 40.566180 92.305241 +976 -72.492763 40.572806 86.739490 +977 -72.504369 40.567471 86.094518 +978 -72.509485 40.557414 88.172261 +979 -72.518558 40.568435 83.764501 +980 -72.532429 40.562482 84.296218 +981 -72.545219 40.569110 81.234983 +982 -72.558071 40.575742 78.235994 +983 -72.572776 40.581302 75.583165 +984 -72.587740 40.579763 74.833980 +985 -72.597118 40.590607 71.378717 +986 -72.610982 40.586627 71.368890 +987 -72.607554 40.599838 68.404860 +988 -72.618712 40.606458 64.860013 +989 -72.631129 40.612036 61.716968 +990 -72.640554 40.620677 58.254958 +991 -72.654761 40.619427 57.444037 +992 -72.659570 40.631931 53.831340 +993 -72.673185 40.634190 52.624178 +994 -72.674691 40.647064 49.562167 +995 -72.685616 40.650767 47.939723 +996 -72.688712 40.661934 45.281924 +997 -72.701097 40.664003 44.041137 +998 -72.704687 40.677996 40.440688 +999 -72.718111 40.675980 39.881001 +1000 -72.716060 40.688630 36.438921 +1001 -72.729102 40.693067 34.634728 +1002 -72.740427 40.687301 35.715362 +1003 -72.741480 40.699053 32.513193 +1004 -72.741574 40.711814 29.337623 +1005 -72.751895 40.715603 27.015374 +1006 -72.757248 40.724247 24.484876 +1007 -72.755503 40.736811 20.447934 +1008 -72.749746 40.751442 13.763284 +1009 -72.743932 40.766682 1.604925 +1010 -72.240617 40.895017 20.420730 +1011 -72.231012 40.885242 25.875876 +1012 -72.226726 40.871942 31.545302 +1013 -72.265933 40.902846 12.932603 +1014 -72.253801 40.893256 19.492901 +1015 -72.271761 40.912065 4.619347 +1016 -72.230613 40.860145 36.094713 +1017 -72.228490 40.848704 41.628713 +1018 -72.227595 40.835195 47.988653 +1019 -72.227155 40.822281 54.122743 +1020 -72.227706 40.808889 60.514755 +1021 -72.242892 40.804810 60.090624 +1022 -72.241052 40.793003 67.060670 +1023 -72.246324 40.783379 74.064802 +1024 -72.243266 40.771888 85.273751 +1025 -72.243241 40.759109 90.087623 +1026 -72.250748 40.748657 92.043013 +1027 -72.258364 40.737590 91.979654 +1028 -72.254397 40.724654 101.214989 +1029 -72.263477 40.713885 106.707154 +1030 -72.265561 40.699841 115.496086 +1031 -72.280442 40.697120 115.299612 +1032 -72.285493 40.683790 123.607801 +1033 -72.292444 40.671177 124.762316 +1034 -72.308127 40.673121 112.844326 +1035 -72.312224 40.659751 119.464125 +1036 -72.323323 40.652500 114.957179 +1037 -72.336907 40.644954 109.861752 +1038 -72.348118 40.632294 109.837990 +1039 -72.345041 40.618769 117.186135 +1040 -72.360490 40.621373 108.795395 +1041 -72.365905 40.607120 112.993022 +1042 -72.375717 40.615737 104.962450 +1043 -72.389065 40.611189 101.611012 +1044 -72.393569 40.598422 105.423614 +1045 -72.406517 40.599231 100.853634 +1046 -72.417388 40.593704 100.146074 +1047 -72.430847 40.591938 97.049550 +1048 -72.441753 40.595914 92.041424 +1049 -72.455565 40.589344 90.398635 +1050 -72.467318 40.578195 91.058393 +1051 -72.481103 40.580965 86.599995 +1052 -72.494614 40.586580 82.366751 +1053 -72.506443 40.579348 82.256490 +1054 -72.519298 40.583189 79.226911 +1055 -72.531864 40.575809 80.370323 +1056 -72.545007 40.582447 77.352408 +1057 -72.557925 40.588990 74.141915 +1058 -72.569184 40.596492 71.384101 +1059 -72.583000 40.592883 71.726075 +1060 -72.593258 40.603811 68.209189 +1061 -72.603146 40.614672 64.135413 +1062 -72.616661 40.619299 61.226756 +1063 -72.627730 40.623369 58.870132 +1064 -72.631981 40.632834 55.836086 +1065 -72.645594 40.631977 54.474263 +1066 -72.648982 40.643770 51.089538 +1067 -72.661935 40.644928 50.367856 +1068 -72.663801 40.657595 47.722080 +1069 -72.675805 40.660179 46.712049 +1070 -72.678130 40.672290 43.827991 +1071 -72.690966 40.674705 41.990376 +1072 -72.692030 40.687255 38.757068 +1073 -72.702943 40.691378 36.659952 +1074 -72.706903 40.703457 33.424884 +1075 -72.719182 40.701496 32.516151 +1076 -72.729680 40.706757 30.863192 +1077 -72.731082 40.719422 27.141652 +1078 -72.744445 40.725944 22.987259 +1079 -72.742158 40.739712 18.680574 +1080 -72.738418 40.751707 15.431403 +1081 -72.733725 40.760706 10.065520 +1082 -72.732153 40.770011 1.486827 +1083 -72.242856 40.880631 25.496611 +1084 -72.239695 40.867899 31.141395 +1085 -72.279355 40.896495 14.444712 +1086 -72.267014 40.889595 19.119980 +1087 -72.256190 40.881658 23.219453 +1088 -72.283126 40.907750 4.827553 +1089 -72.242946 40.855334 35.729191 +1090 -72.238923 40.842443 42.993696 +1091 -72.241508 40.829758 49.133609 +1092 -72.238569 40.816789 55.494508 +1093 -72.251635 40.817725 54.231270 +1094 -72.257285 40.804418 58.004947 +1095 -72.252644 40.792898 63.958875 +1096 -72.257903 40.778199 70.733278 +1097 -72.255496 40.762999 80.914914 +1098 -72.265931 40.751630 82.375681 +1099 -72.271914 40.737835 89.192057 +1100 -72.267772 40.725385 97.983038 +1101 -72.276632 40.711617 105.612550 +1102 -72.291108 40.706136 103.967167 +1103 -72.294928 40.693920 111.584946 +1104 -72.298307 40.682114 115.470437 +1105 -72.308766 40.689023 104.382206 +1106 -72.320623 40.682406 99.322713 +1107 -72.322419 40.667780 106.064014 +1108 -72.335489 40.661158 99.813803 +1109 -72.348269 40.656458 94.473769 +1110 -72.351069 40.644287 100.708343 +1111 -72.362301 40.636804 99.947359 +1112 -72.374282 40.630137 98.151772 +1113 -72.387589 40.624209 96.239199 +1114 -72.402599 40.620290 95.922773 +1115 -72.401412 40.608429 99.349905 +1116 -72.415236 40.609318 96.345292 +1117 -72.428522 40.603621 95.121984 +1118 -72.440903 40.609055 89.239318 +1119 -72.451684 40.602657 87.255455 +1120 -72.463928 40.603604 83.896114 +1121 -72.470793 40.591954 85.623453 +1122 -72.483401 40.593214 82.171130 +1123 -72.493277 40.599847 78.386017 +1124 -72.507523 40.593889 78.103655 +1125 -72.520874 40.595288 75.669252 +1126 -72.532334 40.588903 76.553350 +1127 -72.544263 40.595577 73.467738 +1128 -72.555598 40.602589 70.452583 +1129 -72.565883 40.609943 67.846717 +1130 -72.579272 40.605839 68.318845 +1131 -72.587594 40.616634 64.672485 +1132 -72.592537 40.627666 61.126365 +1133 -72.605611 40.629001 59.610413 +1134 -72.618318 40.631931 57.522942 +1135 -72.622141 40.643011 54.070440 +1136 -72.635661 40.643539 52.490657 +1137 -72.638754 40.654793 49.263973 +1138 -72.651410 40.655859 48.321214 +1139 -72.653587 40.667885 46.139274 +1140 -72.665660 40.670039 45.430075 +1141 -72.667567 40.682059 42.763044 +1142 -72.679809 40.684448 40.784516 +1143 -72.681262 40.696637 38.308453 +1144 -72.693320 40.700060 35.804323 +1145 -72.694480 40.711991 32.678375 +1146 -72.704852 40.716522 30.555489 +1147 -72.717283 40.715140 29.573124 +1148 -72.721860 40.728307 26.590432 +1149 -72.733512 40.731036 19.091780 +1150 -72.728263 40.741504 22.204067 +1151 -72.727786 40.752578 16.703341 +1152 -72.723564 40.761776 11.519136 +1153 -72.720919 40.772910 1.413452 +1154 -72.252659 40.868965 28.439191 +1155 -72.293678 40.903453 4.827833 +1156 -72.290657 40.891160 14.875017 +1157 -72.278644 40.883694 19.366959 +1158 -72.266304 40.876388 23.573609 +1159 -72.255313 40.856434 33.081911 +1160 -72.251749 40.843283 39.678434 +1161 -72.254463 40.830756 46.443800 +1162 -72.264677 40.825116 45.525162 +1163 -72.264188 40.814085 51.208680 +1164 -72.270514 40.804473 55.476259 +1165 -72.264942 40.792176 62.489427 +1166 -72.271379 40.780898 65.734993 +1167 -72.268069 40.767107 73.619029 +1168 -72.279114 40.758885 74.315143 +1169 -72.280384 40.747251 81.274070 +1170 -72.283860 40.735942 87.686821 +1171 -72.280341 40.725780 94.833720 +1172 -72.288775 40.717662 96.663711 +1173 -72.300992 40.715599 93.248555 +1174 -72.305522 40.702642 99.522147 +1175 -72.320014 40.698602 91.980059 +1176 -72.332134 40.689411 88.287411 +1177 -72.333588 40.675523 93.700813 +1178 -72.347755 40.671147 87.088304 +1179 -72.360177 40.663515 85.675826 +1180 -72.361655 40.650604 91.999895 +1181 -72.375235 40.645479 88.984421 +1182 -72.386933 40.637334 89.793657 +1183 -72.398273 40.632003 91.190611 +1184 -72.411654 40.633570 88.667489 +1185 -72.416027 40.621712 92.989433 +1186 -72.428844 40.617312 91.711051 +1187 -72.441813 40.619692 86.610017 +1188 -72.454885 40.615147 83.125393 +1189 -72.468971 40.617024 78.423443 +1190 -72.478623 40.605403 79.327157 +1191 -72.491910 40.612516 74.536008 +1192 -72.503297 40.606641 74.756484 +1193 -72.516342 40.607219 72.794848 +1194 -72.531069 40.601865 72.871706 +1195 -72.542625 40.608476 69.978690 +1196 -72.553394 40.616123 67.027654 +1197 -72.564115 40.622986 64.277959 +1198 -72.575052 40.617281 65.295633 +1199 -72.577319 40.629069 61.651185 +1200 -72.583993 40.638755 58.584708 +1201 -72.595832 40.640360 57.461994 +1202 -72.608722 40.641668 55.868487 +1203 -72.612617 40.652900 52.294191 +1204 -72.625771 40.653957 50.739837 +1205 -72.629046 40.665012 47.963731 +1206 -72.641391 40.666249 46.960493 +1207 -72.643812 40.677646 44.672165 +1208 -72.655652 40.679714 43.827843 +1209 -72.657330 40.691527 41.346951 +1210 -72.669325 40.693828 40.168393 +1211 -72.670854 40.705622 37.071084 +1212 -72.682704 40.708569 34.627780 +1213 -72.684106 40.720475 30.644716 +1214 -72.695720 40.724437 28.482318 +1215 -72.708469 40.728441 26.682482 +1216 -72.716492 40.738265 23.906247 +1217 -72.717009 40.750501 19.323809 +1218 -72.713595 40.763453 11.750588 +1219 -72.710257 40.775613 1.534001 +1220 -72.265531 40.863863 28.423661 +1221 -72.303671 40.899692 5.184524 +1222 -72.301014 40.887862 14.886303 +1223 -72.290098 40.877389 19.992962 +1224 -72.277171 40.870983 23.842641 +1225 -72.264829 40.850552 33.830396 +1226 -72.264528 40.838104 39.706165 +1227 -72.275299 40.831795 38.778533 +1228 -72.276325 40.818159 45.874038 +1229 -72.281474 40.806359 51.142441 +1230 -72.278580 40.793855 57.776201 +1231 -72.282657 40.782270 61.797554 +1232 -72.280471 40.771507 67.640409 +1233 -72.289913 40.764754 68.349299 +1234 -72.293149 40.752919 74.830627 +1235 -72.291881 40.741340 82.832448 +1236 -72.294845 40.728763 88.557980 +1237 -72.308001 40.726038 86.026421 +1238 -72.314411 40.712798 89.405273 +1239 -72.328279 40.712413 82.744109 +1240 -72.332930 40.700810 83.061759 +1241 -72.345325 40.696025 78.335050 +1242 -72.343314 40.683559 84.064695 +1243 -72.355923 40.685430 78.488513 +1244 -72.360881 40.674439 80.875262 +1245 -72.373702 40.670343 78.179637 +1246 -72.371436 40.658051 83.972257 +1247 -72.384122 40.659721 79.469227 +1248 -72.388454 40.648464 84.575301 +1249 -72.401139 40.644111 85.366958 +1250 -72.414052 40.645336 83.404171 +1251 -72.426600 40.640981 84.295523 +1252 -72.424317 40.629294 88.846057 +1253 -72.436953 40.630657 85.759938 +1254 -72.449561 40.626333 82.396729 +1255 -72.461700 40.628133 78.119986 +1256 -72.475855 40.631130 73.541310 +1257 -72.480885 40.618469 75.011330 +1258 -72.490645 40.625042 70.961401 +1259 -72.505081 40.619119 70.802640 +1260 -72.518174 40.619457 69.079762 +1261 -72.529530 40.613777 69.516257 +1262 -72.540827 40.620783 66.693603 +1263 -72.551256 40.629966 63.365021 +1264 -72.564083 40.633955 61.241485 +1265 -72.571163 40.643525 58.261977 +1266 -72.584660 40.651378 55.140927 +1267 -72.599040 40.652023 53.747856 +1268 -72.604170 40.662600 49.965934 +1269 -72.616576 40.663867 48.814325 +1270 -72.620028 40.674736 45.767984 +1271 -72.631917 40.676020 45.197636 +1272 -72.634495 40.686797 42.694507 +1273 -72.646161 40.688788 42.264302 +1274 -72.646945 40.700810 39.423801 +1275 -72.659490 40.702584 38.412320 +1276 -72.660766 40.714538 35.187119 +1277 -72.672974 40.716822 33.537628 +1278 -72.673920 40.728894 30.227304 +1279 -72.685881 40.731812 27.917567 +1280 -72.696785 40.736336 22.034125 +1281 -72.706723 40.742552 21.919749 +1282 -72.705717 40.755109 18.047562 +1283 -72.703905 40.766970 11.234113 +1284 -72.700160 40.778205 1.284975 +1285 -72.276100 40.857627 29.668199 +1286 -72.313041 40.896189 4.592803 +1287 -72.311257 40.886730 12.841394 +1288 -72.302259 40.877090 18.147848 +1289 -72.295682 40.864463 23.749483 +1290 -72.285637 40.864505 25.133839 +1291 -72.275583 40.845121 34.223104 +1292 -72.284448 40.839276 34.616089 +1293 -72.286648 40.827601 38.449312 +1294 -72.288930 40.815069 43.732480 +1295 -72.291748 40.800518 49.699908 +1296 -72.289914 40.788775 55.744698 +1297 -72.293303 40.776447 60.989613 +1298 -72.301744 40.764545 65.696411 +1299 -72.305118 40.752325 72.299514 +1300 -72.303626 40.740199 81.363442 +1301 -72.315184 40.735068 81.274839 +1302 -72.320682 40.724183 83.459062 +1303 -72.331517 40.724733 79.065642 +1304 -72.342046 40.719407 75.717778 +1305 -72.340608 40.707905 77.959738 +1306 -72.352402 40.708707 73.259605 +1307 -72.357573 40.697392 74.112537 +1308 -72.369735 40.692890 71.738959 +1309 -72.368727 40.681706 75.514871 +1310 -72.381124 40.683201 71.278765 +1311 -72.386371 40.671807 73.689120 +1312 -72.398551 40.666779 73.923786 +1313 -72.396862 40.655603 80.626105 +1314 -72.409782 40.656616 78.634350 +1315 -72.422621 40.652299 80.681637 +1316 -72.435980 40.653047 80.207089 +1317 -72.440030 40.642248 82.104930 +1318 -72.450960 40.636693 79.655792 +1319 -72.464018 40.641316 74.646802 +1320 -72.477202 40.645688 69.420536 +1321 -72.489283 40.636909 68.278807 +1322 -72.501129 40.630967 67.978506 +1323 -72.514484 40.631185 66.380874 +1324 -72.527884 40.625908 66.264297 +1325 -72.538247 40.631301 64.095535 +1326 -72.541448 40.641283 61.075438 +1327 -72.555309 40.642507 59.649159 +1328 -72.559513 40.652927 56.728104 +1329 -72.572125 40.655131 54.936952 +1330 -72.578531 40.665234 50.973369 +1331 -72.591112 40.662775 50.790015 +1332 -72.597534 40.671793 47.648604 +1333 -72.608148 40.673509 46.516808 +1334 -72.611395 40.683739 43.343571 +1335 -72.623246 40.685482 43.132329 +1336 -72.626355 40.697067 39.887842 +1337 -72.637481 40.696035 40.508385 +1338 -72.634356 40.705369 37.924009 +1339 -72.641338 40.712373 36.350281 +1340 -72.651380 40.709914 36.752604 +1341 -72.648616 40.719262 34.567010 +1342 -72.655499 40.725732 32.871464 +1343 -72.665011 40.723865 32.546371 +1344 -72.661964 40.733329 30.715393 +1345 -72.667913 40.740003 29.018629 +1346 -72.677652 40.738260 27.925395 +1347 -72.686200 40.743790 22.516744 +1348 -72.696827 40.748409 22.651268 +1349 -72.695343 40.760965 16.936417 +1350 -72.695697 40.771486 9.330280 +1351 -72.690711 40.781089 1.091949 +1352 -72.287670 40.851723 29.728695 +1353 -72.322021 40.893483 3.231382 +1354 -72.320938 40.886192 8.694853 +1355 -72.314035 40.879670 15.519034 +1356 -72.310687 40.873240 18.861586 +1357 -72.304814 40.868226 21.695461 +1358 -72.305876 40.860152 23.726649 +1359 -72.299029 40.851969 26.723721 +1360 -72.295026 40.839012 33.225746 +1361 -72.298098 40.824781 37.961998 +1362 -72.298808 40.811324 42.189378 +1363 -72.303476 40.800117 46.019768 +1364 -72.300842 40.788378 52.243098 +1365 -72.304414 40.776113 58.068746 +1366 -72.314623 40.769569 59.083635 +1367 -72.312520 40.758749 67.220471 +1368 -72.316213 40.746864 75.067776 +1369 -72.326844 40.736478 77.627182 +1370 -72.339003 40.732234 74.359270 +1371 -72.350667 40.730302 70.964770 +1372 -72.353214 40.719888 71.487405 +1373 -72.363319 40.716748 68.406232 +1374 -72.364791 40.705036 70.234481 +1375 -72.376129 40.703601 67.305220 +1376 -72.382899 40.695568 66.941322 +1377 -72.392490 40.689853 66.147430 +1378 -72.394912 40.679215 68.745549 +1379 -72.407257 40.676829 67.641200 +1380 -72.411963 40.667453 71.900563 +1381 -72.424248 40.663147 73.011773 +1382 -72.437103 40.664053 72.461727 +1383 -72.448947 40.659858 73.156374 +1384 -72.451143 40.648616 76.901892 +1385 -72.463492 40.655349 69.548657 +1386 -72.475648 40.657667 66.221094 +1387 -72.487125 40.655198 64.310258 +1388 -72.491594 40.646505 65.499533 +1389 -72.504363 40.641921 64.465995 +1390 -72.517962 40.642676 62.863648 +1391 -72.528072 40.637561 63.222576 +1392 -72.529603 40.650181 59.564573 +1393 -72.545074 40.652073 57.940653 +1394 -72.550780 40.662607 54.233118 +1395 -72.564426 40.662933 52.818455 +1396 -72.568601 40.671538 49.562439 +1397 -72.575157 40.678283 47.047905 +1398 -72.587097 40.675635 47.215270 +1399 -72.598825 40.682764 43.975975 +1400 -72.604597 40.692644 40.414564 +1401 -72.615507 40.693417 40.120050 +1402 -72.616770 40.703034 38.135111 +1403 -72.623937 40.709153 37.087468 +1404 -72.631284 40.715806 35.876554 +1405 -72.637648 40.723258 34.040464 +1406 -72.645858 40.728747 32.579554 +1407 -72.651979 40.735739 30.930194 +1408 -72.657170 40.743679 28.784104 +1409 -72.664632 40.749698 25.605300 +1410 -72.674513 40.747295 25.056876 +1411 -72.680001 40.754289 21.226513 +1412 -72.688768 40.753828 18.969904 +1413 -72.685133 40.762767 17.155203 +1414 -72.688020 40.771854 10.990239 +1415 -72.681586 40.783169 1.166952 +1416 -72.330327 40.890608 4.143381 +1417 -72.329012 40.885195 7.153149 +1418 -72.323215 40.880048 13.626178 +1419 -72.319445 40.873144 17.709255 +1420 -72.313003 40.866580 21.319680 +1421 -72.316389 40.859984 22.117099 +1422 -72.310461 40.852876 23.842045 +1423 -72.305647 40.844398 28.680346 +1424 -72.305070 40.834376 34.263771 +1425 -72.309953 40.826416 35.640794 +1426 -72.307367 40.817751 38.707508 +1427 -72.307886 40.808738 41.731251 +1428 -72.314139 40.802541 43.097581 +1429 -72.312141 40.793051 47.204230 +1430 -72.311935 40.782332 52.520902 +1431 -72.320813 40.778230 52.485459 +1432 -72.327396 40.770753 56.166035 +1433 -72.323160 40.759194 64.802762 +1434 -72.326929 40.747868 72.464029 +1435 -72.337372 40.744278 71.557214 +1436 -72.346255 40.739371 69.782583 +1437 -72.355635 40.741405 66.844211 +1438 -72.362481 40.735246 66.265673 +1439 -72.359893 40.726230 68.331572 +1440 -72.368970 40.728060 65.112850 +1441 -72.374418 40.721034 64.042396 +1442 -72.371832 40.712118 66.789072 +1443 -72.380902 40.713835 63.627154 +1444 -72.386907 40.706685 63.312203 +1445 -72.393944 40.700725 62.738785 +1446 -72.401618 40.695840 62.332753 +1447 -72.404190 40.687064 64.128852 +1448 -72.415585 40.685414 62.902081 +1449 -72.420093 40.675063 66.585002 +1450 -72.432212 40.673633 66.100337 +1451 -72.444763 40.671500 66.109248 +1452 -72.457594 40.668117 66.440311 +1453 -72.470217 40.668064 63.662040 +1454 -72.483153 40.664981 62.261599 +1455 -72.495316 40.663293 60.854141 +1456 -72.500492 40.653349 62.385366 +1457 -72.513941 40.651988 60.785928 +1458 -72.521521 40.661081 57.595252 +1459 -72.535972 40.661250 56.211191 +1460 -72.542364 40.669728 52.611618 +1461 -72.549523 40.674068 50.147843 +1462 -72.558481 40.671614 50.043044 +1463 -72.564073 40.680055 47.005591 +1464 -72.567417 40.687202 44.676761 +1465 -72.573624 40.690082 43.579652 +1466 -72.581077 40.685258 44.457701 +1467 -72.588829 40.687866 42.805163 +1468 -72.595433 40.694679 40.234577 +1469 -72.599875 40.703882 38.470503 +1470 -72.608585 40.700360 38.620476 +1471 -72.607731 40.708704 37.283026 +1472 -72.614316 40.711316 36.832175 +1473 -72.616252 40.716999 36.019298 +1474 -72.622345 40.719625 35.372698 +1475 -72.627676 40.725462 33.994012 +1476 -72.630325 40.732882 32.583987 +1477 -72.637959 40.732306 32.278018 +1478 -72.642921 40.737709 31.058095 +1479 -72.647156 40.744630 29.362607 +1480 -72.649181 40.752151 25.275452 +1481 -72.656384 40.753002 24.501893 +1482 -72.660400 40.758867 21.967836 +1483 -72.670117 40.756970 21.873006 +1484 -72.676558 40.763581 18.167383 +1485 -72.680278 40.771948 12.631216 +1486 -72.675420 40.778662 9.216964 +1487 -72.673180 40.785991 1.028595 +1488 -72.338068 40.887790 3.581603 +1489 -72.332214 40.880941 10.154838 +1490 -72.327665 40.875695 15.303743 +1491 -72.327901 40.869786 17.968950 +1492 -72.320978 40.866286 19.875319 +1493 -72.327099 40.861997 20.465411 +1494 -72.321468 40.854395 22.741716 +1495 -72.316884 40.847319 23.342446 +1496 -72.312809 40.840289 29.229797 +1497 -72.315596 40.833910 32.138970 +1498 -72.320181 40.827732 32.660169 +1499 -72.317383 40.820137 36.131991 +1500 -72.316093 40.812164 38.998799 +1501 -72.322161 40.806892 40.399667 +1502 -72.323205 40.798004 43.483209 +1503 -72.321100 40.787988 47.659069 +1504 -72.329122 40.782321 48.749527 +1505 -72.335573 40.778176 49.778786 +1506 -72.338942 40.771331 53.613083 +1507 -72.334494 40.762885 60.392559 +1508 -72.332983 40.754042 66.689197 +1509 -72.342238 40.755375 64.352105 +1510 -72.348591 40.748701 66.663968 +1511 -72.358132 40.751102 62.626046 +1512 -72.365780 40.744971 62.776607 +1513 -72.373408 40.738165 61.785202 +1514 -72.378767 40.730450 60.748479 +1515 -72.383925 40.723257 60.839845 +1516 -72.390315 40.716608 60.346649 +1517 -72.397380 40.711090 59.546835 +1518 -72.404421 40.704783 59.513374 +1519 -72.411985 40.696373 60.119914 +1520 -72.422637 40.693233 59.545889 +1521 -72.427514 40.683773 61.821420 +1522 -72.439771 40.683020 60.145249 +1523 -72.451690 40.678815 61.081109 +1524 -72.463424 40.678469 60.229767 +1525 -72.474587 40.680337 58.739349 +1526 -72.480410 40.673493 59.944426 +1527 -72.490595 40.672647 58.759133 +1528 -72.501668 40.672168 57.553666 +1529 -72.507615 40.661629 59.138458 +1530 -72.512092 40.669135 56.698603 +1531 -72.519407 40.672781 55.087802 +1532 -72.527579 40.669096 55.080593 +1533 -72.534436 40.673317 52.379961 +1534 -72.540984 40.679992 49.230494 +1535 -72.548027 40.682691 47.496554 +1536 -72.555414 40.681495 46.982013 +1537 -72.559055 40.690236 44.375454 +1538 -72.565252 40.697216 42.196574 +1539 -72.572234 40.698638 41.329708 +1540 -72.580267 40.695620 41.496216 +1541 -72.587262 40.698009 40.263505 +1542 -72.591105 40.704894 38.904193 +1543 -72.593953 40.713981 37.534800 +1544 -72.601385 40.713562 37.101460 +1545 -72.607583 40.718874 36.232686 +1546 -72.613123 40.724745 35.272896 +1547 -72.619461 40.727662 34.455030 +1548 -72.621900 40.734231 33.256209 +1549 -72.625123 40.742117 31.625538 +1550 -72.633943 40.739839 31.292702 +1551 -72.639162 40.744877 30.156790 +1552 -72.639890 40.752619 27.294524 +1553 -72.643862 40.759000 23.613050 +1554 -72.651355 40.761121 21.474915 +1555 -72.656611 40.768124 17.711674 +1556 -72.663782 40.764590 17.761309 +1557 -72.669434 40.765943 17.933996 +1558 -72.672313 40.772150 13.944221 +1559 -72.668284 40.779924 9.815395 +1560 -72.665038 40.788100 1.151116 +1561 -72.339007 40.881428 7.590165 +1562 -72.345271 40.885010 4.196290 +1563 -72.335470 40.874969 14.339505 +1564 -72.335179 40.867646 17.762554 +1565 -72.336793 40.861171 19.904993 +1566 -72.330442 40.855895 22.269516 +1567 -72.328021 40.848627 24.295330 +1568 -72.321725 40.841299 26.503297 +1569 -72.324946 40.834633 29.003768 +1570 -72.329312 40.828459 30.998366 +1571 -72.325920 40.822436 34.029768 +1572 -72.326371 40.815042 36.609068 +1573 -72.330203 40.807009 38.951530 +1574 -72.333626 40.800121 40.505103 +1575 -72.330427 40.791555 44.408852 +1576 -72.339009 40.786927 45.008928 +1577 -72.344180 40.779970 47.416458 +1578 -72.348529 40.773350 50.839050 +1579 -72.344820 40.764576 57.143811 +1580 -72.352810 40.758878 59.547220 +1581 -72.362570 40.760139 56.785922 +1582 -72.365737 40.753631 58.905879 +1583 -72.372666 40.753572 56.896551 +1584 -72.374517 40.746929 59.145899 +1585 -72.381550 40.745859 56.599950 +1586 -72.384083 40.738566 57.557811 +1587 -72.388458 40.732098 57.824247 +1588 -72.392113 40.725102 58.246667 +1589 -72.399438 40.721471 57.199557 +1590 -72.407371 40.715259 56.735872 +1591 -72.413160 40.707462 57.323838 +1592 -72.420706 40.702589 56.854157 +1593 -72.428724 40.700650 55.303149 +1594 -72.433107 40.692799 57.074620 +1595 -72.441552 40.695020 54.476914 +1596 -72.448566 40.688922 56.522021 +1597 -72.456573 40.686344 56.981731 +1598 -72.462851 40.690282 54.760559 +1599 -72.469193 40.687133 55.854449 +1600 -72.475782 40.691668 53.586346 +1601 -72.481900 40.688562 54.635862 +1602 -72.485497 40.681388 56.709297 +1603 -72.494596 40.681448 55.691523 +1604 -72.502391 40.681865 54.736805 +1605 -72.510376 40.678693 54.681378 +1606 -72.518282 40.681472 52.402022 +1607 -72.526200 40.679489 51.665327 +1608 -72.533460 40.682647 49.345469 +1609 -72.536889 40.690698 46.400425 +1610 -72.543589 40.688611 46.271035 +1611 -72.550524 40.690055 45.201734 +1612 -72.551745 40.697452 43.249058 +1613 -72.558091 40.699547 42.223827 +1614 -72.560242 40.707634 40.993155 +1615 -72.567777 40.706432 40.681732 +1616 -72.575119 40.704430 40.373062 +1617 -72.581656 40.706382 39.447663 +1618 -72.586551 40.712249 38.438204 +1619 -72.586277 40.720031 38.185193 +1620 -72.592189 40.723151 37.520823 +1621 -72.599388 40.722097 36.685369 +1622 -72.604889 40.729429 35.487813 +1623 -72.612918 40.733279 34.466865 +1624 -72.616009 40.740755 33.429164 +1625 -72.618036 40.748556 31.398786 +1626 -72.625061 40.750901 29.612099 +1627 -72.632111 40.747795 29.839585 +1628 -72.631826 40.755457 27.512253 +1629 -72.636334 40.762285 23.723479 +1630 -72.643017 40.766619 20.664664 +1631 -72.649014 40.769363 18.724373 +1632 -72.651081 40.775918 14.979965 +1633 -72.657378 40.776328 13.965270 +1634 -72.664017 40.772949 14.830282 +1635 -72.661147 40.781976 9.772654 +1636 -72.657367 40.790268 1.045232 +1637 -72.344354 40.878462 7.910619 +1638 -72.341872 40.872534 14.570553 +1639 -72.352061 40.882510 6.014535 +1640 -72.343660 40.867160 16.891132 +1641 -72.345193 40.860538 18.910254 +1642 -72.338317 40.853692 22.061780 +1643 -72.337016 40.846138 24.364799 +1644 -72.330223 40.841247 26.238288 +1645 -72.333289 40.834776 28.062303 +1646 -72.336815 40.829245 30.223762 +1647 -72.334945 40.822023 33.369763 +1648 -72.336179 40.814507 35.873983 +1649 -72.339198 40.807494 37.194098 +1650 -72.343170 40.801498 38.466022 +1651 -72.338552 40.794816 41.846904 +1652 -72.346269 40.794525 40.856443 +1653 -72.349002 40.787709 42.882159 +1654 -72.353165 40.781099 45.659028 +1655 -72.357864 40.774730 49.111584 +1656 -72.353143 40.767605 53.627445 +1657 -72.361134 40.767533 52.438195 +1658 -72.370430 40.767728 51.249486 +1659 -72.370185 40.760029 54.951193 +1660 -72.377783 40.762072 51.735409 +1661 -72.380167 40.753796 54.757265 +1662 -72.388210 40.753199 52.712208 +1663 -72.389065 40.745565 54.479161 +1664 -72.394634 40.740407 54.184192 +1665 -72.397104 40.731744 55.710220 +1666 -72.404165 40.730461 55.056838 +1667 -72.407228 40.723709 55.264603 +1668 -72.415104 40.724168 53.857087 +1669 -72.416797 40.716624 54.853993 +1670 -72.420859 40.710528 55.397589 +1671 -72.428817 40.709703 53.469138 +1672 -72.436924 40.704156 51.831414 +1673 -72.445388 40.705289 50.021978 +1674 -72.448699 40.697848 52.681515 +1675 -72.455834 40.696132 52.784856 +1676 -72.462423 40.698962 51.227497 +1677 -72.469302 40.696787 51.767725 +1678 -72.476138 40.700202 50.159552 +1679 -72.483060 40.698194 50.653913 +1680 -72.490243 40.691105 53.035213 +1681 -72.498707 40.690156 52.369053 +1682 -72.506609 40.688180 52.113887 +1683 -72.513973 40.687951 51.132357 +1684 -72.521480 40.688939 49.434726 +1685 -72.528574 40.689159 48.101928 +1686 -72.531026 40.695932 45.888341 +1687 -72.536071 40.700693 44.041321 +1688 -72.543318 40.697257 44.092483 +1689 -72.546659 40.703787 42.270050 +1690 -72.552981 40.705343 41.452283 +1691 -72.553332 40.712099 40.554019 +1692 -72.556673 40.717379 39.888442 +1693 -72.564276 40.715056 40.225019 +1694 -72.572764 40.713145 39.796820 +1695 -72.579858 40.716008 38.989563 +1696 -72.579502 40.724604 37.940539 +1697 -72.586173 40.728669 37.447196 +1698 -72.595306 40.730394 36.747760 +1699 -72.599973 40.736703 35.581148 +1700 -72.606724 40.739910 34.234398 +1701 -72.611177 40.746709 32.816706 +1702 -72.611365 40.754766 30.655468 +1703 -72.618968 40.756262 29.010283 +1704 -72.625070 40.757800 27.451307 +1705 -72.629006 40.761961 24.529121 +1706 -72.629425 40.768196 21.037446 +1707 -72.636227 40.771497 18.911640 +1708 -72.643121 40.775389 16.298204 +1709 -72.647736 40.782765 11.480356 +1710 -72.654008 40.783670 9.876334 +1711 -72.650042 40.792113 1.039908 +1712 -72.350146 40.874543 10.214628 +1713 -72.358459 40.880262 3.815826 +1714 -72.351319 40.867178 16.057646 +1715 -72.353698 40.860531 17.825752 +1716 -72.347727 40.854371 19.894865 +1717 -72.344134 40.848657 22.218869 +1718 -72.345145 40.841626 24.920357 +1719 -72.337743 40.839867 25.992909 +1720 -72.341598 40.834571 27.920047 +1721 -72.343804 40.827443 30.527660 +1722 -72.344439 40.820489 33.068531 +1723 -72.344410 40.813802 35.392240 +1724 -72.348309 40.808586 35.957746 +1725 -72.351702 40.801882 37.352901 +1726 -72.354735 40.795209 39.061342 +1727 -72.357728 40.788574 41.690744 +1728 -72.361570 40.781989 44.784428 +1729 -72.367242 40.775748 47.942410 +1730 -72.376107 40.775721 46.375004 +1731 -72.378991 40.769697 48.153467 +1732 -72.386229 40.767834 47.213732 +1733 -72.384772 40.759966 50.751739 +1734 -72.391347 40.761676 48.801441 +1735 -72.395306 40.756867 49.657193 +1736 -72.395700 40.749556 51.636540 +1737 -72.403154 40.747217 50.861696 +1738 -72.403125 40.738794 53.505652 +1739 -72.410390 40.736449 53.395110 +1740 -72.410629 40.729593 54.068553 +1741 -72.415829 40.732577 52.842183 +1742 -72.422071 40.731565 51.813243 +1743 -72.423595 40.723951 52.583781 +1744 -72.424639 40.716671 53.635288 +1745 -72.431250 40.720721 51.751361 +1746 -72.435705 40.713301 51.027308 +1747 -72.443509 40.713947 48.572427 +1748 -72.452064 40.713331 47.037590 +1749 -72.452496 40.704440 49.854699 +1750 -72.459076 40.706967 48.527731 +1751 -72.465877 40.704826 48.913309 +1752 -72.471890 40.705953 48.227682 +1753 -72.479617 40.707802 47.244010 +1754 -72.486633 40.707714 47.006084 +1755 -72.489871 40.700237 49.584869 +1756 -72.496997 40.699418 49.594885 +1757 -72.504232 40.696812 49.635971 +1758 -72.510500 40.694613 49.478883 +1759 -72.516829 40.696649 48.000419 +1760 -72.523792 40.697744 46.561881 +1761 -72.529545 40.702178 44.606453 +1762 -72.531659 40.709037 42.662615 +1763 -72.539903 40.707725 42.063654 +1764 -72.546955 40.710892 41.040531 +1765 -72.549111 40.718327 39.868014 +1766 -72.551774 40.725727 38.349810 +1767 -72.560147 40.723522 38.736398 +1768 -72.567577 40.722222 38.891675 +1769 -72.574050 40.721287 38.706359 +1770 -72.571689 40.729646 37.356687 +1771 -72.578544 40.731449 36.739197 +1772 -72.581868 40.736509 35.364642 +1773 -72.588625 40.735027 35.819568 +1774 -72.593433 40.738959 35.753743 +1775 -72.598418 40.744937 33.919678 +1776 -72.604836 40.749143 32.317302 +1777 -72.604267 40.756876 29.186634 +1778 -72.608400 40.763472 25.106009 +1779 -72.614944 40.761686 27.281071 +1780 -72.621833 40.764297 24.147019 +1781 -72.622778 40.771637 19.891350 +1782 -72.629396 40.775721 17.799969 +1783 -72.635495 40.780373 14.602321 +1784 -72.641615 40.782511 12.577516 +1785 -72.644462 40.788007 8.302755 +1786 -72.643058 40.793698 1.566779 +1787 -72.357315 40.873330 7.264110 +1788 -72.364447 40.878134 3.177915 +1789 -72.358722 40.867183 14.141085 +1790 -72.361068 40.862603 15.610800 +1791 -72.360514 40.856814 17.936012 +1792 -72.354597 40.853895 19.264120 +1793 -72.351769 40.847442 21.542965 +1794 -72.352350 40.840287 24.123373 +1795 -72.349150 40.833837 27.268599 +1796 -72.352756 40.826139 29.517602 +1797 -72.352732 40.817035 34.201157 +1798 -72.356289 40.808974 35.155614 +1799 -72.360333 40.802327 36.244803 +1800 -72.362924 40.795876 37.876273 +1801 -72.365428 40.789308 40.711039 +1802 -72.368513 40.783745 43.429409 +1803 -72.374804 40.782795 43.279856 +1804 -72.382170 40.782636 42.125584 +1805 -72.384617 40.775603 44.296535 +1806 -72.392852 40.775181 42.602426 +1807 -72.393607 40.768007 45.590665 +1808 -72.399497 40.763713 46.313734 +1809 -72.401604 40.755723 48.574489 +1810 -72.408188 40.755064 47.578601 +1811 -72.411218 40.749948 48.763389 +1812 -72.410849 40.743505 51.202789 +1813 -72.418285 40.739718 51.471633 +1814 -72.426496 40.738196 50.113152 +1815 -72.430457 40.730517 50.408152 +1816 -72.437768 40.727483 48.921227 +1817 -72.438291 40.719876 49.654630 +1818 -72.443417 40.723284 47.827383 +1819 -72.449537 40.722297 46.637336 +1820 -72.456842 40.722348 45.284620 +1821 -72.459708 40.715522 45.634989 +1822 -72.466408 40.713133 46.073432 +1823 -72.473275 40.712735 45.894384 +1824 -72.477877 40.715484 45.013252 +1825 -72.484622 40.716079 44.437256 +1826 -72.492105 40.715266 44.280060 +1827 -72.492862 40.706710 47.114992 +1828 -72.498320 40.708983 46.124098 +1829 -72.504223 40.705050 47.044239 +1830 -72.510960 40.702163 47.113991 +1831 -72.518057 40.705989 44.900830 +1832 -72.524962 40.705790 44.263374 +1833 -72.523608 40.712511 42.294814 +1834 -72.528815 40.716591 40.866093 +1835 -72.535235 40.715694 40.901872 +1836 -72.542132 40.716272 40.541260 +1837 -72.544092 40.723992 39.161895 +1838 -72.544727 40.731272 37.534548 +1839 -72.551244 40.734623 36.250637 +1840 -72.557047 40.730550 37.353911 +1841 -72.563930 40.730461 37.327314 +1842 -72.567066 40.737643 35.388006 +1843 -72.574330 40.737748 35.251550 +1844 -72.578857 40.743692 33.204900 +1845 -72.586021 40.741588 34.235750 +1846 -72.590921 40.745236 33.271554 +1847 -72.591435 40.751296 30.790369 +1848 -72.598205 40.752836 30.828240 +1849 -72.598058 40.759265 27.358636 +1850 -72.601697 40.763127 25.290291 +1851 -72.601959 40.769124 22.926839 +1852 -72.608048 40.770777 22.929607 +1853 -72.615010 40.768870 23.631912 +1854 -72.617527 40.775295 20.023550 +1855 -72.622905 40.778900 17.649662 +1856 -72.628383 40.783349 14.247745 +1857 -72.632645 40.788990 9.986086 +1858 -72.638515 40.788161 9.474345 +1859 -72.636471 40.795327 1.581545 +1860 -72.363629 40.872247 7.885494 +1861 -72.370019 40.876028 3.456976 +1862 -72.366975 40.867355 10.650901 +1863 -72.366103 40.860502 15.790664 +1864 -72.367411 40.854133 17.473234 +1865 -72.359893 40.850248 19.876139 +1866 -72.358354 40.843398 22.338866 +1867 -72.357320 40.835037 25.250528 +1868 -72.360617 40.829245 26.903570 +1869 -72.361115 40.822053 30.650713 +1870 -72.360349 40.814795 33.531864 +1871 -72.364757 40.808793 34.312675 +1872 -72.369845 40.802419 35.036704 +1873 -72.369832 40.795315 37.574316 +1874 -72.373055 40.789917 39.844755 +1875 -72.380167 40.790211 38.779680 +1876 -72.387147 40.789384 38.219994 +1877 -72.389676 40.782026 40.728471 +1878 -72.397569 40.782609 38.834316 +1879 -72.401370 40.776944 40.210454 +1880 -72.398998 40.770942 43.149108 +1881 -72.406040 40.770070 41.917559 +1882 -72.406505 40.762361 45.090410 +1883 -72.412566 40.760535 44.333813 +1884 -72.415976 40.755458 46.422688 +1885 -72.418275 40.748473 48.909224 +1886 -72.423926 40.744292 49.618412 +1887 -72.431216 40.745877 47.735277 +1888 -72.433144 40.738793 48.393345 +1889 -72.438692 40.735325 47.506729 +1890 -72.445973 40.731305 46.304324 +1891 -72.454090 40.730179 44.770419 +1892 -72.461818 40.729625 43.317175 +1893 -72.464614 40.722023 43.951811 +1894 -72.471790 40.720580 43.808378 +1895 -72.478682 40.720885 43.558586 +1896 -72.483041 40.723810 42.520510 +1897 -72.489555 40.723854 42.016405 +1898 -72.497207 40.723208 41.669825 +1899 -72.498654 40.715985 43.820373 +1900 -72.504648 40.712892 44.276010 +1901 -72.511071 40.710303 44.376432 +1902 -72.516903 40.715671 42.001444 +1903 -72.522991 40.720611 40.272813 +1904 -72.530693 40.723902 39.567800 +1905 -72.537730 40.721893 39.766808 +1906 -72.537432 40.728515 38.666987 +1907 -72.537971 40.735549 36.668377 +1908 -72.544823 40.738987 35.364818 +1909 -72.550869 40.742586 34.296719 +1910 -72.558652 40.737849 35.143684 +1911 -72.563283 40.744346 33.640075 +1912 -72.571046 40.745616 33.017361 +1913 -72.577917 40.751027 30.097203 +1914 -72.584611 40.748671 30.859971 +1915 -72.584667 40.756449 28.119677 +1916 -72.592259 40.758001 27.930056 +1917 -72.595077 40.765462 24.435299 +1918 -72.596035 40.772836 21.764864 +1919 -72.603555 40.776716 20.059344 +1920 -72.611276 40.776101 20.251936 +1921 -72.616172 40.781445 17.299889 +1922 -72.621772 40.785568 13.862757 +1923 -72.626718 40.790947 9.606671 +1924 -72.630313 40.797183 1.451250 +1925 -72.373463 40.869215 6.800537 +1926 -72.375383 40.874490 4.456895 +1927 -72.372392 40.861523 15.147401 +1928 -72.374897 40.854304 16.885015 +1929 -72.371675 40.848698 19.243484 +1930 -72.365475 40.846622 20.595164 +1931 -72.363705 40.840286 23.281189 +1932 -72.365991 40.834968 24.773443 +1933 -72.367387 40.828488 26.473144 +1934 -72.369850 40.822365 28.877502 +1935 -72.367287 40.815922 32.331865 +1936 -72.372712 40.809899 32.872352 +1937 -72.379393 40.804685 32.820123 +1938 -72.376870 40.797241 36.063459 +1939 -72.385376 40.797590 34.933243 +1940 -72.392908 40.794417 35.432651 +1941 -72.393782 40.787874 37.648442 +1942 -72.400666 40.790357 35.415921 +1943 -72.405565 40.783963 36.802883 +1944 -72.407979 40.777082 38.907552 +1945 -72.413885 40.773674 38.991862 +1946 -72.412967 40.766881 41.620825 +1947 -72.418949 40.762439 43.348244 +1948 -72.423455 40.756485 45.540375 +1949 -72.425243 40.749904 48.125867 +1950 -72.430008 40.753003 46.123533 +1951 -72.436977 40.752499 44.561366 +1952 -72.438539 40.744218 46.229984 +1953 -72.444778 40.740300 45.340836 +1954 -72.451924 40.737808 44.141233 +1955 -72.459253 40.737372 42.792046 +1956 -72.466133 40.736599 41.695262 +1957 -72.469786 40.729103 42.436196 +1958 -72.476778 40.727217 42.010114 +1959 -72.483272 40.730383 40.973503 +1960 -72.488939 40.731607 40.365715 +1961 -72.495090 40.730183 40.244929 +1962 -72.502658 40.730847 39.483402 +1963 -72.504234 40.724130 40.788120 +1964 -72.503127 40.719127 42.430438 +1965 -72.510052 40.718896 41.759069 +1966 -72.516067 40.724877 39.659490 +1967 -72.523696 40.727876 38.715993 +1968 -72.530690 40.732428 37.788174 +1969 -72.532188 40.740818 35.578137 +1970 -72.539070 40.742094 34.965116 +1971 -72.544005 40.747436 33.757347 +1972 -72.551595 40.751044 33.095955 +1973 -72.556478 40.745026 33.648052 +1974 -72.558784 40.750237 32.859568 +1975 -72.564947 40.751590 32.050530 +1976 -72.571508 40.753702 29.721125 +1977 -72.577737 40.758260 27.311180 +1978 -72.582121 40.765064 25.591323 +1979 -72.588399 40.762913 26.105338 +1980 -72.588923 40.769507 23.515600 +1981 -72.589632 40.776387 21.750262 +1982 -72.596769 40.779601 19.852072 +1983 -72.602633 40.784333 17.268902 +1984 -72.609309 40.782697 17.205015 +1985 -72.615101 40.788250 13.216209 +1986 -72.621437 40.791615 10.074316 +1987 -72.624454 40.798857 1.635425 +1988 -72.380319 40.872759 2.074183 +1989 -72.378653 40.866252 8.174680 +1990 -72.379079 40.859774 13.474913 +1991 -72.381432 40.853462 15.826128 +1992 -72.378457 40.847088 18.920731 +1993 -72.371204 40.841682 22.108605 +1994 -72.373817 40.834460 24.672804 +1995 -72.373776 40.827956 26.024430 +1996 -72.377592 40.823560 26.204656 +1997 -72.374474 40.817108 29.429262 +1998 -72.379835 40.812605 31.063496 +1999 -72.386081 40.810460 30.277622 +2000 -72.387528 40.804636 32.115836 +2001 -72.393960 40.802116 32.566745 +2002 -72.398749 40.797027 33.691866 +2003 -72.405344 40.797140 32.779775 +2004 -72.408446 40.791583 33.826037 +2005 -72.412189 40.786556 34.937030 +2006 -72.413456 40.780540 36.847960 +2007 -72.421131 40.777717 37.628241 +2008 -72.420056 40.769711 40.455760 +2009 -72.425940 40.764374 42.409206 +2010 -72.431123 40.759217 43.533590 +2011 -72.437361 40.760285 42.232638 +2012 -72.443255 40.757461 42.471797 +2013 -72.444665 40.749635 44.154213 +2014 -72.450001 40.744428 43.703697 +2015 -72.457139 40.744978 42.494890 +2016 -72.464784 40.744231 41.576905 +2017 -72.472180 40.742631 40.296187 +2018 -72.471477 40.735919 41.200232 +2019 -72.477236 40.734992 40.711740 +2020 -72.485204 40.738061 39.464345 +2021 -72.491922 40.736550 39.241751 +2022 -72.498113 40.737009 38.664442 +2023 -72.505607 40.738720 37.732861 +2024 -72.510633 40.732551 38.474017 +2025 -72.509092 40.726412 39.883751 +2026 -72.517550 40.732888 37.973352 +2027 -72.523681 40.734167 37.489223 +2028 -72.526517 40.738594 36.382259 +2029 -72.524579 40.744849 35.058575 +2030 -72.529557 40.747450 34.118045 +2031 -72.536021 40.747325 33.877636 +2032 -72.537781 40.753657 32.712467 +2033 -72.544793 40.754933 32.602680 +2034 -72.551237 40.758817 30.950965 +2035 -72.558260 40.757186 31.112939 +2036 -72.565840 40.758585 29.518358 +2037 -72.571652 40.760111 27.500993 +2038 -72.575432 40.764191 26.062841 +2039 -72.576047 40.770091 21.055044 +2040 -72.582852 40.773297 18.467768 +2041 -72.583777 40.781514 19.986225 +2042 -72.590835 40.782312 19.346519 +2043 -72.596115 40.786192 17.355986 +2044 -72.601511 40.791609 13.624210 +2045 -72.608194 40.789569 13.400023 +2046 -72.613400 40.794978 8.950692 +2047 -72.618569 40.794766 8.299458 +2048 -72.618863 40.800316 1.961758 +2049 -72.384819 40.870815 3.370408 +2050 -72.384106 40.864564 8.199200 +2051 -72.385122 40.858823 12.456116 +2052 -72.387288 40.853916 15.272871 +2053 -72.386304 40.848564 16.814037 +2054 -72.385261 40.842555 18.188778 +2055 -72.378048 40.840528 20.013232 +2056 -72.381696 40.835899 21.819127 +2057 -72.380147 40.829736 24.719482 +2058 -72.385643 40.824557 25.178938 +2059 -72.380864 40.819121 27.768323 +2060 -72.386215 40.817375 28.422805 +2061 -72.391617 40.815082 28.058496 +2062 -72.393606 40.809520 29.803569 +2063 -72.400816 40.808739 29.757271 +2064 -72.401181 40.802207 31.937036 +2065 -72.407351 40.803967 31.059445 +2066 -72.413025 40.798722 31.634833 +2067 -72.415526 40.791851 33.089107 +2068 -72.418655 40.784912 34.695397 +2069 -72.426065 40.785025 33.687192 +2070 -72.428652 40.778328 36.701635 +2071 -72.426832 40.771594 39.708391 +2072 -72.433768 40.766721 41.007107 +2073 -72.441616 40.765516 40.816389 +2074 -72.447471 40.762899 41.322574 +2075 -72.450755 40.756693 42.169877 +2076 -72.451650 40.749891 42.889524 +2077 -72.456475 40.752577 41.995586 +2078 -72.462526 40.751266 41.427680 +2079 -72.470399 40.751178 40.030620 +2080 -72.477310 40.748313 38.760581 +2081 -72.479268 40.741844 39.376718 +2082 -72.484899 40.745498 38.109768 +2083 -72.492191 40.743467 37.833860 +2084 -72.499193 40.743013 37.419426 +2085 -72.503660 40.745902 36.472006 +2086 -72.509804 40.745579 36.080358 +2087 -72.513376 40.739630 36.898539 +2088 -72.520030 40.739921 36.407314 +2089 -72.517438 40.747207 35.123971 +2090 -72.524114 40.752682 33.329115 +2091 -72.531407 40.752434 33.044841 +2092 -72.530397 40.758890 31.675460 +2093 -72.538564 40.760281 31.406491 +2094 -72.544885 40.761184 30.869885 +2095 -72.548916 40.764969 28.836729 +2096 -72.555751 40.765686 28.102606 +2097 -72.562100 40.763546 28.861086 +2098 -72.568843 40.766134 27.348809 +2099 -72.569701 40.773304 23.880161 +2100 -72.576881 40.777000 18.635189 +2101 -72.577226 40.783799 20.006820 +2102 -72.582163 40.789959 16.781134 +2103 -72.588758 40.787847 17.274780 +2104 -72.594314 40.791398 14.992468 +2105 -72.596495 40.796350 11.905679 +2106 -72.603051 40.798479 9.254289 +2107 -72.607966 40.796425 9.013462 +2108 -72.613619 40.801891 1.851086 +2109 -72.389034 40.868985 3.829857 +2110 -72.389453 40.863093 8.106637 +2111 -72.391045 40.857647 13.154148 +2112 -72.392674 40.851640 15.645849 +2113 -72.393560 40.845540 17.416355 +2114 -72.392087 40.840049 18.864561 +2115 -72.387773 40.836870 20.253524 +2116 -72.387021 40.831228 23.521936 +2117 -72.393082 40.827932 24.231194 +2118 -72.392564 40.821338 25.771766 +2119 -72.398471 40.816643 26.577714 +2120 -72.404855 40.815129 27.042622 +2121 -72.408496 40.810586 28.637363 +2122 -72.413956 40.806092 29.724931 +2123 -72.420113 40.803396 29.955590 +2124 -72.420399 40.796677 31.405346 +2125 -72.421549 40.790255 32.812675 +2126 -72.426637 40.793102 31.426350 +2127 -72.432387 40.789637 31.637700 +2128 -72.433411 40.783285 33.938274 +2129 -72.435365 40.777659 36.733285 +2130 -72.433070 40.773086 38.935990 +2131 -72.440384 40.772681 38.694856 +2132 -72.448155 40.770116 39.538272 +2133 -72.453553 40.764200 40.492171 +2134 -72.458986 40.758915 40.976299 +2135 -72.465792 40.757025 40.351352 +2136 -72.471540 40.759965 39.185651 +2137 -72.477430 40.756080 37.884965 +2138 -72.482767 40.751239 37.467604 +2139 -72.490011 40.750995 36.528995 +2140 -72.497728 40.749921 36.081310 +2141 -72.505239 40.751927 35.095495 +2142 -72.511692 40.751790 34.607992 +2143 -72.516855 40.755197 33.492820 +2144 -72.522247 40.760262 32.122019 +2145 -72.526288 40.765901 30.983034 +2146 -72.534186 40.765566 30.480349 +2147 -72.542102 40.767345 27.477545 +2148 -72.549754 40.770869 25.475493 +2149 -72.556697 40.773944 25.463539 +2150 -72.562655 40.770138 26.560905 +2151 -72.563536 40.777239 23.744374 +2152 -72.570631 40.779857 22.145893 +2153 -72.571317 40.785704 20.268952 +2154 -72.575391 40.789695 18.414814 +2155 -72.576213 40.795938 15.031098 +2156 -72.582983 40.797029 13.555029 +2157 -72.589040 40.795140 13.358140 +2158 -72.593224 40.801648 9.053076 +2159 -72.599031 40.801145 8.234323 +2160 -72.603904 40.804661 1.296073 +2161 -72.608674 40.803464 1.340585 +2162 -72.393073 40.867496 3.426805 +2163 -72.395002 40.861922 5.608823 +2164 -72.396376 40.856162 12.414486 +2165 -72.399798 40.850890 14.741630 +2166 -72.400597 40.845398 17.291840 +2167 -72.399015 40.839157 19.219114 +2168 -72.393580 40.834349 21.675382 +2169 -72.399924 40.831949 21.711716 +2170 -72.399349 40.824619 24.449630 +2171 -72.405437 40.821592 25.043593 +2172 -72.411585 40.817993 26.134041 +2173 -72.414281 40.812170 27.730636 +2174 -72.420147 40.810274 27.648211 +2175 -72.426697 40.808201 28.264004 +2176 -72.426421 40.800469 30.280841 +2177 -72.432191 40.796505 30.815014 +2178 -72.438299 40.793342 31.006346 +2179 -72.439023 40.786935 32.666715 +2180 -72.440450 40.780489 35.433204 +2181 -72.446588 40.777697 36.718583 +2182 -72.452529 40.775898 36.580548 +2183 -72.456251 40.770924 38.227732 +2184 -72.459866 40.765993 39.373193 +2185 -72.465505 40.763849 39.501259 +2186 -72.471344 40.768007 37.613754 +2187 -72.477271 40.764224 37.565483 +2188 -72.483051 40.761195 36.653297 +2189 -72.484630 40.755744 36.744333 +2190 -72.489696 40.758502 35.825205 +2191 -72.494933 40.755997 35.208233 +2192 -72.501103 40.757463 34.424828 +2193 -72.508819 40.758565 33.717892 +2194 -72.515261 40.761616 33.035865 +2195 -72.518341 40.767722 31.988705 +2196 -72.524074 40.773516 29.751364 +2197 -72.530424 40.770788 29.648221 +2198 -72.536918 40.772268 23.927706 +2199 -72.543758 40.774556 19.385118 +2200 -72.550865 40.777809 24.472254 +2201 -72.557760 40.782125 22.109234 +2202 -72.565327 40.783947 21.591479 +2203 -72.568810 40.791285 18.390404 +2204 -72.568867 40.797927 15.270586 +2205 -72.574323 40.802210 12.417279 +2206 -72.581154 40.803211 8.946502 +2207 -72.587276 40.802295 8.831213 +2208 -72.590919 40.808293 1.671887 +2209 -72.595192 40.807112 1.775771 +2210 -72.599343 40.805605 1.740844 +2211 -72.396931 40.866311 3.148808 +2212 -72.400525 40.865133 3.349247 +2213 -72.399953 40.860412 7.506697 +2214 -72.401386 40.856050 12.080589 +2215 -72.406786 40.855417 10.214024 +2216 -72.406834 40.848807 14.722043 +2217 -72.405194 40.842402 16.681469 +2218 -72.406697 40.836234 19.200985 +2219 -72.406134 40.828735 22.318278 +2220 -72.412399 40.825163 24.502460 +2221 -72.418627 40.821944 23.786938 +2222 -72.418003 40.816096 25.733462 +2223 -72.424383 40.816760 24.848713 +2224 -72.430288 40.814224 25.949478 +2225 -72.434141 40.809277 26.695429 +2226 -72.432728 40.803268 29.198532 +2227 -72.437869 40.799071 30.018644 +2228 -72.444758 40.797183 29.372075 +2229 -72.443996 40.790780 31.267392 +2230 -72.446024 40.784826 33.357040 +2231 -72.453019 40.782825 33.014823 +2232 -72.458988 40.777310 34.454674 +2233 -72.464486 40.771679 36.646399 +2234 -72.472009 40.775355 33.956477 +2235 -72.477929 40.771872 35.399678 +2236 -72.483457 40.767791 35.836627 +2237 -72.488604 40.764095 35.426539 +2238 -72.495507 40.763111 34.065920 +2239 -72.502952 40.764353 33.347720 +2240 -72.510118 40.766054 33.138550 +2241 -72.511374 40.772548 31.748229 +2242 -72.517416 40.774594 30.669912 +2243 -72.519861 40.780701 27.271520 +2244 -72.526467 40.780113 25.459402 +2245 -72.531438 40.776826 25.753373 +2246 -72.537972 40.779105 18.036509 +2247 -72.544781 40.781059 20.764381 +2248 -72.551177 40.784547 22.068806 +2249 -72.555818 40.790427 19.483541 +2250 -72.561922 40.788454 19.574621 +2251 -72.562613 40.794718 17.611811 +2252 -72.562583 40.802052 14.132832 +2253 -72.568759 40.803732 12.222535 +2254 -72.572433 40.808457 6.685342 +2255 -72.577687 40.807134 6.622258 +2256 -72.582495 40.811054 1.413132 +2257 -72.586692 40.809629 1.622438 +2258 -72.404503 40.863686 3.073251 +2259 -72.404399 40.859447 9.011084 +2260 -72.408570 40.862240 4.160678 +2261 -72.412999 40.860613 2.640825 +2262 -72.412137 40.854424 8.754335 +2263 -72.412998 40.849276 11.950877 +2264 -72.411670 40.843275 15.658801 +2265 -72.413881 40.837861 18.262871 +2266 -72.412964 40.831934 21.959340 +2267 -72.419497 40.828917 21.385069 +2268 -72.425217 40.825019 21.286658 +2269 -72.430611 40.820772 22.725662 +2270 -72.436305 40.816274 24.173770 +2271 -72.439571 40.810495 25.581070 +2272 -72.440423 40.804305 28.035987 +2273 -72.447663 40.803178 27.766469 +2274 -72.452079 40.797730 28.131372 +2275 -72.450685 40.790854 30.149141 +2276 -72.457136 40.788307 30.308430 +2277 -72.460694 40.783569 31.324062 +2278 -72.465964 40.778735 32.861106 +2279 -72.472735 40.782223 30.666414 +2280 -72.479347 40.779762 31.163077 +2281 -72.484818 40.774152 33.694072 +2282 -72.490543 40.769407 34.192328 +2283 -72.497494 40.770085 32.788514 +2284 -72.504368 40.771348 32.190933 +2285 -72.505834 40.778031 30.180907 +2286 -72.512568 40.779080 29.387888 +2287 -72.513938 40.784619 26.970294 +2288 -72.518384 40.787849 22.721513 +2289 -72.525156 40.785948 19.676710 +2290 -72.532308 40.784274 20.905316 +2291 -72.539563 40.785567 16.390953 +2292 -72.545357 40.786827 20.109714 +2293 -72.549289 40.790491 19.942347 +2294 -72.550428 40.796506 18.172415 +2295 -72.557179 40.797427 17.171453 +2296 -72.555359 40.803657 14.166263 +2297 -72.561019 40.809061 8.818705 +2298 -72.566402 40.808708 7.713981 +2299 -72.569606 40.814330 1.423901 +2300 -72.573912 40.813275 1.441146 +2301 -72.578214 40.812206 1.636778 +2302 -72.417389 40.859155 1.098795 +2303 -72.417531 40.853438 7.459641 +2304 -72.418098 40.847721 12.147543 +2305 -72.419027 40.842179 15.928421 +2306 -72.419911 40.835630 17.425394 +2307 -72.426718 40.833242 17.438736 +2308 -72.431646 40.827978 19.781488 +2309 -72.436655 40.823198 20.756557 +2310 -72.442241 40.819284 22.008891 +2311 -72.442576 40.814199 24.076874 +2312 -72.445386 40.809045 25.741841 +2313 -72.451704 40.808485 25.802199 +2314 -72.453960 40.803286 27.383326 +2315 -72.459037 40.800033 27.207392 +2316 -72.457958 40.794026 28.591958 +2317 -72.464178 40.790095 29.237581 +2318 -72.466736 40.784509 30.490340 +2319 -72.470909 40.787879 29.269517 +2320 -72.477927 40.788152 28.620434 +2321 -72.484902 40.785435 28.898484 +2322 -72.486842 40.779777 30.974640 +2323 -72.492160 40.775677 32.005753 +2324 -72.498872 40.777084 30.742083 +2325 -72.500741 40.783706 28.792049 +2326 -72.507696 40.784528 27.913008 +2327 -72.511286 40.790767 24.961263 +2328 -72.517522 40.794305 22.792753 +2329 -72.523091 40.791401 19.187788 +2330 -72.529724 40.791790 18.867020 +2331 -72.536036 40.790278 16.178089 +2332 -72.542767 40.792581 17.068014 +2333 -72.543405 40.798899 18.022898 +2334 -72.548794 40.802390 16.097733 +2335 -72.550030 40.808244 13.263652 +2336 -72.556214 40.810833 8.589483 +2337 -72.561020 40.816533 1.087317 +2338 -72.565329 40.815495 1.314529 +2339 -72.421669 40.858001 1.102870 +2340 -72.422939 40.852610 7.538120 +2341 -72.424541 40.847684 12.429477 +2342 -72.425310 40.840804 16.158180 +2343 -72.431401 40.840409 15.037066 +2344 -72.434282 40.834815 17.771662 +2345 -72.437957 40.829841 17.887060 +2346 -72.442337 40.825159 19.707443 +2347 -72.447498 40.821235 20.142414 +2348 -72.448614 40.814836 23.052519 +2349 -72.455375 40.812535 24.089232 +2350 -72.459176 40.806585 25.969949 +2351 -72.465205 40.802266 26.613020 +2352 -72.465056 40.796357 28.033330 +2353 -72.471665 40.793128 28.874454 +2354 -72.478622 40.795981 26.245351 +2355 -72.484560 40.792476 27.526648 +2356 -72.490205 40.788989 28.311629 +2357 -72.493176 40.782902 29.388543 +2358 -72.496697 40.789640 27.871260 +2359 -72.503606 40.790085 26.813407 +2360 -72.506367 40.795423 24.554888 +2361 -72.512062 40.797946 22.609651 +2362 -72.518523 40.800697 21.031495 +2363 -72.524023 40.796970 20.481794 +2364 -72.529832 40.798513 19.237797 +2365 -72.536208 40.796751 18.501423 +2366 -72.538668 40.802799 17.068165 +2367 -72.543749 40.805353 15.367909 +2368 -72.544161 40.810551 12.728629 +2369 -72.547933 40.814323 7.492506 +2370 -72.552581 40.813614 7.444883 +2371 -72.556668 40.817377 1.774432 +2372 -72.425901 40.856681 1.101795 +2373 -72.430128 40.855345 1.068928 +2374 -72.430024 40.847398 10.623670 +2375 -72.435321 40.846847 9.852017 +2376 -72.437967 40.841207 13.623480 +2377 -72.441409 40.836291 14.985753 +2378 -72.443259 40.830691 17.339283 +2379 -72.447272 40.827330 17.769754 +2380 -72.451300 40.823955 18.759989 +2381 -72.453566 40.818710 20.825742 +2382 -72.458782 40.815857 22.361105 +2383 -72.461995 40.811538 23.857234 +2384 -72.466413 40.807533 24.913659 +2385 -72.471323 40.804037 24.354450 +2386 -72.471943 40.799032 25.913086 +2387 -72.478453 40.802942 20.080669 +2388 -72.486043 40.799622 21.051866 +2389 -72.491779 40.794813 26.524317 +2390 -72.499585 40.796547 24.921672 +2391 -72.505936 40.801565 21.265071 +2392 -72.512399 40.804489 19.980762 +2393 -72.518974 40.806520 18.332607 +2394 -72.525711 40.803760 18.570427 +2395 -72.532939 40.803870 17.431038 +2396 -72.537868 40.809401 14.370051 +2397 -72.542081 40.815806 7.457824 +2398 -72.548163 40.819872 1.582322 +2399 -72.552413 40.818615 1.807315 +2400 -72.434352 40.854000 1.077617 +2401 -72.438579 40.852661 1.021269 +2402 -72.440902 40.847069 7.392496 +2403 -72.444746 40.843502 8.930221 +2404 -72.446794 40.838836 13.040915 +2405 -72.447695 40.833438 15.492646 +2406 -72.451934 40.828806 17.124287 +2407 -72.455832 40.824096 18.579607 +2408 -72.459542 40.820081 20.591488 +2409 -72.464035 40.816061 21.318033 +2410 -72.468440 40.812132 22.520815 +2411 -72.473653 40.808269 23.346344 +2412 -72.480289 40.809677 21.410661 +2413 -72.484855 40.805455 19.437149 +2414 -72.492224 40.805717 21.280814 +2415 -72.493811 40.800270 24.725011 +2416 -72.499803 40.803885 22.771487 +2417 -72.506732 40.808917 18.213818 +2418 -72.513927 40.810857 15.565813 +2419 -72.519956 40.811933 15.549285 +2420 -72.524460 40.809480 15.775271 +2421 -72.530724 40.810419 14.683255 +2422 -72.536177 40.816029 8.966289 +2423 -72.539631 40.822274 1.759183 +2424 -72.543865 40.820962 1.735188 +2425 -72.442813 40.851349 1.134685 +2426 -72.447032 40.849988 1.056191 +2427 -72.450442 40.843176 7.582777 +2428 -72.451238 40.838064 12.544303 +2429 -72.453097 40.833396 14.813195 +2430 -72.456770 40.828941 16.500881 +2431 -72.461016 40.824387 18.476978 +2432 -72.464998 40.820293 19.854681 +2433 -72.469520 40.816637 20.281003 +2434 -72.474488 40.813188 21.510243 +2435 -72.479423 40.815415 19.791044 +2436 -72.484571 40.814279 19.752489 +2437 -72.487502 40.810040 19.102249 +2438 -72.493727 40.811744 18.674866 +2439 -72.499388 40.809684 19.183508 +2440 -72.504324 40.814916 16.206100 +2441 -72.511140 40.816557 14.652144 +2442 -72.518040 40.816738 13.933509 +2443 -72.525174 40.815424 12.445473 +2444 -72.531278 40.817154 8.712625 +2445 -72.535412 40.823635 1.493137 +2446 -72.451218 40.848526 0.725241 +2447 -72.455310 40.846825 0.365793 +2448 -72.454877 40.842148 7.490651 +2449 -72.455411 40.837738 10.571174 +2450 -72.457095 40.833773 14.109475 +2451 -72.459942 40.831433 14.756613 +2452 -72.460888 40.828231 16.384283 +2453 -72.464331 40.826919 16.346848 +2454 -72.466449 40.823772 18.341009 +2455 -72.470199 40.820679 18.788918 +2456 -72.474586 40.817893 19.011013 +2457 -72.478884 40.820074 17.512409 +2458 -72.483561 40.818810 17.151649 +2459 -72.488606 40.818354 16.618683 +2460 -72.489857 40.814511 18.450710 +2461 -72.494423 40.817568 16.617409 +2462 -72.498604 40.814882 17.224432 +2463 -72.500705 40.819885 14.606184 +2464 -72.506607 40.820817 13.356578 +2465 -72.511625 40.823438 8.802087 +2466 -72.516796 40.822917 7.093217 +2467 -72.522730 40.821306 7.199222 +2468 -72.528514 40.820993 6.427059 +2469 -72.531172 40.824928 1.507024 +2470 -72.459399 40.845111 0.643088 +2471 -72.458744 40.841170 7.393149 +2472 -72.458803 40.837382 9.921515 +2473 -72.460467 40.834650 12.160079 +2474 -72.462861 40.833051 12.754119 +2475 -72.463185 40.830131 14.696360 +2476 -72.466258 40.829597 14.296807 +2477 -72.468154 40.826944 15.780472 +2478 -72.470907 40.824121 17.286324 +2479 -72.474726 40.821998 17.139307 +2480 -72.478521 40.824287 15.386282 +2481 -72.482395 40.822650 15.544996 +2482 -72.487163 40.822399 15.114961 +2483 -72.491888 40.821778 14.779922 +2484 -72.496262 40.821896 14.198776 +2485 -72.498902 40.825255 10.566337 +2486 -72.503280 40.825009 9.704228 +2487 -72.508199 40.827058 6.110822 +2488 -72.514194 40.830048 1.327289 +2489 -72.518437 40.828763 1.273372 +2490 -72.522681 40.827481 1.713135 +2491 -72.526927 40.826206 1.829533 +2492 -72.462395 40.841648 5.443700 +2493 -72.462668 40.843890 0.439484 +2494 -72.461463 40.839429 8.050264 +2495 -72.461662 40.837097 9.489970 +2496 -72.463596 40.835708 10.018347 +2497 -72.465679 40.834369 10.691107 +2498 -72.465167 40.831962 12.906286 +2499 -72.467473 40.832451 12.364101 +2500 -72.468857 40.830528 13.268350 +2501 -72.470235 40.828929 13.894355 +2502 -72.471538 40.826847 15.233039 +2503 -72.474656 40.825500 15.617990 +2504 -72.477102 40.827333 14.519689 +2505 -72.479388 40.828439 11.333035 +2506 -72.481834 40.826324 14.567136 +2507 -72.484776 40.825086 14.301663 +2508 -72.487563 40.826513 13.097108 +2509 -72.490694 40.825513 12.777287 +2510 -72.494672 40.825590 11.457698 +2511 -72.496667 40.829634 7.901321 +2512 -72.500168 40.829871 6.825693 +2513 -72.503916 40.829522 4.827805 +2514 -72.505723 40.832666 1.368449 +2515 -72.509954 40.831344 1.563661 +2516 -72.465517 40.842844 2.018934 +2517 -72.464507 40.840619 5.736509 +2518 -72.464099 40.838279 8.224334 +2519 -72.466362 40.837026 8.554946 +2520 -72.468123 40.834982 9.415207 +2521 -72.470155 40.833386 9.124032 +2522 -72.471201 40.831186 10.278335 +2523 -72.472052 40.829293 13.007375 +2524 -72.473544 40.828140 13.716936 +2525 -72.475333 40.828994 11.683733 +2526 -72.477214 40.830379 7.571089 +2527 -72.478809 40.832038 5.665978 +2528 -72.480738 40.831695 5.017888 +2529 -72.481486 40.829435 7.887919 +2530 -72.483229 40.829254 9.368025 +2531 -72.484944 40.827968 12.440003 +2532 -72.487114 40.829911 7.702233 +2533 -72.489803 40.829005 8.773206 +2534 -72.493052 40.828885 8.742445 +2535 -72.494423 40.832434 5.749287 +2536 -72.497248 40.835255 0.335868 +2537 -72.501507 40.834038 0.680588 +2538 -72.467377 40.842113 2.790792 +2539 -72.466529 40.839695 6.067099 +2540 -72.468389 40.839125 5.654102 +2541 -72.468706 40.837150 7.811728 +2542 -72.470439 40.836097 7.654905 +2543 -72.472387 40.835153 5.346585 +2544 -72.472811 40.832919 6.302107 +2545 -72.473504 40.830710 9.331757 +2546 -72.475134 40.831785 6.510984 +2547 -72.476778 40.833154 5.530867 +2548 -72.478288 40.834678 6.573034 +2549 -72.480201 40.834111 5.584671 +2550 -72.482214 40.833890 3.938494 +2551 -72.482850 40.831614 4.240966 +2552 -72.484914 40.831069 3.983298 +2553 -72.486508 40.832964 3.504036 +2554 -72.488783 40.832081 4.381546 +2555 -72.491383 40.831651 6.128453 +2556 -72.492099 40.834085 2.511643 +2557 -72.493596 40.835751 -1.166865 +2558 -72.468886 40.841610 0.877539 +2559 -72.470018 40.841107 0.136408 +2560 -72.470462 40.838636 4.240261 +2561 -72.472380 40.837645 3.660271 +2562 -72.474214 40.836371 2.465582 +2563 -72.474665 40.834242 4.327290 +2564 -72.476347 40.835643 5.262805 +2565 -72.478006 40.836868 9.494951 +2566 -72.479685 40.836333 5.408797 +2567 -72.481515 40.836025 5.651602 +2568 -72.483533 40.835888 4.609108 +2569 -72.484349 40.833641 4.064034 +2570 -72.485712 40.835813 3.705251 +2571 -72.487747 40.835265 2.846165 +2572 -72.489857 40.834466 2.366937 +2573 -72.490863 40.836515 -0.367830 +2574 -72.471192 40.840562 2.222605 +2575 -72.472324 40.840143 2.208218 +2576 -72.473624 40.839556 -2.101058 +2577 -72.474363 40.838176 0.530961 +2578 -72.474863 40.838105 2.003211 +2579 -72.475547 40.837469 5.109446 +2580 -72.476620 40.837652 9.210798 +2581 -72.477362 40.838490 6.408189 +2582 -72.478270 40.838548 5.021817 +2583 -72.479398 40.838256 4.257147 +2584 -72.480864 40.837862 6.101051 +2585 -72.482575 40.837655 4.335375 +2586 -72.484580 40.837807 2.448854 +2587 -72.486905 40.838598 -0.852935 +2588 -72.488863 40.837556 -1.445857 +2589 -72.474322 40.839144 -0.576436 +2590 -72.474853 40.839144 1.756138 +2591 -72.475746 40.839200 5.965252 +2592 -72.476553 40.839140 6.175214 +2593 -72.477045 40.839788 6.112574 +2594 -72.477711 40.839548 3.448296 +2595 -72.477933 40.839548 2.802722 +2596 -72.478776 40.839642 2.678310 +2597 -72.479645 40.839960 2.955902 +2598 -72.480507 40.839465 3.880124 +2599 -72.481692 40.839223 3.604616 +2600 -72.483025 40.839008 2.461584 +2601 -72.483783 40.839783 1.056116 +2602 -72.484800 40.839396 0.833827 +2603 -72.474843 40.840239 1.354929 +2604 -72.475679 40.840797 5.236218 +2605 -72.476346 40.840396 9.416155 +2606 -72.477032 40.840868 4.388872 +2607 -72.477712 40.840153 1.823442 +2608 -72.477997 40.840134 2.346415 +2609 -72.478320 40.840688 1.159180 +2610 -72.479013 40.840891 1.436074 +2611 -72.479745 40.841107 1.619788 +2612 -72.480479 40.840939 2.142786 +2613 -72.481213 40.840772 2.598862 +2614 -72.482171 40.840401 1.789177 +2615 -72.483057 40.840059 1.014702 +2616 -72.474899 40.841021 0.349482 +2617 -72.475555 40.842068 4.517681 +2618 -72.476438 40.841981 8.927621 +2619 -72.477197 40.841719 4.213827 +2620 -72.477773 40.841242 0.337092 +2621 -72.477742 40.840682 0.271279 +2622 -72.474966 40.841945 -0.949204 +2623 -72.474988 40.843404 5.499937 +2624 -72.475908 40.843141 9.992003 +2625 -72.476735 40.843725 9.796218 +2626 -72.477324 40.842636 4.064770 +2627 -72.477802 40.841769 0.384337 +2628 -72.474435 40.842688 0.041428 +2629 -72.473917 40.843413 0.811648 +2630 -72.474498 40.844829 3.533190 +2631 -72.475649 40.844481 7.643339 +2632 -72.476542 40.845376 4.960338 +2633 -72.477612 40.844750 8.089311 +2634 -72.477774 40.843520 5.092311 +2635 -72.478285 40.842614 -1.083346 +2636 -72.478049 40.842202 -0.248005 +2637 -72.473478 40.844791 2.210218 +2638 -72.473219 40.843688 0.698937 +2639 -72.473820 40.846490 2.966674 +2640 -72.475256 40.846046 3.520019 +2641 -72.476368 40.847033 2.920768 +2642 -72.477702 40.846245 4.049466 +2643 -72.478754 40.845393 4.946445 +2644 -72.478484 40.844183 5.727789 +2645 -72.478634 40.843092 1.346799 +2646 -72.472534 40.843958 0.422035 +2647 -72.472600 40.845377 1.802038 +2648 -72.472366 40.846926 3.215405 +2649 -72.473609 40.848586 1.458291 +2650 -72.474976 40.847769 2.453736 +2651 -72.476171 40.848853 1.886564 +2652 -72.477631 40.847847 2.182625 +2653 -72.479183 40.846998 2.612803 +2654 -72.480052 40.845397 3.401183 +2655 -72.479466 40.844320 3.555887 +2656 -72.479004 40.843599 3.591861 +2657 -72.471889 40.844217 0.730307 +2658 -72.471225 40.844484 0.979022 +2659 -72.471038 40.847202 2.654347 +2660 -72.472284 40.849239 1.325626 +2661 -72.473641 40.851150 0.944185 +2662 -72.474850 40.849639 0.967939 +2663 -72.475936 40.851094 1.005730 +2664 -72.477271 40.849550 1.497035 +2665 -72.478750 40.848956 1.507917 +2666 -72.480330 40.848384 1.198141 +2667 -72.480895 40.846706 3.445867 +2668 -72.481435 40.844974 3.423380 +2669 -72.480540 40.843838 3.320991 +2670 -72.479488 40.843159 3.283026 +2671 -72.469950 40.845232 0.985570 +2672 -72.469621 40.847891 5.598149 +2673 -72.470869 40.849715 1.128062 +2674 -72.472089 40.851610 1.317520 +2675 -72.473359 40.853936 0.996931 +2676 -72.475182 40.853107 1.078072 +2677 -72.477121 40.852925 0.562363 +2678 -72.477855 40.850900 1.178859 +2679 -72.479626 40.850492 0.965749 +2680 -72.481202 40.849660 0.791217 +2681 -72.482320 40.848159 0.864188 +2682 -72.482287 40.846251 2.895669 +2683 -72.483104 40.844803 1.760781 +2684 -72.481854 40.843519 3.700706 +2685 -72.480864 40.842470 3.853159 +2686 -72.480039 40.842658 2.941824 +2687 -72.468383 40.846432 0.117524 +2688 -72.468127 40.849205 3.308861 +2689 -72.469510 40.850200 5.218322 +2690 -72.470407 40.852153 1.957193 +2691 -72.471571 40.853930 2.130035 +2692 -72.472176 40.856584 2.899282 +2693 -72.474705 40.856449 2.566781 +2694 -72.476573 40.855191 1.547310 +2695 -72.478551 40.854856 0.970051 +2696 -72.478556 40.852296 0.639672 +2697 -72.479703 40.852545 1.216842 +2698 -72.481052 40.851405 0.604511 +2699 -72.482668 40.850246 0.249274 +2700 -72.484370 40.849130 -0.256172 +2701 -72.483751 40.846912 3.044629 +2702 -72.484762 40.845398 2.356331 +2703 -72.484347 40.843421 4.912067 +2704 -72.483019 40.843138 4.145692 +2705 -72.482364 40.842030 3.397266 +2706 -72.481506 40.842323 4.585687 +2707 -72.466790 40.847354 0.343979 +2708 -72.464902 40.850775 1.698819 +2709 -72.466706 40.851246 2.002937 +2710 -72.468655 40.852027 4.791756 +2711 -72.469756 40.854986 3.790318 +2712 -72.469902 40.858369 2.727830 +2713 -72.473550 40.859833 2.923274 +2714 -72.477382 40.858066 2.903387 +2715 -72.480199 40.856460 2.522302 +2716 -72.480648 40.853838 0.456814 +2717 -72.482347 40.852339 0.814246 +2718 -72.484079 40.851374 0.315413 +2719 -72.485712 40.850960 1.110623 +2720 -72.486682 40.849511 1.130832 +2721 -72.485543 40.847522 1.281852 +2722 -72.486359 40.846015 1.103885 +2723 -72.486052 40.844076 1.752830 +2724 -72.485176 40.841707 3.427956 +2725 -72.483351 40.841694 1.953375 +2726 -72.464610 40.847522 -0.230080 +2727 -72.463080 40.850113 -0.021176 +2728 -72.462634 40.852970 3.820871 +2729 -72.465225 40.854585 1.932433 +2730 -72.467534 40.853816 1.596387 +2731 -72.467670 40.856298 1.833347 +2732 -72.466094 40.858771 2.819138 +2733 -72.469609 40.861783 2.840719 +2734 -72.473381 40.863812 2.805848 +2735 -72.477352 40.861372 2.931827 +2736 -72.481162 40.859199 2.825517 +2737 -72.482589 40.856707 2.770209 +2738 -72.482251 40.854646 2.174062 +2739 -72.483758 40.853214 1.304548 +2740 -72.485573 40.852954 1.982595 +2741 -72.487630 40.852015 2.018052 +2742 -72.488834 40.849725 1.186131 +2743 -72.487569 40.847694 1.651381 +2744 -72.487934 40.845582 0.910748 +2745 -72.487652 40.843389 5.132318 +2746 -72.487347 40.841285 0.395631 +2747 -72.462136 40.848486 0.846119 +2748 -72.460795 40.850205 2.770545 +2749 -72.459685 40.853883 2.791483 +2750 -72.462708 40.856468 2.737212 +2751 -72.462377 40.860157 2.853392 +2752 -72.465766 40.862384 2.876132 +2753 -72.468191 40.866134 2.636291 +2754 -72.473963 40.867738 2.782109 +2755 -72.478464 40.864826 2.727755 +2756 -72.481430 40.862135 2.821122 +2757 -72.485189 40.860415 2.757032 +2758 -72.484987 40.857575 2.904648 +2759 -72.484448 40.855105 2.631927 +2760 -72.486826 40.855049 2.671041 +2761 -72.489027 40.854197 2.728716 +2762 -72.490100 40.851814 2.029702 +2763 -72.491121 40.849336 1.091031 +2764 -72.489548 40.847375 0.734660 +2765 -72.489823 40.845149 0.701939 +2766 -72.489670 40.842991 6.774023 +2767 -72.489517 40.840864 0.449505 +2768 -72.458489 40.850079 1.138301 +2769 -72.455847 40.855402 2.985652 +2770 -72.459563 40.857386 2.828585 +2771 -72.458181 40.860787 3.036358 +2772 -72.462099 40.864200 2.951926 +2773 -72.462935 40.868336 2.683183 +2774 -72.469140 40.871208 2.753749 +2775 -72.475951 40.871468 2.765532 +2776 -72.480402 40.868096 2.710385 +2777 -72.484627 40.864450 2.777311 +2778 -72.489244 40.860770 2.610357 +2779 -72.488750 40.857375 2.667697 +2780 -72.491617 40.854264 2.601997 +2781 -72.492449 40.851391 1.767494 +2782 -72.493791 40.849046 1.124022 +2783 -72.491849 40.847008 -2.342191 +2784 -72.492027 40.844686 1.669205 +2785 -72.491756 40.842624 4.431066 +2786 -72.491910 40.840925 0.372486 +2787 -72.454006 40.850285 1.055834 +2788 -72.450931 40.856367 1.500000 +2789 -72.454015 40.860321 2.897601 +2790 -72.456463 40.865397 2.889372 +2791 -72.458016 40.870700 2.857457 +2792 -72.463532 40.872686 2.814104 +2793 -72.466740 40.876775 2.682993 +2794 -72.472813 40.875271 2.915503 +2795 -72.478605 40.875195 2.775363 +2796 -72.482130 40.871807 2.777112 +2797 -72.486676 40.868330 2.750027 +2798 -72.490166 40.864222 2.673699 +2799 -72.493725 40.860601 2.402101 +2800 -72.493104 40.856827 2.617652 +2801 -72.495069 40.852101 2.460472 +2802 -72.496589 40.847890 4.058435 +2803 -72.494273 40.846270 1.771278 +2804 -72.494302 40.843707 6.523306 +2805 -72.493713 40.842075 0.694687 +2806 -72.493887 40.841041 0.607074 +2807 -72.449775 40.851713 1.000000 +2808 -72.445947 40.853946 1.021431 +2809 -72.446394 40.858423 1.010000 +2810 -72.449726 40.862989 3.042660 +2811 -72.451946 40.868542 3.106724 +2812 -72.454197 40.873924 2.822363 +2813 -72.460088 40.876145 2.869006 +2814 -72.463209 40.881435 1.010000 +2815 -72.467554 40.882301 1.010000 +2816 -72.471758 40.879436 2.525766 +2817 -72.476775 40.879097 2.510356 +2818 -72.481188 40.878964 2.474700 +2819 -72.483878 40.875917 2.841167 +2820 -72.487343 40.872903 2.624744 +2821 -72.490931 40.870648 1.332506 +2822 -72.492877 40.866786 1.048962 +2823 -72.495762 40.863421 0.897360 +2824 -72.498614 40.860028 0.980138 +2825 -72.496681 40.857530 2.195851 +2826 -72.497347 40.854070 2.781976 +2827 -72.498775 40.849519 1.817276 +2828 -72.499691 40.844771 3.553432 +2829 -72.496537 40.844695 4.841416 +2830 -72.496212 40.841216 0.581660 +2831 -72.441715 40.855174 0.758648 +2832 -72.443238 40.861972 1.239446 +2833 -72.445348 40.867338 2.335282 +2834 -72.448839 40.872605 2.354688 +2835 -72.450441 40.877730 1.010000 +2836 -72.454726 40.878867 1.010000 +2837 -72.458936 40.880256 1.010010 +2838 -72.471969 40.882705 1.010000 +2839 -72.476386 40.883076 1.010000 +2840 -72.480802 40.883470 1.010265 +2841 -72.485684 40.880400 2.635433 +2842 -72.488569 40.876898 2.706367 +2843 -72.492747 40.874521 1.523719 +2844 -72.500714 40.856142 1.295393 +2845 -72.500434 40.851948 1.602114 +2846 -72.502705 40.847678 -0.417688 +2847 -72.503561 40.841802 1.926763 +2848 -72.499876 40.840789 2.784129 +2849 -72.497103 40.838717 1.152988 +2850 -72.438414 40.860122 1.010000 +2851 -72.437357 40.855959 0.700000 +2852 -72.438160 40.865968 1.010000 +2853 -72.440025 40.869952 3.139000 +2854 -72.444218 40.872463 2.880019 +2855 -72.446053 40.877406 1.051646 +2856 -72.485203 40.883999 1.085000 +2857 -72.489630 40.883988 1.429944 +2858 -72.490878 40.880478 2.772816 +2859 -72.492931 40.877394 2.121201 +2860 -72.497070 40.875361 2.276438 +2861 -72.502936 40.852345 1.215883 +2862 -72.506748 40.850449 1.095258 +2863 -72.505806 40.845512 2.208562 +2864 -72.508084 40.841610 1.765526 +2865 -72.506292 40.837035 1.933650 +2866 -72.501312 40.836964 1.082689 +2867 -72.433141 40.857329 0.700000 +2868 -72.434877 40.863024 1.010000 +2869 -72.440281 40.874343 1.010000 +2870 -72.442371 40.876192 1.830791 +2871 -72.442001 40.879069 1.330127 +2872 -72.494056 40.883872 0.905163 +2873 -72.495529 40.879500 2.525010 +2874 -72.500304 40.878133 1.753740 +2875 -72.511010 40.848426 2.497768 +2876 -72.510563 40.852652 1.085000 +2877 -72.508861 40.845866 1.866823 +2878 -72.512365 40.843388 3.095338 +2879 -72.511673 40.838692 2.280000 +2880 -72.510137 40.834938 1.085000 +2881 -72.430724 40.861558 1.010000 +2882 -72.428944 40.858757 1.009429 +2883 -72.438294 40.878293 1.010000 +2884 -72.438589 40.882582 1.538742 +2885 -72.440531 40.883143 1.807650 +2886 -72.497963 40.881575 1.924729 +2887 -72.498427 40.884597 1.688013 +2888 -72.501664 40.882306 2.549083 +2889 -72.514405 40.850561 1.318967 +2890 -72.514250 40.846858 2.391314 +2891 -72.514707 40.853999 1.085000 +2892 -72.516876 40.844377 3.192878 +2893 -72.516362 40.840739 2.280000 +2894 -72.516135 40.837540 2.280000 +2895 -72.514070 40.834239 1.824777 +2896 -72.426501 40.862346 1.010000 +2897 -72.424721 40.860103 1.010000 +2898 -72.518687 40.852248 1.091654 +2899 -72.517360 40.848260 2.176571 +2900 -72.520505 40.846034 2.295059 +2901 -72.520671 40.842285 2.365458 +2902 -72.521112 40.838150 2.280000 +2903 -72.518566 40.835426 1.954535 +2904 -72.518265 40.832928 1.004264 +2905 -72.423516 40.862790 1.618000 +2906 -72.424530 40.865983 1.010000 +2907 -72.420434 40.861233 1.012305 +2908 -72.521855 40.851473 1.420982 +2909 -72.522219 40.854135 1.085000 +2910 -72.520230 40.849260 2.148181 +2911 -72.523340 40.848848 2.005035 +2912 -72.524326 40.845003 2.304152 +2913 -72.524737 40.840712 2.280000 +2914 -72.526314 40.836384 2.140697 +2915 -72.522548 40.833714 1.373246 +2916 -72.420997 40.863549 1.618000 +2917 -72.422484 40.865001 1.618000 +2918 -72.422296 40.867189 1.618000 +2919 -72.422627 40.870127 1.443394 +2920 -72.418458 40.863886 1.618000 +2921 -72.416133 40.862294 1.033694 +2922 -72.524718 40.852977 1.085000 +2923 -72.525244 40.857095 1.085000 +2924 -72.527567 40.848702 1.387850 +2925 -72.528084 40.843651 2.386695 +2926 -72.528702 40.839547 2.394935 +2927 -72.532155 40.836477 2.308157 +2928 -72.529562 40.833155 2.167374 +2929 -72.526306 40.832141 1.000000 +2930 -72.420464 40.865725 1.618000 +2931 -72.420666 40.868310 1.531934 +2932 -72.419733 40.870842 1.010000 +2933 -72.422054 40.874515 1.010000 +2934 -72.415545 40.864386 1.411812 +2935 -72.416644 40.865683 1.010000 +2936 -72.418607 40.866566 1.010000 +2937 -72.412606 40.864561 1.010000 +2938 -72.531417 40.845566 2.863486 +2939 -72.531940 40.849425 1.107979 +2940 -72.532094 40.841235 2.611257 +2941 -72.536208 40.839458 2.286195 +2942 -72.537141 40.834890 2.280000 +2943 -72.533468 40.831467 2.280000 +2944 -72.528228 40.828820 1.033124 +2945 -72.419671 40.875257 1.306761 +2946 -72.421025 40.878625 1.010000 +2947 -72.414240 40.866285 1.010000 +2948 -72.415470 40.867469 1.010000 +2949 -72.412622 40.868951 1.010000 +2950 -72.534643 40.847532 2.315861 +2951 -72.535501 40.843526 2.494336 +2952 -72.533323 40.851931 1.085000 +2953 -72.540445 40.842852 2.278490 +2954 -72.540254 40.838527 2.306810 +2955 -72.542426 40.834966 2.337006 +2956 -72.538820 40.830169 2.227469 +2957 -72.533434 40.826699 1.019895 +2958 -72.537378 40.849487 2.372269 +2959 -72.538085 40.846033 2.237784 +2960 -72.534226 40.854344 1.450053 +2961 -72.530110 40.854931 1.085000 +2962 -72.537181 40.852927 2.175240 +2963 -72.541642 40.847459 2.466620 +2964 -72.545459 40.845026 2.501828 +2965 -72.544591 40.840687 2.222836 +2966 -72.547475 40.838544 2.347715 +2967 -72.546298 40.834269 2.453843 +2968 -72.544303 40.829858 2.110010 +2969 -72.542192 40.825455 1.029509 +2970 -72.537785 40.825919 1.107934 +2971 -72.540121 40.851135 2.242688 +2972 -72.533656 40.856305 2.270684 +2973 -72.537042 40.856315 2.316590 +2974 -72.532075 40.857718 1.272931 +2975 -72.530093 40.859286 1.085000 +2976 -72.540486 40.854742 2.219817 +2977 -72.543347 40.851497 2.296046 +2978 -72.545610 40.848743 2.362398 +2979 -72.549801 40.848285 1.877137 +2980 -72.550384 40.843962 1.430569 +2981 -72.551760 40.840172 2.217541 +2982 -72.550268 40.835691 3.758200 +2983 -72.548458 40.831965 2.309686 +2984 -72.549226 40.828584 2.280121 +2985 -72.546585 40.824870 1.947379 +2986 -72.534819 40.858636 2.254768 +2987 -72.537041 40.859822 2.157745 +2988 -72.539354 40.858757 2.300853 +2989 -72.532879 40.860118 1.113815 +2990 -72.532654 40.862799 1.085000 +2991 -72.541478 40.858372 1.796809 +2992 -72.544200 40.855005 1.510941 +2993 -72.547462 40.852040 1.406758 +2994 -72.554274 40.835879 2.595231 +2995 -72.556155 40.839791 1.714976 +2996 -72.552394 40.831942 2.296057 +2997 -72.553991 40.828091 2.012778 +2998 -72.550985 40.825328 1.510448 +2999 -72.535020 40.861801 1.171564 +3000 -72.536979 40.862819 1.345066 +3001 -72.538855 40.862129 1.987236 +3002 -72.541115 40.862778 1.609606 +3003 -72.536147 40.865524 1.085000 +3004 -72.558290 40.836000 2.323778 +3005 -72.556846 40.831652 2.344745 +3006 -72.560587 40.839744 1.100113 +3007 -72.558473 40.826922 2.010427 +3008 -72.554710 40.823704 1.045338 +3009 -72.538172 40.865119 1.134898 +3010 -72.539783 40.865194 1.138758 +3011 -72.541194 40.867204 1.110105 +3012 -72.539251 40.868688 1.246029 +3013 -72.562065 40.836178 2.324613 +3014 -72.561158 40.832956 2.325856 +3015 -72.560758 40.829735 2.280000 +3016 -72.563756 40.838662 1.817628 +3017 -72.564844 40.840756 1.085000 +3018 -72.563658 40.827098 2.280000 +3019 -72.562621 40.824078 1.962054 +3020 -72.558849 40.823292 1.057643 +3021 -72.557294 40.820319 1.073687 +3022 -72.565253 40.836960 2.329814 +3023 -72.565318 40.833833 2.291126 +3024 -72.564635 40.830343 2.223613 +3025 -72.567197 40.839960 1.708382 +3026 -72.567921 40.843930 1.085000 +3027 -72.568335 40.827542 2.280000 +3028 -72.567164 40.824361 1.874798 +3029 -72.566059 40.821399 1.085000 +3030 -72.561674 40.820755 1.451422 +3031 -72.567863 40.836823 2.282426 +3032 -72.569228 40.834316 2.042656 +3033 -72.568219 40.831194 2.326581 +3034 -72.569654 40.842562 1.125057 +3035 -72.570082 40.839520 2.180441 +3036 -72.571590 40.846382 1.085000 +3037 -72.571695 40.829626 2.204060 +3038 -72.572575 40.826987 2.654320 +3039 -72.571803 40.824003 2.280388 +3040 -72.570458 40.821416 1.012404 +3041 -72.570679 40.836909 2.152147 +3042 -72.573095 40.835609 1.570855 +3043 -72.571406 40.832532 2.278769 +3044 -72.571726 40.842413 1.782091 +3045 -72.573163 40.838448 1.571581 +3046 -72.573392 40.845707 1.161185 +3047 -72.574405 40.831544 1.568015 +3048 -72.575949 40.828691 2.040877 +3049 -72.575687 40.825375 2.488053 +3050 -72.575632 40.822578 2.260887 +3051 -72.574524 40.819675 1.010333 +3052 -72.578196 40.831591 1.085000 +3053 -72.579825 40.829822 2.027109 +3054 -72.579111 40.826410 2.280000 +3055 -72.579112 40.823287 2.280000 +3056 -72.578216 40.820520 1.828855 +3057 -72.578561 40.817844 1.102920 +3058 -72.582079 40.833522 1.082838 +3059 -72.582985 40.830609 1.768867 +3060 -72.581591 40.827881 1.299825 +3061 -72.582871 40.823987 1.374735 +3062 -72.581805 40.820453 1.646650 +3063 -72.580976 40.818490 1.102493 +3064 -72.582459 40.815745 1.500000 +3065 -72.583869 40.818335 1.500000 +3066 -72.585409 40.821305 1.085000 +3067 -72.585885 40.815623 2.286951 +3068 -72.585996 40.813074 1.747097 +3069 -72.586352 40.818835 1.500000 +3070 -72.589697 40.813418 1.500000 +$EndNodes +$Elements +5830 +1 15 2 0 0 1 +2 15 2 0 0 2 +3 15 2 0 0 3 +4 15 2 0 0 4 +5 15 2 0 0 5 +6 15 2 0 0 6 +7 15 2 0 0 7 +8 15 2 0 0 8 +9 15 2 0 0 9 +10 15 2 0 0 10 +11 15 2 0 0 11 +12 15 2 0 0 12 +13 15 2 0 0 13 +14 15 2 0 0 14 +15 15 2 0 0 15 +16 15 2 0 0 16 +17 15 2 0 0 17 +18 15 2 0 0 18 +19 15 2 0 0 19 +20 15 2 0 0 36 +21 15 2 0 0 37 +22 15 2 0 0 38 +23 15 2 0 0 39 +24 15 2 0 0 40 +25 15 2 0 0 41 +26 15 2 0 0 42 +27 15 2 0 0 43 +28 15 2 0 0 44 +29 15 2 0 0 45 +30 15 2 0 0 46 +31 15 2 0 0 47 +32 15 2 0 0 48 +33 15 2 0 0 49 +34 15 2 0 0 50 +35 15 2 0 0 51 +36 15 2 0 0 52 +37 15 2 0 0 53 +38 15 2 0 0 54 +39 15 2 0 0 70 +40 15 2 0 0 71 +41 15 2 0 0 72 +42 15 2 0 0 73 +43 15 2 0 0 74 +44 15 2 0 0 75 +45 15 2 0 0 77 +46 15 2 0 0 146 +47 15 2 0 0 148 +48 15 2 0 0 221 +49 15 2 0 0 223 +50 15 2 0 0 304 +51 2 3 0 1 0 77 76 1 +52 2 3 0 2 0 76 2 1 +53 2 3 0 3 0 78 2 76 +54 2 3 0 4 0 2 78 3 +55 2 3 0 5 0 3 78 79 +56 2 3 0 6 0 3 79 4 +57 2 3 0 7 0 4 79 80 +58 2 3 0 8 0 4 80 5 +59 2 3 0 9 0 5 80 81 +60 2 3 0 10 0 5 81 6 +61 2 3 0 11 0 7 6 81 +62 2 3 0 12 0 7 81 82 +63 2 3 0 13 0 82 8 7 +64 2 3 0 14 0 8 82 83 +65 2 3 0 15 0 9 8 83 +66 2 3 0 16 0 83 84 9 +67 2 3 0 17 0 10 9 84 +68 2 3 0 18 0 10 84 11 +69 2 3 0 19 0 85 11 84 +70 2 3 0 20 0 11 85 12 +71 2 3 0 21 0 12 85 86 +72 2 3 0 22 0 12 86 13 +73 2 3 0 23 0 86 87 13 +74 2 3 0 24 0 13 87 14 +75 2 3 0 25 0 87 88 14 +76 2 3 0 26 0 14 88 15 +77 2 3 0 27 0 88 89 15 +78 2 3 0 28 0 16 15 89 +79 2 3 0 29 0 90 16 89 +80 2 3 0 30 0 90 17 16 +81 2 3 0 31 0 91 17 90 +82 2 3 0 32 0 91 18 17 +83 2 3 0 33 0 18 91 19 +84 2 3 0 34 0 19 91 92 +85 2 3 0 35 0 92 93 19 +86 2 3 0 36 0 93 20 19 +87 2 3 0 37 0 93 94 20 +88 2 3 0 38 0 94 21 20 +89 2 3 0 39 0 94 22 21 +90 2 3 0 40 0 95 22 94 +91 2 3 0 41 0 95 96 22 +92 2 3 0 42 0 96 23 22 +93 2 3 0 43 0 96 24 23 +94 2 3 0 44 0 96 97 24 +95 2 3 0 45 0 97 98 24 +96 2 3 0 46 0 24 98 25 +97 2 3 0 47 0 25 98 99 +98 2 3 0 48 0 25 99 26 +99 2 3 0 49 0 27 26 99 +100 2 3 0 50 0 100 27 99 +101 2 3 0 51 0 100 28 27 +102 2 3 0 52 0 101 28 100 +103 2 3 0 53 0 102 28 101 +104 2 3 0 54 0 102 29 28 +105 2 3 0 55 0 29 102 30 +106 2 3 0 56 0 103 30 102 +107 2 3 0 57 0 103 104 30 +108 2 3 0 58 0 30 104 31 +109 2 3 0 59 0 31 104 32 +110 2 3 0 60 0 105 32 104 +111 2 3 0 61 0 105 106 32 +112 2 3 0 62 0 33 32 106 +113 2 3 0 63 0 106 34 33 +114 2 3 0 64 0 34 106 107 +115 2 3 0 65 0 107 35 34 +116 2 3 0 66 0 35 107 108 +117 2 3 0 67 0 108 36 35 +118 2 3 0 68 0 108 109 36 +119 2 3 0 69 0 37 36 109 +120 2 3 0 70 0 109 110 37 +121 2 3 0 71 0 110 38 37 +122 2 3 0 72 0 110 111 38 +123 2 3 0 73 0 111 39 38 +124 2 3 0 74 0 111 112 39 +125 2 3 0 75 0 39 112 113 +126 2 3 0 76 0 113 40 39 +127 2 3 0 77 0 113 41 40 +128 2 3 0 78 0 114 41 113 +129 2 3 0 79 0 114 42 41 +130 2 3 0 80 0 115 42 114 +131 2 3 0 81 0 115 43 42 +132 2 3 0 82 0 116 43 115 +133 2 3 0 83 0 116 44 43 +134 2 3 0 84 0 116 45 44 +135 2 3 0 85 0 116 117 45 +136 2 3 0 86 0 117 46 45 +137 2 3 0 87 0 118 46 117 +138 2 3 0 88 0 118 47 46 +139 2 3 0 89 0 119 47 118 +140 2 3 0 90 0 119 48 47 +141 2 3 0 91 0 48 119 49 +142 2 3 0 92 0 120 49 119 +143 2 3 0 93 0 120 50 49 +144 2 3 0 94 0 120 121 50 +145 2 3 0 95 0 121 51 50 +146 2 3 0 96 0 121 122 51 +147 2 3 0 97 0 122 52 51 +148 2 3 0 98 0 122 123 52 +149 2 3 0 99 0 52 123 53 +150 2 3 0 100 0 123 124 53 +151 2 3 0 101 0 124 54 53 +152 2 3 0 102 0 125 54 124 +153 2 3 0 103 0 125 55 54 +154 2 3 0 104 0 126 55 125 +155 2 3 0 105 0 56 55 126 +156 2 3 0 106 0 127 56 126 +157 2 3 0 107 0 57 56 127 +158 2 3 0 108 0 128 57 127 +159 2 3 0 109 0 58 57 128 +160 2 3 0 110 0 59 58 128 +161 2 3 0 111 0 59 128 129 +162 2 3 0 112 0 130 59 129 +163 2 3 0 113 0 60 59 130 +164 2 3 0 114 0 60 130 61 +165 2 3 0 115 0 61 130 131 +166 2 3 0 116 0 132 61 131 +167 2 3 0 117 0 132 62 61 +168 2 3 0 118 0 62 132 63 +169 2 3 0 119 0 63 132 133 +170 2 3 0 120 0 63 133 134 +171 2 3 0 121 0 63 134 64 +172 2 3 0 122 0 64 134 65 +173 2 3 0 123 0 65 134 135 +174 2 3 0 124 0 136 65 135 +175 2 3 0 125 0 66 65 136 +176 2 3 0 126 0 137 66 136 +177 2 3 0 127 0 67 66 137 +178 2 3 0 128 0 137 138 67 +179 2 3 0 129 0 67 138 68 +180 2 3 0 130 0 68 138 139 +181 2 3 0 131 0 68 139 69 +182 2 3 0 132 0 139 140 69 +183 2 3 0 133 0 70 69 140 +184 2 3 0 134 0 70 140 141 +185 2 3 0 135 0 71 70 141 +186 2 3 0 136 0 142 71 141 +187 2 3 0 137 0 72 71 142 +188 2 3 0 138 0 142 143 72 +189 2 3 0 139 0 73 72 143 +190 2 3 0 140 0 73 143 144 +191 2 3 0 141 0 144 74 73 +192 2 3 0 142 0 144 145 74 +193 2 3 0 143 0 145 75 74 +194 2 3 0 144 0 145 146 75 +195 2 3 0 145 0 77 147 76 +196 2 3 0 146 0 76 147 78 +197 2 3 0 147 0 148 147 77 +198 2 3 0 148 0 147 149 78 +199 2 3 0 149 0 78 149 150 +200 2 3 0 150 0 79 78 150 +201 2 3 0 151 0 79 150 80 +202 2 3 0 152 0 80 150 151 +203 2 3 0 153 0 80 151 81 +204 2 3 0 154 0 81 151 152 +205 2 3 0 155 0 81 152 82 +206 2 3 0 156 0 82 152 153 +207 2 3 0 157 0 82 153 83 +208 2 3 0 158 0 83 153 154 +209 2 3 0 159 0 83 154 84 +210 2 3 0 160 0 84 154 155 +211 2 3 0 161 0 84 155 85 +212 2 3 0 162 0 155 156 85 +213 2 3 0 163 0 85 156 86 +214 2 3 0 164 0 156 157 86 +215 2 3 0 165 0 86 157 87 +216 2 3 0 166 0 87 157 158 +217 2 3 0 167 0 158 88 87 +218 2 3 0 168 0 88 158 159 +219 2 3 0 169 0 88 159 89 +220 2 3 0 170 0 89 159 90 +221 2 3 0 171 0 159 160 90 +222 2 3 0 172 0 160 161 90 +223 2 3 0 173 0 90 161 91 +224 2 3 0 174 0 161 92 91 +225 2 3 0 175 0 161 162 92 +226 2 3 0 176 0 162 163 92 +227 2 3 0 177 0 163 164 92 +228 2 3 0 178 0 92 164 93 +229 2 3 0 179 0 164 165 93 +230 2 3 0 180 0 94 93 165 +231 2 3 0 181 0 95 94 165 +232 2 3 0 182 0 165 166 95 +233 2 3 0 183 0 166 167 95 +234 2 3 0 184 0 96 95 167 +235 2 3 0 185 0 97 96 167 +236 2 3 0 186 0 167 168 97 +237 2 3 0 187 0 168 169 97 +238 2 3 0 188 0 97 169 98 +239 2 3 0 189 0 169 170 98 +240 2 3 0 190 0 98 170 99 +241 2 3 0 191 0 170 100 99 +242 2 3 0 192 0 170 171 100 +243 2 3 0 193 0 171 101 100 +244 2 3 0 194 0 171 172 101 +245 2 3 0 195 0 172 173 101 +246 2 3 0 196 0 101 173 102 +247 2 3 0 197 0 173 103 102 +248 2 3 0 198 0 173 174 103 +249 2 3 0 199 0 174 175 103 +250 2 3 0 200 0 104 103 175 +251 2 3 0 201 0 105 104 175 +252 2 3 0 202 0 175 176 105 +253 2 3 0 203 0 176 177 105 +254 2 3 0 204 0 105 177 106 +255 2 3 0 205 0 177 107 106 +256 2 3 0 206 0 107 177 178 +257 2 3 0 207 0 108 107 178 +258 2 3 0 208 0 108 178 179 +259 2 3 0 209 0 180 108 179 +260 2 3 0 210 0 108 180 109 +261 2 3 0 211 0 180 110 109 +262 2 3 0 212 0 110 180 181 +263 2 3 0 213 0 111 110 181 +264 2 3 0 214 0 111 181 182 +265 2 3 0 215 0 111 182 112 +266 2 3 0 216 0 182 183 112 +267 2 3 0 217 0 183 184 112 +268 2 3 0 218 0 113 112 184 +269 2 3 0 219 0 114 113 184 +270 2 3 0 220 0 114 184 185 +271 2 3 0 221 0 115 114 185 +272 2 3 0 222 0 115 185 186 +273 2 3 0 223 0 116 115 186 +274 2 3 0 224 0 116 186 187 +275 2 3 0 225 0 117 116 187 +276 2 3 0 226 0 117 187 188 +277 2 3 0 227 0 118 117 188 +278 2 3 0 228 0 118 188 189 +279 2 3 0 229 0 119 118 189 +280 2 3 0 230 0 119 189 190 +281 2 3 0 231 0 120 119 190 +282 2 3 0 232 0 120 190 191 +283 2 3 0 233 0 121 120 191 +284 2 3 0 234 0 121 191 122 +285 2 3 0 235 0 122 191 192 +286 2 3 0 236 0 122 192 193 +287 2 3 0 237 0 123 122 193 +288 2 3 0 238 0 123 193 194 +289 2 3 0 239 0 124 123 194 +290 2 3 0 240 0 124 194 195 +291 2 3 0 241 0 125 124 195 +292 2 3 0 242 0 125 195 126 +293 2 3 0 243 0 126 195 196 +294 2 3 0 244 0 126 196 197 +295 2 3 0 245 0 127 126 197 +296 2 3 0 246 0 198 127 197 +297 2 3 0 247 0 127 198 199 +298 2 3 0 248 0 128 127 199 +299 2 3 0 249 0 128 199 129 +300 2 3 0 250 0 129 199 200 +301 2 3 0 251 0 129 200 201 +302 2 3 0 252 0 130 129 201 +303 2 3 0 253 0 130 201 131 +304 2 3 0 254 0 202 131 201 +305 2 3 0 255 0 202 203 131 +306 2 3 0 256 0 204 131 203 +307 2 3 0 257 0 204 132 131 +308 2 3 0 258 0 204 133 132 +309 2 3 0 259 0 133 204 205 +310 2 3 0 260 0 205 206 133 +311 2 3 0 261 0 207 133 206 +312 2 3 0 262 0 207 134 133 +313 2 3 0 263 0 207 135 134 +314 2 3 0 264 0 207 208 135 +315 2 3 0 265 0 135 208 209 +316 2 3 0 266 0 210 135 209 +317 2 3 0 267 0 210 136 135 +318 2 3 0 268 0 136 210 211 +319 2 3 0 269 0 211 137 136 +320 2 3 0 270 0 137 211 212 +321 2 3 0 271 0 212 138 137 +322 2 3 0 272 0 212 139 138 +323 2 3 0 273 0 139 212 213 +324 2 3 0 274 0 140 139 213 +325 2 3 0 275 0 140 213 214 +326 2 3 0 276 0 140 214 215 +327 2 3 0 277 0 140 215 141 +328 2 3 0 278 0 215 216 141 +329 2 3 0 279 0 216 142 141 +330 2 3 0 280 0 217 142 216 +331 2 3 0 281 0 143 142 217 +332 2 3 0 282 0 217 218 143 +333 2 3 0 283 0 143 218 144 +334 2 3 0 284 0 218 219 144 +335 2 3 0 285 0 145 144 219 +336 2 3 0 286 0 220 145 219 +337 2 3 0 287 0 145 220 146 +338 2 3 0 288 0 220 221 146 +339 2 3 0 289 0 147 148 149 +340 2 3 0 290 0 148 223 222 +341 2 3 0 291 0 222 149 148 +342 2 3 0 292 0 222 224 149 +343 2 3 0 293 0 149 224 225 +344 2 3 0 294 0 149 225 150 +345 2 3 0 295 0 150 225 226 +346 2 3 0 296 0 150 226 151 +347 2 3 0 297 0 151 226 227 +348 2 3 0 298 0 151 227 152 +349 2 3 0 299 0 227 228 152 +350 2 3 0 300 0 152 228 229 +351 2 3 0 301 0 152 229 153 +352 2 3 0 302 0 153 229 230 +353 2 3 0 303 0 153 230 154 +354 2 3 0 304 0 230 155 154 +355 2 3 0 305 0 231 155 230 +356 2 3 0 306 0 231 232 155 +357 2 3 0 307 0 156 155 232 +358 2 3 0 308 0 233 156 232 +359 2 3 0 309 0 233 234 156 +360 2 3 0 310 0 234 157 156 +361 2 3 0 311 0 234 235 157 +362 2 3 0 312 0 158 157 235 +363 2 3 0 313 0 158 235 236 +364 2 3 0 314 0 159 158 236 +365 2 3 0 315 0 236 237 159 +366 2 3 0 316 0 159 237 160 +367 2 3 0 317 0 238 160 237 +368 2 3 0 318 0 238 239 160 +369 2 3 0 319 0 160 239 161 +370 2 3 0 320 0 161 239 162 +371 2 3 0 321 0 240 162 239 +372 2 3 0 322 0 162 240 163 +373 2 3 0 323 0 240 241 163 +374 2 3 0 324 0 163 241 242 +375 2 3 0 325 0 163 242 164 +376 2 3 0 326 0 242 243 164 +377 2 3 0 327 0 164 243 165 +378 2 3 0 328 0 243 166 165 +379 2 3 0 329 0 244 166 243 +380 2 3 0 330 0 166 244 167 +381 2 3 0 331 0 244 245 167 +382 2 3 0 332 0 168 167 245 +383 2 3 0 333 0 245 246 168 +384 2 3 0 334 0 246 169 168 +385 2 3 0 335 0 246 247 169 +386 2 3 0 336 0 247 248 169 +387 2 3 0 337 0 169 248 170 +388 2 3 0 338 0 248 171 170 +389 2 3 0 339 0 171 248 249 +390 2 3 0 340 0 249 250 171 +391 2 3 0 341 0 172 171 250 +392 2 3 0 342 0 251 172 250 +393 2 3 0 343 0 173 172 251 +394 2 3 0 344 0 251 252 173 +395 2 3 0 345 0 252 174 173 +396 2 3 0 346 0 253 174 252 +397 2 3 0 347 0 175 174 253 +398 2 3 0 348 0 254 175 253 +399 2 3 0 349 0 175 254 176 +400 2 3 0 350 0 254 255 176 +401 2 3 0 351 0 255 177 176 +402 2 3 0 352 0 255 256 177 +403 2 3 0 353 0 178 177 256 +404 2 3 0 354 0 178 256 179 +405 2 3 0 355 0 256 257 179 +406 2 3 0 356 0 258 179 257 +407 2 3 0 357 0 180 179 258 +408 2 3 0 358 0 181 180 258 +409 2 3 0 359 0 259 181 258 +410 2 3 0 360 0 260 181 259 +411 2 3 0 361 0 260 182 181 +412 2 3 0 362 0 182 260 183 +413 2 3 0 363 0 261 183 260 +414 2 3 0 364 0 262 183 261 +415 2 3 0 365 0 262 263 183 +416 2 3 0 366 0 184 183 263 +417 2 3 0 367 0 184 263 264 +418 2 3 0 368 0 185 184 264 +419 2 3 0 369 0 264 265 185 +420 2 3 0 370 0 265 186 185 +421 2 3 0 371 0 186 265 266 +422 2 3 0 372 0 266 267 186 +423 2 3 0 373 0 267 187 186 +424 2 3 0 374 0 267 188 187 +425 2 3 0 375 0 267 268 188 +426 2 3 0 376 0 188 268 269 +427 2 3 0 377 0 188 269 189 +428 2 3 0 378 0 189 269 270 +429 2 3 0 379 0 270 271 189 +430 2 3 0 380 0 271 190 189 +431 2 3 0 381 0 272 190 271 +432 2 3 0 382 0 190 272 273 +433 2 3 0 383 0 273 191 190 +434 2 3 0 384 0 191 273 192 +435 2 3 0 385 0 192 273 274 +436 2 3 0 386 0 275 192 274 +437 2 3 0 387 0 192 275 193 +438 2 3 0 388 0 276 193 275 +439 2 3 0 389 0 194 193 276 +440 2 3 0 390 0 277 194 276 +441 2 3 0 391 0 194 277 278 +442 2 3 0 392 0 195 194 278 +443 2 3 0 393 0 196 195 278 +444 2 3 0 394 0 196 278 279 +445 2 3 0 395 0 279 197 196 +446 2 3 0 396 0 279 280 197 +447 2 3 0 397 0 198 197 280 +448 2 3 0 398 0 280 281 198 +449 2 3 0 399 0 198 281 282 +450 2 3 0 400 0 282 199 198 +451 2 3 0 401 0 200 199 282 +452 2 3 0 402 0 200 282 283 +453 2 3 0 403 0 202 200 283 +454 2 3 0 404 0 200 202 201 +455 2 3 0 405 0 202 283 284 +456 2 3 0 406 0 285 202 284 +457 2 3 0 407 0 285 203 202 +458 2 3 0 408 0 203 285 286 +459 2 3 0 409 0 203 286 205 +460 2 3 0 410 0 204 203 205 +461 2 3 0 411 0 205 286 287 +462 2 3 0 412 0 287 206 205 +463 2 3 0 413 0 206 287 288 +464 2 3 0 414 0 206 288 208 +465 2 3 0 415 0 207 206 208 +466 2 3 0 416 0 208 288 289 +467 2 3 0 417 0 208 289 209 +468 2 3 0 418 0 209 289 290 +469 2 3 0 419 0 290 291 209 +470 2 3 0 420 0 291 210 209 +471 2 3 0 421 0 211 210 291 +472 2 3 0 422 0 211 291 292 +473 2 3 0 423 0 212 211 292 +474 2 3 0 424 0 213 212 292 +475 2 3 0 425 0 293 213 292 +476 2 3 0 426 0 213 293 214 +477 2 3 0 427 0 293 294 214 +478 2 3 0 428 0 295 214 294 +479 2 3 0 429 0 295 296 214 +480 2 3 0 430 0 215 214 296 +481 2 3 0 431 0 215 296 216 +482 2 3 0 432 0 296 297 216 +483 2 3 0 433 0 217 216 297 +484 2 3 0 434 0 298 217 297 +485 2 3 0 435 0 217 298 299 +486 2 3 0 436 0 299 218 217 +487 2 3 0 437 0 218 299 300 +488 2 3 0 438 0 218 300 219 +489 2 3 0 439 0 219 300 220 +490 2 3 0 440 0 220 300 301 +491 2 3 0 441 0 220 301 221 +492 2 3 0 442 0 302 221 301 +493 2 3 0 443 0 222 223 303 +494 2 3 0 444 0 222 303 224 +495 2 3 0 445 0 303 223 304 +496 2 3 0 446 0 303 305 224 +497 2 3 0 447 0 224 305 306 +498 2 3 0 448 0 224 306 225 +499 2 3 0 449 0 225 306 307 +500 2 3 0 450 0 225 307 226 +501 2 3 0 451 0 226 307 308 +502 2 3 0 452 0 226 308 227 +503 2 3 0 453 0 227 308 228 +504 2 3 0 454 0 308 309 228 +505 2 3 0 455 0 309 310 228 +506 2 3 0 456 0 310 311 228 +507 2 3 0 457 0 228 311 229 +508 2 3 0 458 0 229 311 230 +509 2 3 0 459 0 311 312 230 +510 2 3 0 460 0 230 312 231 +511 2 3 0 461 0 312 313 231 +512 2 3 0 462 0 231 313 314 +513 2 3 0 463 0 231 314 232 +514 2 3 0 464 0 232 314 233 +515 2 3 0 465 0 314 315 233 +516 2 3 0 466 0 233 315 316 +517 2 3 0 467 0 233 316 234 +518 2 3 0 468 0 234 316 317 +519 2 3 0 469 0 234 317 235 +520 2 3 0 470 0 317 236 235 +521 2 3 0 471 0 317 318 236 +522 2 3 0 472 0 318 319 236 +523 2 3 0 473 0 319 237 236 +524 2 3 0 474 0 319 320 237 +525 2 3 0 475 0 238 237 320 +526 2 3 0 476 0 321 238 320 +527 2 3 0 477 0 238 321 322 +528 2 3 0 478 0 238 322 239 +529 2 3 0 479 0 240 239 322 +530 2 3 0 480 0 323 240 322 +531 2 3 0 481 0 240 323 241 +532 2 3 0 482 0 324 241 323 +533 2 3 0 483 0 242 241 324 +534 2 3 0 484 0 325 242 324 +535 2 3 0 485 0 242 325 326 +536 2 3 0 486 0 242 326 243 +537 2 3 0 487 0 244 243 326 +538 2 3 0 488 0 327 244 326 +539 2 3 0 489 0 327 245 244 +540 2 3 0 490 0 328 245 327 +541 2 3 0 491 0 245 328 246 +542 2 3 0 492 0 328 329 246 +543 2 3 0 493 0 329 247 246 +544 2 3 0 494 0 329 330 247 +545 2 3 0 495 0 249 247 330 +546 2 3 0 496 0 249 248 247 +547 2 3 0 497 0 331 249 330 +548 2 3 0 498 0 249 331 250 +549 2 3 0 499 0 331 332 250 +550 2 3 0 500 0 251 250 332 +551 2 3 0 501 0 333 251 332 +552 2 3 0 502 0 333 252 251 +553 2 3 0 503 0 334 252 333 +554 2 3 0 504 0 253 252 334 +555 2 3 0 505 0 335 253 334 +556 2 3 0 506 0 335 254 253 +557 2 3 0 507 0 335 336 254 +558 2 3 0 508 0 254 336 255 +559 2 3 0 509 0 336 337 255 +560 2 3 0 510 0 256 255 337 +561 2 3 0 511 0 256 337 338 +562 2 3 0 512 0 338 257 256 +563 2 3 0 513 0 339 257 338 +564 2 3 0 514 0 339 340 257 +565 2 3 0 515 0 258 257 340 +566 2 3 0 516 0 259 258 340 +567 2 3 0 517 0 259 340 341 +568 2 3 0 518 0 342 259 341 +569 2 3 0 519 0 342 260 259 +570 2 3 0 520 0 261 260 342 +571 2 3 0 521 0 261 342 343 +572 2 3 0 522 0 261 343 344 +573 2 3 0 523 0 262 261 344 +574 2 3 0 524 0 344 345 262 +575 2 3 0 525 0 345 263 262 +576 2 3 0 526 0 346 263 345 +577 2 3 0 527 0 346 347 263 +578 2 3 0 528 0 263 347 264 +579 2 3 0 529 0 265 264 347 +580 2 3 0 530 0 265 347 348 +581 2 3 0 531 0 348 266 265 +582 2 3 0 532 0 266 348 349 +583 2 3 0 533 0 350 266 349 +584 2 3 0 534 0 267 266 350 +585 2 3 0 535 0 268 267 350 +586 2 3 0 536 0 268 350 351 +587 2 3 0 537 0 268 351 352 +588 2 3 0 538 0 269 268 352 +589 2 3 0 539 0 270 269 352 +590 2 3 0 540 0 270 352 353 +591 2 3 0 541 0 270 353 354 +592 2 3 0 542 0 271 270 354 +593 2 3 0 543 0 272 271 354 +594 2 3 0 544 0 272 354 355 +595 2 3 0 545 0 272 355 356 +596 2 3 0 546 0 273 272 356 +597 2 3 0 547 0 273 356 274 +598 2 3 0 548 0 274 356 357 +599 2 3 0 549 0 357 358 274 +600 2 3 0 550 0 358 275 274 +601 2 3 0 551 0 359 275 358 +602 2 3 0 552 0 275 359 276 +603 2 3 0 553 0 276 359 360 +604 2 3 0 554 0 360 277 276 +605 2 3 0 555 0 277 360 361 +606 2 3 0 556 0 362 277 361 +607 2 3 0 557 0 278 277 362 +608 2 3 0 558 0 278 362 279 +609 2 3 0 559 0 279 362 363 +610 2 3 0 560 0 279 363 280 +611 2 3 0 561 0 280 363 364 +612 2 3 0 562 0 281 280 364 +613 2 3 0 563 0 281 364 365 +614 2 3 0 564 0 365 366 281 +615 2 3 0 565 0 366 282 281 +616 2 3 0 566 0 282 366 283 +617 2 3 0 567 0 283 366 367 +618 2 3 0 568 0 283 367 284 +619 2 3 0 569 0 284 367 368 +620 2 3 0 570 0 368 285 284 +621 2 3 0 571 0 368 369 285 +622 2 3 0 572 0 285 369 286 +623 2 3 0 573 0 370 286 369 +624 2 3 0 574 0 370 371 286 +625 2 3 0 575 0 286 371 287 +626 2 3 0 576 0 287 371 372 +627 2 3 0 577 0 287 372 288 +628 2 3 0 578 0 373 288 372 +629 2 3 0 579 0 373 374 288 +630 2 3 0 580 0 288 374 289 +631 2 3 0 581 0 289 374 375 +632 2 3 0 582 0 289 375 290 +633 2 3 0 583 0 376 290 375 +634 2 3 0 584 0 376 377 290 +635 2 3 0 585 0 377 378 290 +636 2 3 0 586 0 378 291 290 +637 2 3 0 587 0 292 291 378 +638 2 3 0 588 0 292 378 293 +639 2 3 0 589 0 378 379 293 +640 2 3 0 590 0 293 379 294 +641 2 3 0 591 0 379 380 294 +642 2 3 0 592 0 380 381 294 +643 2 3 0 593 0 294 381 295 +644 2 3 0 594 0 295 381 382 +645 2 3 0 595 0 295 382 383 +646 2 3 0 596 0 296 295 383 +647 2 3 0 597 0 296 383 297 +648 2 3 0 598 0 297 383 298 +649 2 3 0 599 0 383 384 298 +650 2 3 0 600 0 385 298 384 +651 2 3 0 601 0 385 386 298 +652 2 3 0 602 0 298 386 299 +653 2 3 0 603 0 387 299 386 +654 2 3 0 604 0 387 300 299 +655 2 3 0 605 0 300 387 301 +656 2 3 0 606 0 387 388 301 +657 2 3 0 607 0 388 302 301 +658 2 3 0 608 0 389 302 388 +659 2 3 0 609 0 303 304 390 +660 2 3 0 610 0 303 390 391 +661 2 3 0 611 0 391 305 303 +662 2 3 0 612 0 304 392 390 +663 2 3 0 613 0 305 391 393 +664 2 3 0 614 0 305 393 306 +665 2 3 0 615 0 393 394 306 +666 2 3 0 616 0 306 394 307 +667 2 3 0 617 0 307 394 308 +668 2 3 0 618 0 394 395 308 +669 2 3 0 619 0 309 308 395 +670 2 3 0 620 0 396 309 395 +671 2 3 0 621 0 309 396 397 +672 2 3 0 622 0 309 397 310 +673 2 3 0 623 0 310 397 398 +674 2 3 0 624 0 398 311 310 +675 2 3 0 625 0 311 398 312 +676 2 3 0 626 0 398 399 312 +677 2 3 0 627 0 312 399 313 +678 2 3 0 628 0 399 400 313 +679 2 3 0 629 0 401 313 400 +680 2 3 0 630 0 401 314 313 +681 2 3 0 631 0 401 402 314 +682 2 3 0 632 0 314 402 315 +683 2 3 0 633 0 402 403 315 +684 2 3 0 634 0 316 315 403 +685 2 3 0 635 0 404 316 403 +686 2 3 0 636 0 316 404 405 +687 2 3 0 637 0 316 405 317 +688 2 3 0 638 0 318 317 405 +689 2 3 0 639 0 406 318 405 +690 2 3 0 640 0 319 318 406 +691 2 3 0 641 0 407 319 406 +692 2 3 0 642 0 319 407 320 +693 2 3 0 643 0 407 408 320 +694 2 3 0 644 0 408 409 320 +695 2 3 0 645 0 321 320 409 +696 2 3 0 646 0 410 321 409 +697 2 3 0 647 0 322 321 410 +698 2 3 0 648 0 411 322 410 +699 2 3 0 649 0 323 322 411 +700 2 3 0 650 0 323 411 412 +701 2 3 0 651 0 324 323 412 +702 2 3 0 652 0 324 412 413 +703 2 3 0 653 0 414 324 413 +704 2 3 0 654 0 325 324 414 +705 2 3 0 655 0 415 325 414 +706 2 3 0 656 0 325 415 326 +707 2 3 0 657 0 415 416 326 +708 2 3 0 658 0 327 326 416 +709 2 3 0 659 0 327 416 417 +710 2 3 0 660 0 328 327 417 +711 2 3 0 661 0 328 417 418 +712 2 3 0 662 0 419 328 418 +713 2 3 0 663 0 328 419 329 +714 2 3 0 664 0 419 420 329 +715 2 3 0 665 0 329 420 330 +716 2 3 0 666 0 330 420 421 +717 2 3 0 667 0 422 330 421 +718 2 3 0 668 0 331 330 422 +719 2 3 0 669 0 422 423 331 +720 2 3 0 670 0 331 423 332 +721 2 3 0 671 0 332 423 424 +722 2 3 0 672 0 425 332 424 +723 2 3 0 673 0 333 332 425 +724 2 3 0 674 0 425 426 333 +725 2 3 0 675 0 334 333 426 +726 2 3 0 676 0 334 426 427 +727 2 3 0 677 0 428 334 427 +728 2 3 0 678 0 335 334 428 +729 2 3 0 679 0 428 429 335 +730 2 3 0 680 0 335 429 336 +731 2 3 0 681 0 429 430 336 +732 2 3 0 682 0 337 336 430 +733 2 3 0 683 0 431 337 430 +734 2 3 0 684 0 338 337 431 +735 2 3 0 685 0 431 339 338 +736 2 3 0 686 0 431 432 339 +737 2 3 0 687 0 339 432 433 +738 2 3 0 688 0 339 433 340 +739 2 3 0 689 0 340 433 341 +740 2 3 0 690 0 341 433 434 +741 2 3 0 691 0 434 435 341 +742 2 3 0 692 0 342 341 435 +743 2 3 0 693 0 342 435 436 +744 2 3 0 694 0 343 342 436 +745 2 3 0 695 0 343 436 437 +746 2 3 0 696 0 344 343 437 +747 2 3 0 697 0 437 438 344 +748 2 3 0 698 0 438 439 344 +749 2 3 0 699 0 344 439 345 +750 2 3 0 700 0 439 440 345 +751 2 3 0 701 0 440 346 345 +752 2 3 0 702 0 441 346 440 +753 2 3 0 703 0 441 347 346 +754 2 3 0 704 0 348 347 441 +755 2 3 0 705 0 348 441 442 +756 2 3 0 706 0 348 442 349 +757 2 3 0 707 0 349 442 443 +758 2 3 0 708 0 444 349 443 +759 2 3 0 709 0 349 444 350 +760 2 3 0 710 0 350 444 445 +761 2 3 0 711 0 351 350 445 +762 2 3 0 712 0 351 445 446 +763 2 3 0 713 0 352 351 446 +764 2 3 0 714 0 352 446 447 +765 2 3 0 715 0 353 352 447 +766 2 3 0 716 0 447 448 353 +767 2 3 0 717 0 448 354 353 +768 2 3 0 718 0 354 448 449 +769 2 3 0 719 0 355 354 449 +770 2 3 0 720 0 355 449 450 +771 2 3 0 721 0 356 355 450 +772 2 3 0 722 0 356 450 357 +773 2 3 0 723 0 357 450 451 +774 2 3 0 724 0 357 451 452 +775 2 3 0 725 0 357 452 453 +776 2 3 0 726 0 358 357 453 +777 2 3 0 727 0 359 358 453 +778 2 3 0 728 0 359 453 454 +779 2 3 0 729 0 359 454 360 +780 2 3 0 730 0 360 454 455 +781 2 3 0 731 0 360 455 456 +782 2 3 0 732 0 360 456 361 +783 2 3 0 733 0 361 456 457 +784 2 3 0 734 0 458 361 457 +785 2 3 0 735 0 362 361 458 +786 2 3 0 736 0 362 458 363 +787 2 3 0 737 0 363 458 459 +788 2 3 0 738 0 363 459 364 +789 2 3 0 739 0 364 459 460 +790 2 3 0 740 0 364 460 461 +791 2 3 0 741 0 365 364 461 +792 2 3 0 742 0 365 461 462 +793 2 3 0 743 0 462 366 365 +794 2 3 0 744 0 462 463 366 +795 2 3 0 745 0 366 463 367 +796 2 3 0 746 0 367 463 464 +797 2 3 0 747 0 367 464 368 +798 2 3 0 748 0 465 368 464 +799 2 3 0 749 0 465 466 368 +800 2 3 0 750 0 466 369 368 +801 2 3 0 751 0 466 370 369 +802 2 3 0 752 0 370 466 467 +803 2 3 0 753 0 371 370 467 +804 2 3 0 754 0 371 467 468 +805 2 3 0 755 0 371 468 372 +806 2 3 0 756 0 372 468 469 +807 2 3 0 757 0 372 469 373 +808 2 3 0 758 0 470 373 469 +809 2 3 0 759 0 374 373 470 +810 2 3 0 760 0 374 470 471 +811 2 3 0 761 0 374 471 375 +812 2 3 0 762 0 472 375 471 +813 2 3 0 763 0 472 376 375 +814 2 3 0 764 0 473 376 472 +815 2 3 0 765 0 377 376 473 +816 2 3 0 766 0 377 473 474 +817 2 3 0 767 0 378 377 474 +818 2 3 0 768 0 378 474 379 +819 2 3 0 769 0 380 379 474 +820 2 3 0 770 0 475 380 474 +821 2 3 0 771 0 380 475 476 +822 2 3 0 772 0 380 476 381 +823 2 3 0 773 0 381 476 477 +824 2 3 0 774 0 381 477 382 +825 2 3 0 775 0 382 477 478 +826 2 3 0 776 0 383 382 478 +827 2 3 0 777 0 383 478 384 +828 2 3 0 778 0 384 478 479 +829 2 3 0 779 0 384 479 385 +830 2 3 0 780 0 385 479 480 +831 2 3 0 781 0 385 480 481 +832 2 3 0 782 0 386 385 481 +833 2 3 0 783 0 386 481 387 +834 2 3 0 784 0 387 481 482 +835 2 3 0 785 0 387 482 388 +836 2 3 0 786 0 388 482 483 +837 2 3 0 787 0 483 389 388 +838 2 3 0 788 0 389 483 484 +839 2 3 0 789 0 485 389 484 +840 2 3 0 790 0 390 392 486 +841 2 3 0 791 0 390 486 391 +842 2 3 0 792 0 487 391 486 +843 2 3 0 793 0 391 487 488 +844 2 3 0 794 0 391 488 393 +845 2 3 0 795 0 489 486 392 +846 2 3 0 796 0 490 393 488 +847 2 3 0 797 0 490 394 393 +848 2 3 0 798 0 394 490 395 +849 2 3 0 799 0 491 395 490 +850 2 3 0 800 0 395 491 396 +851 2 3 0 801 0 396 491 492 +852 2 3 0 802 0 396 492 397 +853 2 3 0 803 0 397 492 493 +854 2 3 0 804 0 397 493 494 +855 2 3 0 805 0 397 494 398 +856 2 3 0 806 0 398 494 495 +857 2 3 0 807 0 398 495 399 +858 2 3 0 808 0 399 495 400 +859 2 3 0 809 0 495 496 400 +860 2 3 0 810 0 400 496 401 +861 2 3 0 811 0 496 497 401 +862 2 3 0 812 0 402 401 497 +863 2 3 0 813 0 498 402 497 +864 2 3 0 814 0 498 403 402 +865 2 3 0 815 0 403 498 499 +866 2 3 0 816 0 403 499 404 +867 2 3 0 817 0 500 404 499 +868 2 3 0 818 0 405 404 500 +869 2 3 0 819 0 406 405 500 +870 2 3 0 820 0 500 501 406 +871 2 3 0 821 0 501 502 406 +872 2 3 0 822 0 406 502 407 +873 2 3 0 823 0 502 408 407 +874 2 3 0 824 0 502 503 408 +875 2 3 0 825 0 503 504 408 +876 2 3 0 826 0 408 504 409 +877 2 3 0 827 0 504 505 409 +878 2 3 0 828 0 409 505 506 +879 2 3 0 829 0 409 506 410 +880 2 3 0 830 0 410 506 507 +881 2 3 0 831 0 410 507 411 +882 2 3 0 832 0 412 411 507 +883 2 3 0 833 0 412 507 508 +884 2 3 0 834 0 413 412 508 +885 2 3 0 835 0 509 413 508 +886 2 3 0 836 0 509 510 413 +887 2 3 0 837 0 413 510 414 +888 2 3 0 838 0 510 511 414 +889 2 3 0 839 0 512 414 511 +890 2 3 0 840 0 512 415 414 +891 2 3 0 841 0 513 415 512 +892 2 3 0 842 0 513 416 415 +893 2 3 0 843 0 417 416 513 +894 2 3 0 844 0 513 514 417 +895 2 3 0 845 0 514 418 417 +896 2 3 0 846 0 515 418 514 +897 2 3 0 847 0 516 418 515 +898 2 3 0 848 0 516 419 418 +899 2 3 0 849 0 516 420 419 +900 2 3 0 850 0 516 517 420 +901 2 3 0 851 0 517 421 420 +902 2 3 0 852 0 517 518 421 +903 2 3 0 853 0 421 518 519 +904 2 3 0 854 0 421 519 422 +905 2 3 0 855 0 519 423 422 +906 2 3 0 856 0 519 520 423 +907 2 3 0 857 0 520 424 423 +908 2 3 0 858 0 521 424 520 +909 2 3 0 859 0 424 521 522 +910 2 3 0 860 0 424 522 425 +911 2 3 0 861 0 522 426 425 +912 2 3 0 862 0 426 522 523 +913 2 3 0 863 0 427 426 523 +914 2 3 0 864 0 523 524 427 +915 2 3 0 865 0 427 524 525 +916 2 3 0 866 0 427 525 428 +917 2 3 0 867 0 525 429 428 +918 2 3 0 868 0 525 526 429 +919 2 3 0 869 0 526 430 429 +920 2 3 0 870 0 527 430 526 +921 2 3 0 871 0 431 430 527 +922 2 3 0 872 0 527 528 431 +923 2 3 0 873 0 528 432 431 +924 2 3 0 874 0 528 529 432 +925 2 3 0 875 0 433 432 529 +926 2 3 0 876 0 433 529 434 +927 2 3 0 877 0 434 529 530 +928 2 3 0 878 0 434 530 531 +929 2 3 0 879 0 532 434 531 +930 2 3 0 880 0 434 532 435 +931 2 3 0 881 0 532 436 435 +932 2 3 0 882 0 532 533 436 +933 2 3 0 883 0 437 436 533 +934 2 3 0 884 0 437 533 534 +935 2 3 0 885 0 438 437 534 +936 2 3 0 886 0 438 534 535 +937 2 3 0 887 0 536 438 535 +938 2 3 0 888 0 438 536 439 +939 2 3 0 889 0 536 440 439 +940 2 3 0 890 0 440 536 537 +941 2 3 0 891 0 538 440 537 +942 2 3 0 892 0 441 440 538 +943 2 3 0 893 0 441 538 442 +944 2 3 0 894 0 442 538 539 +945 2 3 0 895 0 442 539 443 +946 2 3 0 896 0 443 539 540 +947 2 3 0 897 0 443 540 541 +948 2 3 0 898 0 542 443 541 +949 2 3 0 899 0 444 443 542 +950 2 3 0 900 0 445 444 542 +951 2 3 0 901 0 445 542 543 +952 2 3 0 902 0 446 445 543 +953 2 3 0 903 0 446 543 544 +954 2 3 0 904 0 447 446 544 +955 2 3 0 905 0 447 544 545 +956 2 3 0 906 0 448 447 545 +957 2 3 0 907 0 448 545 546 +958 2 3 0 908 0 449 448 546 +959 2 3 0 909 0 449 546 547 +960 2 3 0 910 0 450 449 547 +961 2 3 0 911 0 450 547 451 +962 2 3 0 912 0 451 547 548 +963 2 3 0 913 0 451 548 549 +964 2 3 0 914 0 549 452 451 +965 2 3 0 915 0 549 550 452 +966 2 3 0 916 0 453 452 550 +967 2 3 0 917 0 453 550 551 +968 2 3 0 918 0 454 453 551 +969 2 3 0 919 0 454 551 455 +970 2 3 0 920 0 455 551 552 +971 2 3 0 921 0 552 456 455 +972 2 3 0 922 0 552 553 456 +973 2 3 0 923 0 456 553 457 +974 2 3 0 924 0 554 457 553 +975 2 3 0 925 0 555 457 554 +976 2 3 0 926 0 458 457 555 +977 2 3 0 927 0 458 555 459 +978 2 3 0 928 0 459 555 556 +979 2 3 0 929 0 459 556 460 +980 2 3 0 930 0 557 460 556 +981 2 3 0 931 0 557 461 460 +982 2 3 0 932 0 557 558 461 +983 2 3 0 933 0 461 558 559 +984 2 3 0 934 0 462 461 559 +985 2 3 0 935 0 559 463 462 +986 2 3 0 936 0 559 560 463 +987 2 3 0 937 0 463 560 464 +988 2 3 0 938 0 561 464 560 +989 2 3 0 939 0 561 465 464 +990 2 3 0 940 0 465 561 562 +991 2 3 0 941 0 466 465 562 +992 2 3 0 942 0 466 562 563 +993 2 3 0 943 0 466 563 467 +994 2 3 0 944 0 564 467 563 +995 2 3 0 945 0 564 468 467 +996 2 3 0 946 0 564 469 468 +997 2 3 0 947 0 469 564 565 +998 2 3 0 948 0 565 470 469 +999 2 3 0 949 0 470 565 566 +1000 2 3 0 950 0 470 566 567 +1001 2 3 0 951 0 471 470 567 +1002 2 3 0 952 0 471 567 472 +1003 2 3 0 953 0 472 567 568 +1004 2 3 0 954 0 472 568 569 +1005 2 3 0 955 0 569 473 472 +1006 2 3 0 956 0 570 473 569 +1007 2 3 0 957 0 473 570 475 +1008 2 3 0 958 0 474 473 475 +1009 2 3 0 959 0 570 571 475 +1010 2 3 0 960 0 475 571 476 +1011 2 3 0 961 0 476 571 572 +1012 2 3 0 962 0 476 572 477 +1013 2 3 0 963 0 573 477 572 +1014 2 3 0 964 0 573 574 477 +1015 2 3 0 965 0 477 574 478 +1016 2 3 0 966 0 478 574 479 +1017 2 3 0 967 0 574 575 479 +1018 2 3 0 968 0 479 575 480 +1019 2 3 0 969 0 575 576 480 +1020 2 3 0 970 0 480 576 577 +1021 2 3 0 971 0 480 577 482 +1022 2 3 0 972 0 481 480 482 +1023 2 3 0 973 0 578 482 577 +1024 2 3 0 974 0 578 483 482 +1025 2 3 0 975 0 483 578 484 +1026 2 3 0 976 0 578 579 484 +1027 2 3 0 977 0 485 484 579 +1028 2 3 0 978 0 579 580 485 +1029 2 3 0 979 0 581 486 489 +1030 2 3 0 980 0 486 581 487 +1031 2 3 0 981 0 581 582 487 +1032 2 3 0 982 0 487 582 583 +1033 2 3 0 983 0 487 583 488 +1034 2 3 0 984 0 488 583 584 +1035 2 3 0 985 0 488 584 585 +1036 2 3 0 986 0 585 490 488 +1037 2 3 0 987 0 489 586 581 +1038 2 3 0 988 0 490 585 587 +1039 2 3 0 989 0 491 490 587 +1040 2 3 0 990 0 588 491 587 +1041 2 3 0 991 0 491 588 492 +1042 2 3 0 992 0 588 589 492 +1043 2 3 0 993 0 492 589 590 +1044 2 3 0 994 0 492 590 493 +1045 2 3 0 995 0 590 591 493 +1046 2 3 0 996 0 493 591 592 +1047 2 3 0 997 0 592 494 493 +1048 2 3 0 998 0 592 495 494 +1049 2 3 0 999 0 495 592 496 +1050 2 3 0 1000 0 592 593 496 +1051 2 3 0 1001 0 497 496 593 +1052 2 3 0 1002 0 594 497 593 +1053 2 3 0 1003 0 595 497 594 +1054 2 3 0 1004 0 595 498 497 +1055 2 3 0 1005 0 499 498 595 +1056 2 3 0 1006 0 596 499 595 +1057 2 3 0 1007 0 500 499 596 +1058 2 3 0 1008 0 501 500 596 +1059 2 3 0 1009 0 596 597 501 +1060 2 3 0 1010 0 503 501 597 +1061 2 3 0 1011 0 502 501 503 +1062 2 3 0 1012 0 597 598 503 +1063 2 3 0 1013 0 598 599 503 +1064 2 3 0 1014 0 503 599 504 +1065 2 3 0 1015 0 599 600 504 +1066 2 3 0 1016 0 504 600 601 +1067 2 3 0 1017 0 504 601 505 +1068 2 3 0 1018 0 602 505 601 +1069 2 3 0 1019 0 602 506 505 +1070 2 3 0 1020 0 507 506 602 +1071 2 3 0 1021 0 508 507 602 +1072 2 3 0 1022 0 602 603 508 +1073 2 3 0 1023 0 603 604 508 +1074 2 3 0 1024 0 509 508 604 +1075 2 3 0 1025 0 605 509 604 +1076 2 3 0 1026 0 510 509 605 +1077 2 3 0 1027 0 606 510 605 +1078 2 3 0 1028 0 606 511 510 +1079 2 3 0 1029 0 607 511 606 +1080 2 3 0 1030 0 607 512 511 +1081 2 3 0 1031 0 513 512 607 +1082 2 3 0 1032 0 514 513 607 +1083 2 3 0 1033 0 514 607 608 +1084 2 3 0 1034 0 609 514 608 +1085 2 3 0 1035 0 515 514 609 +1086 2 3 0 1036 0 609 610 515 +1087 2 3 0 1037 0 515 610 516 +1088 2 3 0 1038 0 610 517 516 +1089 2 3 0 1039 0 610 611 517 +1090 2 3 0 1040 0 611 612 517 +1091 2 3 0 1041 0 517 612 518 +1092 2 3 0 1042 0 612 613 518 +1093 2 3 0 1043 0 519 518 613 +1094 2 3 0 1044 0 520 519 613 +1095 2 3 0 1045 0 613 614 520 +1096 2 3 0 1046 0 614 615 520 +1097 2 3 0 1047 0 521 520 615 +1098 2 3 0 1048 0 616 521 615 +1099 2 3 0 1049 0 522 521 616 +1100 2 3 0 1050 0 523 522 616 +1101 2 3 0 1051 0 523 616 617 +1102 2 3 0 1052 0 618 523 617 +1103 2 3 0 1053 0 523 618 524 +1104 2 3 0 1054 0 618 619 524 +1105 2 3 0 1055 0 525 524 619 +1106 2 3 0 1056 0 526 525 619 +1107 2 3 0 1057 0 526 619 620 +1108 2 3 0 1058 0 621 526 620 +1109 2 3 0 1059 0 527 526 621 +1110 2 3 0 1060 0 621 528 527 +1111 2 3 0 1061 0 621 622 528 +1112 2 3 0 1062 0 623 528 622 +1113 2 3 0 1063 0 528 623 529 +1114 2 3 0 1064 0 529 623 530 +1115 2 3 0 1065 0 530 623 624 +1116 2 3 0 1066 0 530 624 625 +1117 2 3 0 1067 0 530 625 626 +1118 2 3 0 1068 0 531 530 626 +1119 2 3 0 1069 0 531 626 627 +1120 2 3 0 1070 0 628 531 627 +1121 2 3 0 1071 0 533 531 628 +1122 2 3 0 1072 0 533 532 531 +1123 2 3 0 1073 0 628 534 533 +1124 2 3 0 1074 0 628 629 534 +1125 2 3 0 1075 0 535 534 629 +1126 2 3 0 1076 0 535 629 630 +1127 2 3 0 1077 0 535 630 631 +1128 2 3 0 1078 0 632 535 631 +1129 2 3 0 1079 0 536 535 632 +1130 2 3 0 1080 0 632 537 536 +1131 2 3 0 1081 0 632 633 537 +1132 2 3 0 1082 0 634 537 633 +1133 2 3 0 1083 0 539 537 634 +1134 2 3 0 1084 0 539 538 537 +1135 2 3 0 1085 0 539 634 540 +1136 2 3 0 1086 0 540 634 635 +1137 2 3 0 1087 0 540 635 636 +1138 2 3 0 1088 0 540 636 637 +1139 2 3 0 1089 0 541 540 637 +1140 2 3 0 1090 0 541 637 638 +1141 2 3 0 1091 0 639 541 638 +1142 2 3 0 1092 0 543 541 639 +1143 2 3 0 1093 0 543 542 541 +1144 2 3 0 1094 0 544 543 639 +1145 2 3 0 1095 0 544 639 640 +1146 2 3 0 1096 0 545 544 640 +1147 2 3 0 1097 0 545 640 641 +1148 2 3 0 1098 0 641 642 545 +1149 2 3 0 1099 0 642 546 545 +1150 2 3 0 1100 0 642 547 546 +1151 2 3 0 1101 0 642 548 547 +1152 2 3 0 1102 0 548 642 643 +1153 2 3 0 1103 0 548 643 644 +1154 2 3 0 1104 0 548 644 645 +1155 2 3 0 1105 0 549 548 645 +1156 2 3 0 1106 0 549 645 646 +1157 2 3 0 1107 0 550 549 646 +1158 2 3 0 1108 0 646 551 550 +1159 2 3 0 1109 0 646 647 551 +1160 2 3 0 1110 0 551 647 552 +1161 2 3 0 1111 0 552 647 648 +1162 2 3 0 1112 0 552 648 649 +1163 2 3 0 1113 0 553 552 649 +1164 2 3 0 1114 0 553 649 650 +1165 2 3 0 1115 0 650 554 553 +1166 2 3 0 1116 0 554 650 651 +1167 2 3 0 1117 0 556 554 651 +1168 2 3 0 1118 0 555 554 556 +1169 2 3 0 1119 0 556 651 652 +1170 2 3 0 1120 0 652 557 556 +1171 2 3 0 1121 0 557 652 653 +1172 2 3 0 1122 0 558 557 653 +1173 2 3 0 1123 0 558 653 654 +1174 2 3 0 1124 0 654 559 558 +1175 2 3 0 1125 0 654 655 559 +1176 2 3 0 1126 0 560 559 655 +1177 2 3 0 1127 0 560 655 561 +1178 2 3 0 1128 0 561 655 656 +1179 2 3 0 1129 0 561 656 657 +1180 2 3 0 1130 0 561 657 562 +1181 2 3 0 1131 0 562 657 658 +1182 2 3 0 1132 0 658 563 562 +1183 2 3 0 1133 0 658 659 563 +1184 2 3 0 1134 0 659 564 563 +1185 2 3 0 1135 0 564 659 660 +1186 2 3 0 1136 0 564 660 565 +1187 2 3 0 1137 0 661 565 660 +1188 2 3 0 1138 0 661 566 565 +1189 2 3 0 1139 0 566 661 662 +1190 2 3 0 1140 0 566 662 568 +1191 2 3 0 1141 0 567 566 568 +1192 2 3 0 1142 0 568 662 663 +1193 2 3 0 1143 0 569 568 663 +1194 2 3 0 1144 0 569 663 664 +1195 2 3 0 1145 0 664 570 569 +1196 2 3 0 1146 0 570 664 665 +1197 2 3 0 1147 0 570 665 571 +1198 2 3 0 1148 0 666 571 665 +1199 2 3 0 1149 0 571 666 572 +1200 2 3 0 1150 0 573 572 666 +1201 2 3 0 1151 0 667 573 666 +1202 2 3 0 1152 0 668 573 667 +1203 2 3 0 1153 0 573 668 574 +1204 2 3 0 1154 0 574 668 575 +1205 2 3 0 1155 0 575 668 669 +1206 2 3 0 1156 0 575 669 576 +1207 2 3 0 1157 0 576 669 670 +1208 2 3 0 1158 0 576 670 577 +1209 2 3 0 1159 0 577 670 578 +1210 2 3 0 1160 0 670 671 578 +1211 2 3 0 1161 0 578 671 579 +1212 2 3 0 1162 0 671 672 579 +1213 2 3 0 1163 0 579 672 580 +1214 2 3 0 1164 0 580 672 673 +1215 2 3 0 1165 0 674 581 586 +1216 2 3 0 1166 0 581 674 582 +1217 2 3 0 1167 0 674 675 582 +1218 2 3 0 1168 0 582 675 676 +1219 2 3 0 1169 0 582 676 583 +1220 2 3 0 1170 0 583 676 584 +1221 2 3 0 1171 0 676 677 584 +1222 2 3 0 1172 0 584 677 678 +1223 2 3 0 1173 0 678 585 584 +1224 2 3 0 1174 0 587 585 678 +1225 2 3 0 1175 0 674 586 679 +1226 2 3 0 1176 0 680 587 678 +1227 2 3 0 1177 0 587 680 588 +1228 2 3 0 1178 0 680 681 588 +1229 2 3 0 1179 0 588 681 589 +1230 2 3 0 1180 0 681 682 589 +1231 2 3 0 1181 0 589 682 590 +1232 2 3 0 1182 0 682 683 590 +1233 2 3 0 1183 0 590 683 591 +1234 2 3 0 1184 0 683 684 591 +1235 2 3 0 1185 0 591 684 685 +1236 2 3 0 1186 0 591 685 592 +1237 2 3 0 1187 0 592 685 593 +1238 2 3 0 1188 0 686 593 685 +1239 2 3 0 1189 0 593 686 594 +1240 2 3 0 1190 0 686 687 594 +1241 2 3 0 1191 0 594 687 595 +1242 2 3 0 1192 0 596 595 687 +1243 2 3 0 1193 0 688 596 687 +1244 2 3 0 1194 0 596 688 597 +1245 2 3 0 1195 0 688 689 597 +1246 2 3 0 1196 0 689 598 597 +1247 2 3 0 1197 0 689 690 598 +1248 2 3 0 1198 0 691 598 690 +1249 2 3 0 1199 0 599 598 691 +1250 2 3 0 1200 0 692 599 691 +1251 2 3 0 1201 0 600 599 692 +1252 2 3 0 1202 0 693 600 692 +1253 2 3 0 1203 0 600 693 694 +1254 2 3 0 1204 0 600 694 601 +1255 2 3 0 1205 0 602 601 694 +1256 2 3 0 1206 0 603 602 694 +1257 2 3 0 1207 0 603 694 695 +1258 2 3 0 1208 0 696 603 695 +1259 2 3 0 1209 0 603 696 604 +1260 2 3 0 1210 0 696 697 604 +1261 2 3 0 1211 0 697 605 604 +1262 2 3 0 1212 0 698 605 697 +1263 2 3 0 1213 0 699 605 698 +1264 2 3 0 1214 0 699 606 605 +1265 2 3 0 1215 0 607 606 699 +1266 2 3 0 1216 0 608 607 699 +1267 2 3 0 1217 0 699 700 608 +1268 2 3 0 1218 0 700 701 608 +1269 2 3 0 1219 0 608 701 702 +1270 2 3 0 1220 0 608 702 609 +1271 2 3 0 1221 0 609 702 610 +1272 2 3 0 1222 0 702 703 610 +1273 2 3 0 1223 0 703 611 610 +1274 2 3 0 1224 0 611 703 704 +1275 2 3 0 1225 0 705 611 704 +1276 2 3 0 1226 0 706 611 705 +1277 2 3 0 1227 0 706 612 611 +1278 2 3 0 1228 0 612 706 613 +1279 2 3 0 1229 0 706 707 613 +1280 2 3 0 1230 0 707 614 613 +1281 2 3 0 1231 0 707 708 614 +1282 2 3 0 1232 0 708 709 614 +1283 2 3 0 1233 0 710 614 709 +1284 2 3 0 1234 0 710 615 614 +1285 2 3 0 1235 0 616 615 710 +1286 2 3 0 1236 0 710 711 616 +1287 2 3 0 1237 0 711 617 616 +1288 2 3 0 1238 0 617 711 712 +1289 2 3 0 1239 0 713 617 712 +1290 2 3 0 1240 0 714 617 713 +1291 2 3 0 1241 0 714 618 617 +1292 2 3 0 1242 0 618 714 619 +1293 2 3 0 1243 0 714 715 619 +1294 2 3 0 1244 0 715 620 619 +1295 2 3 0 1245 0 715 716 620 +1296 2 3 0 1246 0 716 717 620 +1297 2 3 0 1247 0 620 717 622 +1298 2 3 0 1248 0 620 622 621 +1299 2 3 0 1249 0 624 622 717 +1300 2 3 0 1250 0 623 622 624 +1301 2 3 0 1251 0 624 717 718 +1302 2 3 0 1252 0 625 624 718 +1303 2 3 0 1253 0 625 718 719 +1304 2 3 0 1254 0 719 626 625 +1305 2 3 0 1255 0 719 720 626 +1306 2 3 0 1256 0 626 720 721 +1307 2 3 0 1257 0 627 626 721 +1308 2 3 0 1258 0 627 721 722 +1309 2 3 0 1259 0 629 627 722 +1310 2 3 0 1260 0 629 628 627 +1311 2 3 0 1261 0 629 722 723 +1312 2 3 0 1262 0 630 629 723 +1313 2 3 0 1263 0 630 723 724 +1314 2 3 0 1264 0 631 630 724 +1315 2 3 0 1265 0 724 725 631 +1316 2 3 0 1266 0 725 726 631 +1317 2 3 0 1267 0 633 631 726 +1318 2 3 0 1268 0 633 632 631 +1319 2 3 0 1269 0 633 726 727 +1320 2 3 0 1270 0 635 633 727 +1321 2 3 0 1271 0 634 633 635 +1322 2 3 0 1272 0 727 636 635 +1323 2 3 0 1273 0 727 728 636 +1324 2 3 0 1274 0 637 636 728 +1325 2 3 0 1275 0 637 728 729 +1326 2 3 0 1276 0 637 729 730 +1327 2 3 0 1277 0 638 637 730 +1328 2 3 0 1278 0 731 638 730 +1329 2 3 0 1279 0 640 638 731 +1330 2 3 0 1280 0 640 639 638 +1331 2 3 0 1281 0 640 731 732 +1332 2 3 0 1282 0 641 640 732 +1333 2 3 0 1283 0 732 643 641 +1334 2 3 0 1284 0 643 642 641 +1335 2 3 0 1285 0 643 732 733 +1336 2 3 0 1286 0 643 733 734 +1337 2 3 0 1287 0 644 643 734 +1338 2 3 0 1288 0 644 734 735 +1339 2 3 0 1289 0 645 644 735 +1340 2 3 0 1290 0 645 735 736 +1341 2 3 0 1291 0 646 645 736 +1342 2 3 0 1292 0 646 736 737 +1343 2 3 0 1293 0 647 646 737 +1344 2 3 0 1294 0 647 737 648 +1345 2 3 0 1295 0 648 737 738 +1346 2 3 0 1296 0 648 738 739 +1347 2 3 0 1297 0 649 648 739 +1348 2 3 0 1298 0 650 649 739 +1349 2 3 0 1299 0 650 739 740 +1350 2 3 0 1300 0 650 740 651 +1351 2 3 0 1301 0 741 651 740 +1352 2 3 0 1302 0 741 742 651 +1353 2 3 0 1303 0 652 651 742 +1354 2 3 0 1304 0 652 742 743 +1355 2 3 0 1305 0 652 743 653 +1356 2 3 0 1306 0 653 743 744 +1357 2 3 0 1307 0 654 653 744 +1358 2 3 0 1308 0 654 744 745 +1359 2 3 0 1309 0 654 745 656 +1360 2 3 0 1310 0 655 654 656 +1361 2 3 0 1311 0 656 745 746 +1362 2 3 0 1312 0 656 746 747 +1363 2 3 0 1313 0 657 656 747 +1364 2 3 0 1314 0 657 747 748 +1365 2 3 0 1315 0 657 748 658 +1366 2 3 0 1316 0 749 658 748 +1367 2 3 0 1317 0 659 658 749 +1368 2 3 0 1318 0 659 749 750 +1369 2 3 0 1319 0 659 750 660 +1370 2 3 0 1320 0 751 660 750 +1371 2 3 0 1321 0 751 661 660 +1372 2 3 0 1322 0 661 751 752 +1373 2 3 0 1323 0 661 752 662 +1374 2 3 0 1324 0 753 662 752 +1375 2 3 0 1325 0 662 753 663 +1376 2 3 0 1326 0 663 753 754 +1377 2 3 0 1327 0 663 754 755 +1378 2 3 0 1328 0 664 663 755 +1379 2 3 0 1329 0 664 755 665 +1380 2 3 0 1330 0 665 755 756 +1381 2 3 0 1331 0 756 666 665 +1382 2 3 0 1332 0 666 756 757 +1383 2 3 0 1333 0 666 757 667 +1384 2 3 0 1334 0 667 757 758 +1385 2 3 0 1335 0 758 668 667 +1386 2 3 0 1336 0 668 758 669 +1387 2 3 0 1337 0 758 759 669 +1388 2 3 0 1338 0 669 759 760 +1389 2 3 0 1339 0 669 760 670 +1390 2 3 0 1340 0 761 670 760 +1391 2 3 0 1341 0 761 671 670 +1392 2 3 0 1342 0 671 761 672 +1393 2 3 0 1343 0 761 762 672 +1394 2 3 0 1344 0 672 762 673 +1395 2 3 0 1345 0 673 762 763 +1396 2 3 0 1346 0 764 673 763 +1397 2 3 0 1347 0 765 674 679 +1398 2 3 0 1348 0 674 765 675 +1399 2 3 0 1349 0 675 765 766 +1400 2 3 0 1350 0 675 766 676 +1401 2 3 0 1351 0 767 676 766 +1402 2 3 0 1352 0 767 677 676 +1403 2 3 0 1353 0 768 677 767 +1404 2 3 0 1354 0 677 768 680 +1405 2 3 0 1355 0 678 677 680 +1406 2 3 0 1356 0 679 770 769 +1407 2 3 0 1357 0 679 769 765 +1408 2 3 0 1358 0 680 768 771 +1409 2 3 0 1359 0 680 771 681 +1410 2 3 0 1360 0 681 771 682 +1411 2 3 0 1361 0 771 772 682 +1412 2 3 0 1362 0 682 772 683 +1413 2 3 0 1363 0 773 683 772 +1414 2 3 0 1364 0 683 773 684 +1415 2 3 0 1365 0 684 773 774 +1416 2 3 0 1366 0 684 774 775 +1417 2 3 0 1367 0 685 684 775 +1418 2 3 0 1368 0 686 685 775 +1419 2 3 0 1369 0 776 686 775 +1420 2 3 0 1370 0 687 686 776 +1421 2 3 0 1371 0 777 687 776 +1422 2 3 0 1372 0 688 687 777 +1423 2 3 0 1373 0 689 688 777 +1424 2 3 0 1374 0 689 777 778 +1425 2 3 0 1375 0 778 690 689 +1426 2 3 0 1376 0 778 779 690 +1427 2 3 0 1377 0 779 780 690 +1428 2 3 0 1378 0 780 691 690 +1429 2 3 0 1379 0 780 781 691 +1430 2 3 0 1380 0 691 781 692 +1431 2 3 0 1381 0 692 781 782 +1432 2 3 0 1382 0 692 782 693 +1433 2 3 0 1383 0 782 695 693 +1434 2 3 0 1384 0 693 695 694 +1435 2 3 0 1385 0 782 783 695 +1436 2 3 0 1386 0 695 783 696 +1437 2 3 0 1387 0 783 784 696 +1438 2 3 0 1388 0 697 696 784 +1439 2 3 0 1389 0 785 697 784 +1440 2 3 0 1390 0 698 697 785 +1441 2 3 0 1391 0 785 786 698 +1442 2 3 0 1392 0 786 787 698 +1443 2 3 0 1393 0 698 787 699 +1444 2 3 0 1394 0 787 700 699 +1445 2 3 0 1395 0 788 700 787 +1446 2 3 0 1396 0 700 788 789 +1447 2 3 0 1397 0 700 789 701 +1448 2 3 0 1398 0 703 701 789 +1449 2 3 0 1399 0 703 702 701 +1450 2 3 0 1400 0 703 789 790 +1451 2 3 0 1401 0 704 703 790 +1452 2 3 0 1402 0 790 791 704 +1453 2 3 0 1403 0 704 791 792 +1454 2 3 0 1404 0 704 792 705 +1455 2 3 0 1405 0 707 705 792 +1456 2 3 0 1406 0 707 706 705 +1457 2 3 0 1407 0 707 792 793 +1458 2 3 0 1408 0 708 707 793 +1459 2 3 0 1409 0 794 708 793 +1460 2 3 0 1410 0 708 794 795 +1461 2 3 0 1411 0 708 795 709 +1462 2 3 0 1412 0 709 795 711 +1463 2 3 0 1413 0 709 711 710 +1464 2 3 0 1414 0 711 795 796 +1465 2 3 0 1415 0 712 711 796 +1466 2 3 0 1416 0 797 712 796 +1467 2 3 0 1417 0 798 712 797 +1468 2 3 0 1418 0 798 713 712 +1469 2 3 0 1419 0 715 713 798 +1470 2 3 0 1420 0 715 714 713 +1471 2 3 0 1421 0 798 799 715 +1472 2 3 0 1422 0 799 716 715 +1473 2 3 0 1423 0 800 716 799 +1474 2 3 0 1424 0 718 716 800 +1475 2 3 0 1425 0 718 717 716 +1476 2 3 0 1426 0 718 800 801 +1477 2 3 0 1427 0 719 718 801 +1478 2 3 0 1428 0 720 719 801 +1479 2 3 0 1429 0 720 801 802 +1480 2 3 0 1430 0 803 720 802 +1481 2 3 0 1431 0 721 720 803 +1482 2 3 0 1432 0 803 722 721 +1483 2 3 0 1433 0 803 804 722 +1484 2 3 0 1434 0 723 722 804 +1485 2 3 0 1435 0 723 804 805 +1486 2 3 0 1436 0 724 723 805 +1487 2 3 0 1437 0 724 805 806 +1488 2 3 0 1438 0 725 724 806 +1489 2 3 0 1439 0 725 806 807 +1490 2 3 0 1440 0 808 725 807 +1491 2 3 0 1441 0 726 725 808 +1492 2 3 0 1442 0 727 726 808 +1493 2 3 0 1443 0 728 727 808 +1494 2 3 0 1444 0 728 808 809 +1495 2 3 0 1445 0 809 729 728 +1496 2 3 0 1446 0 809 810 729 +1497 2 3 0 1447 0 730 729 810 +1498 2 3 0 1448 0 730 810 811 +1499 2 3 0 1449 0 811 812 730 +1500 2 3 0 1450 0 812 731 730 +1501 2 3 0 1451 0 731 812 813 +1502 2 3 0 1452 0 732 731 813 +1503 2 3 0 1453 0 732 813 733 +1504 2 3 0 1454 0 733 813 814 +1505 2 3 0 1455 0 734 733 814 +1506 2 3 0 1456 0 734 814 815 +1507 2 3 0 1457 0 734 815 816 +1508 2 3 0 1458 0 735 734 816 +1509 2 3 0 1459 0 735 816 817 +1510 2 3 0 1460 0 736 735 817 +1511 2 3 0 1461 0 817 737 736 +1512 2 3 0 1462 0 817 818 737 +1513 2 3 0 1463 0 737 818 738 +1514 2 3 0 1464 0 819 738 818 +1515 2 3 0 1465 0 819 820 738 +1516 2 3 0 1466 0 739 738 820 +1517 2 3 0 1467 0 739 820 821 +1518 2 3 0 1468 0 740 739 821 +1519 2 3 0 1469 0 740 821 741 +1520 2 3 0 1470 0 741 821 822 +1521 2 3 0 1471 0 741 822 823 +1522 2 3 0 1472 0 742 741 823 +1523 2 3 0 1473 0 743 742 823 +1524 2 3 0 1474 0 743 823 824 +1525 2 3 0 1475 0 743 824 744 +1526 2 3 0 1476 0 744 824 825 +1527 2 3 0 1477 0 744 825 826 +1528 2 3 0 1478 0 745 744 826 +1529 2 3 0 1479 0 745 826 746 +1530 2 3 0 1480 0 746 826 827 +1531 2 3 0 1481 0 746 827 828 +1532 2 3 0 1482 0 747 746 828 +1533 2 3 0 1483 0 748 747 828 +1534 2 3 0 1484 0 748 828 829 +1535 2 3 0 1485 0 829 749 748 +1536 2 3 0 1486 0 830 749 829 +1537 2 3 0 1487 0 830 831 749 +1538 2 3 0 1488 0 831 750 749 +1539 2 3 0 1489 0 831 751 750 +1540 2 3 0 1490 0 832 751 831 +1541 2 3 0 1491 0 832 833 751 +1542 2 3 0 1492 0 751 833 752 +1543 2 3 0 1493 0 752 833 834 +1544 2 3 0 1494 0 752 834 835 +1545 2 3 0 1495 0 835 753 752 +1546 2 3 0 1496 0 753 835 754 +1547 2 3 0 1497 0 835 836 754 +1548 2 3 0 1498 0 754 836 837 +1549 2 3 0 1499 0 755 754 837 +1550 2 3 0 1500 0 755 837 838 +1551 2 3 0 1501 0 755 838 756 +1552 2 3 0 1502 0 756 838 757 +1553 2 3 0 1503 0 838 839 757 +1554 2 3 0 1504 0 757 839 840 +1555 2 3 0 1505 0 757 840 758 +1556 2 3 0 1506 0 758 840 841 +1557 2 3 0 1507 0 758 841 759 +1558 2 3 0 1508 0 759 841 842 +1559 2 3 0 1509 0 759 842 760 +1560 2 3 0 1510 0 843 760 842 +1561 2 3 0 1511 0 761 760 843 +1562 2 3 0 1512 0 761 843 762 +1563 2 3 0 1513 0 843 844 762 +1564 2 3 0 1514 0 762 844 763 +1565 2 3 0 1515 0 844 845 763 +1566 2 3 0 1516 0 845 764 763 +1567 2 3 0 1517 0 845 846 764 +1568 2 3 0 1518 0 847 765 769 +1569 2 3 0 1519 0 765 847 766 +1570 2 3 0 1520 0 766 847 767 +1571 2 3 0 1521 0 847 848 767 +1572 2 3 0 1522 0 767 848 849 +1573 2 3 0 1523 0 849 768 767 +1574 2 3 0 1524 0 768 849 850 +1575 2 3 0 1525 0 768 850 771 +1576 2 3 0 1526 0 770 851 769 +1577 2 3 0 1527 0 852 769 851 +1578 2 3 0 1528 0 852 847 769 +1579 2 3 0 1529 0 853 851 770 +1580 2 3 0 1530 0 771 850 772 +1581 2 3 0 1531 0 850 854 772 +1582 2 3 0 1532 0 772 854 855 +1583 2 3 0 1533 0 773 772 855 +1584 2 3 0 1534 0 855 856 773 +1585 2 3 0 1535 0 773 856 857 +1586 2 3 0 1536 0 773 857 774 +1587 2 3 0 1537 0 774 857 858 +1588 2 3 0 1538 0 858 775 774 +1589 2 3 0 1539 0 858 776 775 +1590 2 3 0 1540 0 777 776 858 +1591 2 3 0 1541 0 859 777 858 +1592 2 3 0 1542 0 778 777 859 +1593 2 3 0 1543 0 859 860 778 +1594 2 3 0 1544 0 860 779 778 +1595 2 3 0 1545 0 779 860 861 +1596 2 3 0 1546 0 862 779 861 +1597 2 3 0 1547 0 863 779 862 +1598 2 3 0 1548 0 780 779 863 +1599 2 3 0 1549 0 864 780 863 +1600 2 3 0 1550 0 864 781 780 +1601 2 3 0 1551 0 865 781 864 +1602 2 3 0 1552 0 782 781 865 +1603 2 3 0 1553 0 782 865 783 +1604 2 3 0 1554 0 783 865 866 +1605 2 3 0 1555 0 867 783 866 +1606 2 3 0 1556 0 784 783 867 +1607 2 3 0 1557 0 868 784 867 +1608 2 3 0 1558 0 784 868 869 +1609 2 3 0 1559 0 784 869 785 +1610 2 3 0 1560 0 785 869 786 +1611 2 3 0 1561 0 869 870 786 +1612 2 3 0 1562 0 870 871 786 +1613 2 3 0 1563 0 788 786 871 +1614 2 3 0 1564 0 788 787 786 +1615 2 3 0 1565 0 872 788 871 +1616 2 3 0 1566 0 788 872 789 +1617 2 3 0 1567 0 872 790 789 +1618 2 3 0 1568 0 872 873 790 +1619 2 3 0 1569 0 873 874 790 +1620 2 3 0 1570 0 790 874 791 +1621 2 3 0 1571 0 875 791 874 +1622 2 3 0 1572 0 792 791 875 +1623 2 3 0 1573 0 793 792 875 +1624 2 3 0 1574 0 875 876 793 +1625 2 3 0 1575 0 876 877 793 +1626 2 3 0 1576 0 794 793 877 +1627 2 3 0 1577 0 878 794 877 +1628 2 3 0 1578 0 794 878 795 +1629 2 3 0 1579 0 878 796 795 +1630 2 3 0 1580 0 878 879 796 +1631 2 3 0 1581 0 879 880 796 +1632 2 3 0 1582 0 797 796 880 +1633 2 3 0 1583 0 880 881 797 +1634 2 3 0 1584 0 798 797 881 +1635 2 3 0 1585 0 799 798 881 +1636 2 3 0 1586 0 881 882 799 +1637 2 3 0 1587 0 882 883 799 +1638 2 3 0 1588 0 800 799 883 +1639 2 3 0 1589 0 801 800 883 +1640 2 3 0 1590 0 801 883 884 +1641 2 3 0 1591 0 802 801 884 +1642 2 3 0 1592 0 802 884 885 +1643 2 3 0 1593 0 886 802 885 +1644 2 3 0 1594 0 803 802 886 +1645 2 3 0 1595 0 803 886 887 +1646 2 3 0 1596 0 804 803 887 +1647 2 3 0 1597 0 804 887 888 +1648 2 3 0 1598 0 805 804 888 +1649 2 3 0 1599 0 888 806 805 +1650 2 3 0 1600 0 888 889 806 +1651 2 3 0 1601 0 806 889 890 +1652 2 3 0 1602 0 807 806 890 +1653 2 3 0 1603 0 807 890 891 +1654 2 3 0 1604 0 892 807 891 +1655 2 3 0 1605 0 808 807 892 +1656 2 3 0 1606 0 809 808 892 +1657 2 3 0 1607 0 809 892 893 +1658 2 3 0 1608 0 810 809 893 +1659 2 3 0 1609 0 810 893 894 +1660 2 3 0 1610 0 811 810 894 +1661 2 3 0 1611 0 811 894 895 +1662 2 3 0 1612 0 896 811 895 +1663 2 3 0 1613 0 811 896 812 +1664 2 3 0 1614 0 896 813 812 +1665 2 3 0 1615 0 813 896 814 +1666 2 3 0 1616 0 897 814 896 +1667 2 3 0 1617 0 815 814 897 +1668 2 3 0 1618 0 815 897 898 +1669 2 3 0 1619 0 816 815 898 +1670 2 3 0 1620 0 816 898 899 +1671 2 3 0 1621 0 816 899 900 +1672 2 3 0 1622 0 817 816 900 +1673 2 3 0 1623 0 818 817 900 +1674 2 3 0 1624 0 818 900 819 +1675 2 3 0 1625 0 819 900 901 +1676 2 3 0 1626 0 819 901 902 +1677 2 3 0 1627 0 819 902 903 +1678 2 3 0 1628 0 820 819 903 +1679 2 3 0 1629 0 821 820 903 +1680 2 3 0 1630 0 821 903 904 +1681 2 3 0 1631 0 821 904 822 +1682 2 3 0 1632 0 905 822 904 +1683 2 3 0 1633 0 905 906 822 +1684 2 3 0 1634 0 823 822 906 +1685 2 3 0 1635 0 823 906 907 +1686 2 3 0 1636 0 824 823 907 +1687 2 3 0 1637 0 824 907 825 +1688 2 3 0 1638 0 825 907 908 +1689 2 3 0 1639 0 825 908 909 +1690 2 3 0 1640 0 825 909 910 +1691 2 3 0 1641 0 826 825 910 +1692 2 3 0 1642 0 826 910 827 +1693 2 3 0 1643 0 827 910 911 +1694 2 3 0 1644 0 827 911 912 +1695 2 3 0 1645 0 828 827 912 +1696 2 3 0 1646 0 828 912 913 +1697 2 3 0 1647 0 829 828 913 +1698 2 3 0 1648 0 829 913 830 +1699 2 3 0 1649 0 830 913 914 +1700 2 3 0 1650 0 830 914 915 +1701 2 3 0 1651 0 915 832 830 +1702 2 3 0 1652 0 832 831 830 +1703 2 3 0 1653 0 916 832 915 +1704 2 3 0 1654 0 916 917 832 +1705 2 3 0 1655 0 917 833 832 +1706 2 3 0 1656 0 917 834 833 +1707 2 3 0 1657 0 834 917 918 +1708 2 3 0 1658 0 834 918 919 +1709 2 3 0 1659 0 834 919 836 +1710 2 3 0 1660 0 835 834 836 +1711 2 3 0 1661 0 836 919 920 +1712 2 3 0 1662 0 836 920 921 +1713 2 3 0 1663 0 836 921 837 +1714 2 3 0 1664 0 922 837 921 +1715 2 3 0 1665 0 922 923 837 +1716 2 3 0 1666 0 838 837 923 +1717 2 3 0 1667 0 838 923 839 +1718 2 3 0 1668 0 839 923 924 +1719 2 3 0 1669 0 839 924 840 +1720 2 3 0 1670 0 841 840 924 +1721 2 3 0 1671 0 925 841 924 +1722 2 3 0 1672 0 926 841 925 +1723 2 3 0 1673 0 841 926 842 +1724 2 3 0 1674 0 927 842 926 +1725 2 3 0 1675 0 927 843 842 +1726 2 3 0 1676 0 844 843 927 +1727 2 3 0 1677 0 928 844 927 +1728 2 3 0 1678 0 845 844 928 +1729 2 3 0 1679 0 929 845 928 +1730 2 3 0 1680 0 845 929 846 +1731 2 3 0 1681 0 930 846 929 +1732 2 3 0 1682 0 847 852 931 +1733 2 3 0 1683 0 847 931 848 +1734 2 3 0 1684 0 932 848 931 +1735 2 3 0 1685 0 848 932 849 +1736 2 3 0 1686 0 932 933 849 +1737 2 3 0 1687 0 849 933 850 +1738 2 3 0 1688 0 850 933 854 +1739 2 3 0 1689 0 853 934 851 +1740 2 3 0 1690 0 934 852 851 +1741 2 3 0 1691 0 931 852 934 +1742 2 3 0 1692 0 936 935 853 +1743 2 3 0 1693 0 853 935 934 +1744 2 3 0 1694 0 933 937 854 +1745 2 3 0 1695 0 854 937 855 +1746 2 3 0 1696 0 937 938 855 +1747 2 3 0 1697 0 855 938 856 +1748 2 3 0 1698 0 938 939 856 +1749 2 3 0 1699 0 856 939 857 +1750 2 3 0 1700 0 939 940 857 +1751 2 3 0 1701 0 941 857 940 +1752 2 3 0 1702 0 857 941 858 +1753 2 3 0 1703 0 859 858 941 +1754 2 3 0 1704 0 860 859 941 +1755 2 3 0 1705 0 941 942 860 +1756 2 3 0 1706 0 942 861 860 +1757 2 3 0 1707 0 861 942 943 +1758 2 3 0 1708 0 944 861 943 +1759 2 3 0 1709 0 945 861 944 +1760 2 3 0 1710 0 862 861 945 +1761 2 3 0 1711 0 946 862 945 +1762 2 3 0 1712 0 946 863 862 +1763 2 3 0 1713 0 947 863 946 +1764 2 3 0 1714 0 864 863 947 +1765 2 3 0 1715 0 866 864 947 +1766 2 3 0 1716 0 866 865 864 +1767 2 3 0 1717 0 947 948 866 +1768 2 3 0 1718 0 948 949 866 +1769 2 3 0 1719 0 866 949 867 +1770 2 3 0 1720 0 949 950 867 +1771 2 3 0 1721 0 867 950 951 +1772 2 3 0 1722 0 867 951 868 +1773 2 3 0 1723 0 870 868 951 +1774 2 3 0 1724 0 870 869 868 +1775 2 3 0 1725 0 870 951 952 +1776 2 3 0 1726 0 953 870 952 +1777 2 3 0 1727 0 871 870 953 +1778 2 3 0 1728 0 954 871 953 +1779 2 3 0 1729 0 872 871 954 +1780 2 3 0 1730 0 873 872 954 +1781 2 3 0 1731 0 873 954 955 +1782 2 3 0 1732 0 955 956 873 +1783 2 3 0 1733 0 874 873 956 +1784 2 3 0 1734 0 957 874 956 +1785 2 3 0 1735 0 875 874 957 +1786 2 3 0 1736 0 876 875 957 +1787 2 3 0 1737 0 876 957 958 +1788 2 3 0 1738 0 959 876 958 +1789 2 3 0 1739 0 876 959 877 +1790 2 3 0 1740 0 959 960 877 +1791 2 3 0 1741 0 878 877 960 +1792 2 3 0 1742 0 879 878 960 +1793 2 3 0 1743 0 879 960 961 +1794 2 3 0 1744 0 879 961 962 +1795 2 3 0 1745 0 963 879 962 +1796 2 3 0 1746 0 879 963 880 +1797 2 3 0 1747 0 963 964 880 +1798 2 3 0 1748 0 880 964 881 +1799 2 3 0 1749 0 882 881 964 +1800 2 3 0 1750 0 882 964 965 +1801 2 3 0 1751 0 966 882 965 +1802 2 3 0 1752 0 883 882 966 +1803 2 3 0 1753 0 884 883 966 +1804 2 3 0 1754 0 966 885 884 +1805 2 3 0 1755 0 966 967 885 +1806 2 3 0 1756 0 968 885 967 +1807 2 3 0 1757 0 886 885 968 +1808 2 3 0 1758 0 887 886 968 +1809 2 3 0 1759 0 887 968 969 +1810 2 3 0 1760 0 887 969 970 +1811 2 3 0 1761 0 888 887 970 +1812 2 3 0 1762 0 889 888 970 +1813 2 3 0 1763 0 889 970 971 +1814 2 3 0 1764 0 889 971 972 +1815 2 3 0 1765 0 890 889 972 +1816 2 3 0 1766 0 890 972 973 +1817 2 3 0 1767 0 891 890 973 +1818 2 3 0 1768 0 891 973 974 +1819 2 3 0 1769 0 892 891 974 +1820 2 3 0 1770 0 893 892 974 +1821 2 3 0 1771 0 974 975 893 +1822 2 3 0 1772 0 975 894 893 +1823 2 3 0 1773 0 895 894 975 +1824 2 3 0 1774 0 895 975 976 +1825 2 3 0 1775 0 895 976 977 +1826 2 3 0 1776 0 978 895 977 +1827 2 3 0 1777 0 896 895 978 +1828 2 3 0 1778 0 978 897 896 +1829 2 3 0 1779 0 897 978 979 +1830 2 3 0 1780 0 897 979 980 +1831 2 3 0 1781 0 898 897 980 +1832 2 3 0 1782 0 899 898 980 +1833 2 3 0 1783 0 899 980 981 +1834 2 3 0 1784 0 899 981 901 +1835 2 3 0 1785 0 900 899 901 +1836 2 3 0 1786 0 901 981 982 +1837 2 3 0 1787 0 902 901 982 +1838 2 3 0 1788 0 902 982 983 +1839 2 3 0 1789 0 983 903 902 +1840 2 3 0 1790 0 983 984 903 +1841 2 3 0 1791 0 904 903 984 +1842 2 3 0 1792 0 904 984 905 +1843 2 3 0 1793 0 905 984 985 +1844 2 3 0 1794 0 905 985 986 +1845 2 3 0 1795 0 906 905 986 +1846 2 3 0 1796 0 907 906 986 +1847 2 3 0 1797 0 907 986 908 +1848 2 3 0 1798 0 908 986 987 +1849 2 3 0 1799 0 908 987 988 +1850 2 3 0 1800 0 909 908 988 +1851 2 3 0 1801 0 909 988 989 +1852 2 3 0 1802 0 909 989 911 +1853 2 3 0 1803 0 910 909 911 +1854 2 3 0 1804 0 990 911 989 +1855 2 3 0 1805 0 990 991 911 +1856 2 3 0 1806 0 991 912 911 +1857 2 3 0 1807 0 991 914 912 +1858 2 3 0 1808 0 914 913 912 +1859 2 3 0 1809 0 914 991 992 +1860 2 3 0 1810 0 914 992 993 +1861 2 3 0 1811 0 915 914 993 +1862 2 3 0 1812 0 915 993 916 +1863 2 3 0 1813 0 916 993 994 +1864 2 3 0 1814 0 916 994 995 +1865 2 3 0 1815 0 995 918 916 +1866 2 3 0 1816 0 918 917 916 +1867 2 3 0 1817 0 996 918 995 +1868 2 3 0 1818 0 996 997 918 +1869 2 3 0 1819 0 997 919 918 +1870 2 3 0 1820 0 997 920 919 +1871 2 3 0 1821 0 920 997 998 +1872 2 3 0 1822 0 920 998 999 +1873 2 3 0 1823 0 999 921 920 +1874 2 3 0 1824 0 999 922 921 +1875 2 3 0 1825 0 922 999 1000 +1876 2 3 0 1826 0 922 1000 1001 +1877 2 3 0 1827 0 1001 1002 922 +1878 2 3 0 1828 0 1002 923 922 +1879 2 3 0 1829 0 923 1002 924 +1880 2 3 0 1830 0 924 1002 1003 +1881 2 3 0 1831 0 924 1003 925 +1882 2 3 0 1832 0 1003 1004 925 +1883 2 3 0 1833 0 925 1004 1005 +1884 2 3 0 1834 0 1005 926 925 +1885 2 3 0 1835 0 1006 926 1005 +1886 2 3 0 1836 0 927 926 1006 +1887 2 3 0 1837 0 1007 927 1006 +1888 2 3 0 1838 0 1007 928 927 +1889 2 3 0 1839 0 929 928 1007 +1890 2 3 0 1840 0 1008 929 1007 +1891 2 3 0 1841 0 929 1008 930 +1892 2 3 0 1842 0 1009 930 1008 +1893 2 3 0 1843 0 1010 931 934 +1894 2 3 0 1844 0 1011 931 1010 +1895 2 3 0 1845 0 1011 932 931 +1896 2 3 0 1846 0 932 1011 1012 +1897 2 3 0 1847 0 932 1012 933 +1898 2 3 0 1848 0 937 933 1012 +1899 2 3 0 1849 0 1010 934 935 +1900 2 3 0 1850 0 936 1013 935 +1901 2 3 0 1851 0 935 1013 1014 +1902 2 3 0 1852 0 1014 1010 935 +1903 2 3 0 1853 0 1015 1013 936 +1904 2 3 0 1854 0 1016 937 1012 +1905 2 3 0 1855 0 937 1016 1017 +1906 2 3 0 1856 0 937 1017 938 +1907 2 3 0 1857 0 1018 938 1017 +1908 2 3 0 1858 0 939 938 1018 +1909 2 3 0 1859 0 939 1018 1019 +1910 2 3 0 1860 0 939 1019 940 +1911 2 3 0 1861 0 1020 940 1019 +1912 2 3 0 1862 0 942 940 1020 +1913 2 3 0 1863 0 942 941 940 +1914 2 3 0 1864 0 942 1020 943 +1915 2 3 0 1865 0 1020 1021 943 +1916 2 3 0 1866 0 1021 1022 943 +1917 2 3 0 1867 0 943 1022 944 +1918 2 3 0 1868 0 944 1022 1023 +1919 2 3 0 1869 0 944 1023 1024 +1920 2 3 0 1870 0 944 1024 945 +1921 2 3 0 1871 0 945 1024 946 +1922 2 3 0 1872 0 1025 946 1024 +1923 2 3 0 1873 0 946 1025 948 +1924 2 3 0 1874 0 946 948 947 +1925 2 3 0 1875 0 1026 948 1025 +1926 2 3 0 1876 0 948 1026 949 +1927 2 3 0 1877 0 1026 1027 949 +1928 2 3 0 1878 0 949 1027 1028 +1929 2 3 0 1879 0 949 1028 950 +1930 2 3 0 1880 0 950 1028 952 +1931 2 3 0 1881 0 950 952 951 +1932 2 3 0 1882 0 1028 1029 952 +1933 2 3 0 1883 0 952 1029 1030 +1934 2 3 0 1884 0 952 1030 953 +1935 2 3 0 1885 0 953 1030 954 +1936 2 3 0 1886 0 1030 955 954 +1937 2 3 0 1887 0 955 1030 1031 +1938 2 3 0 1888 0 1032 955 1031 +1939 2 3 0 1889 0 955 1032 956 +1940 2 3 0 1890 0 1033 956 1032 +1941 2 3 0 1891 0 957 956 1033 +1942 2 3 0 1892 0 958 957 1033 +1943 2 3 0 1893 0 1033 1034 958 +1944 2 3 0 1894 0 1034 1035 958 +1945 2 3 0 1895 0 959 958 1035 +1946 2 3 0 1896 0 1035 1036 959 +1947 2 3 0 1897 0 961 959 1036 +1948 2 3 0 1898 0 961 960 959 +1949 2 3 0 1899 0 1036 1037 961 +1950 2 3 0 1900 0 1037 962 961 +1951 2 3 0 1901 0 1037 1038 962 +1952 2 3 0 1902 0 1039 962 1038 +1953 2 3 0 1903 0 1039 963 962 +1954 2 3 0 1904 0 963 1039 964 +1955 2 3 0 1905 0 1039 965 964 +1956 2 3 0 1906 0 965 1039 1040 +1957 2 3 0 1907 0 1041 965 1040 +1958 2 3 0 1908 0 966 965 1041 +1959 2 3 0 1909 0 967 966 1041 +1960 2 3 0 1910 0 967 1041 1042 +1961 2 3 0 1911 0 1043 967 1042 +1962 2 3 0 1912 0 1044 967 1043 +1963 2 3 0 1913 0 968 967 1044 +1964 2 3 0 1914 0 1044 969 968 +1965 2 3 0 1915 0 1044 1045 969 +1966 2 3 0 1916 0 969 1045 1046 +1967 2 3 0 1917 0 970 969 1046 +1968 2 3 0 1918 0 970 1046 971 +1969 2 3 0 1919 0 971 1046 1047 +1970 2 3 0 1920 0 972 971 1047 +1971 2 3 0 1921 0 972 1047 1048 +1972 2 3 0 1922 0 972 1048 1049 +1973 2 3 0 1923 0 973 972 1049 +1974 2 3 0 1924 0 1050 973 1049 +1975 2 3 0 1925 0 974 973 1050 +1976 2 3 0 1926 0 975 974 1050 +1977 2 3 0 1927 0 975 1050 1051 +1978 2 3 0 1928 0 975 1051 976 +1979 2 3 0 1929 0 976 1051 1052 +1980 2 3 0 1930 0 976 1052 1053 +1981 2 3 0 1931 0 977 976 1053 +1982 2 3 0 1932 0 977 1053 979 +1983 2 3 0 1933 0 978 977 979 +1984 2 3 0 1934 0 979 1053 1054 +1985 2 3 0 1935 0 979 1054 1055 +1986 2 3 0 1936 0 980 979 1055 +1987 2 3 0 1937 0 980 1055 981 +1988 2 3 0 1938 0 981 1055 1056 +1989 2 3 0 1939 0 981 1056 982 +1990 2 3 0 1940 0 982 1056 1057 +1991 2 3 0 1941 0 983 982 1057 +1992 2 3 0 1942 0 983 1057 1058 +1993 2 3 0 1943 0 983 1058 1059 +1994 2 3 0 1944 0 984 983 1059 +1995 2 3 0 1945 0 984 1059 985 +1996 2 3 0 1946 0 985 1059 1060 +1997 2 3 0 1947 0 985 1060 987 +1998 2 3 0 1948 0 986 985 987 +1999 2 3 0 1949 0 1061 987 1060 +2000 2 3 0 1950 0 1061 988 987 +2001 2 3 0 1951 0 1061 1062 988 +2002 2 3 0 1952 0 1062 989 988 +2003 2 3 0 1953 0 1062 1063 989 +2004 2 3 0 1954 0 1063 990 989 +2005 2 3 0 1955 0 1064 990 1063 +2006 2 3 0 1956 0 1064 1065 990 +2007 2 3 0 1957 0 991 990 1065 +2008 2 3 0 1958 0 991 1065 992 +2009 2 3 0 1959 0 992 1065 1066 +2010 2 3 0 1960 0 992 1066 1067 +2011 2 3 0 1961 0 1067 993 992 +2012 2 3 0 1962 0 1067 994 993 +2013 2 3 0 1963 0 994 1067 1068 +2014 2 3 0 1964 0 994 1068 1069 +2015 2 3 0 1965 0 995 994 1069 +2016 2 3 0 1966 0 995 1069 996 +2017 2 3 0 1967 0 996 1069 1070 +2018 2 3 0 1968 0 996 1070 1071 +2019 2 3 0 1969 0 997 996 1071 +2020 2 3 0 1970 0 997 1071 998 +2021 2 3 0 1971 0 998 1071 1072 +2022 2 3 0 1972 0 998 1072 1073 +2023 2 3 0 1973 0 998 1073 1000 +2024 2 3 0 1974 0 999 998 1000 +2025 2 3 0 1975 0 1074 1000 1073 +2026 2 3 0 1976 0 1074 1075 1000 +2027 2 3 0 1977 0 1075 1001 1000 +2028 2 3 0 1978 0 1075 1076 1001 +2029 2 3 0 1979 0 1001 1076 1003 +2030 2 3 0 1980 0 1002 1001 1003 +2031 2 3 0 1981 0 1003 1076 1004 +2032 2 3 0 1982 0 1076 1077 1004 +2033 2 3 0 1983 0 1078 1004 1077 +2034 2 3 0 1984 0 1078 1005 1004 +2035 2 3 0 1985 0 1078 1006 1005 +2036 2 3 0 1986 0 1006 1078 1007 +2037 2 3 0 1987 0 1078 1079 1007 +2038 2 3 0 1988 0 1007 1079 1008 +2039 2 3 0 1989 0 1079 1080 1008 +2040 2 3 0 1990 0 1080 1009 1008 +2041 2 3 0 1991 0 1081 1009 1080 +2042 2 3 0 1992 0 1009 1081 1082 +2043 2 3 0 1993 0 1083 1010 1014 +2044 2 3 0 1994 0 1083 1011 1010 +2045 2 3 0 1995 0 1012 1011 1083 +2046 2 3 0 1996 0 1084 1012 1083 +2047 2 3 0 1997 0 1016 1012 1084 +2048 2 3 0 1998 0 1015 1085 1013 +2049 2 3 0 1999 0 1013 1085 1086 +2050 2 3 0 2000 0 1013 1086 1014 +2051 2 3 0 2001 0 1014 1086 1087 +2052 2 3 0 2002 0 1087 1083 1014 +2053 2 3 0 2003 0 1085 1015 1088 +2054 2 3 0 2004 0 1089 1016 1084 +2055 2 3 0 2005 0 1016 1089 1017 +2056 2 3 0 2006 0 1089 1090 1017 +2057 2 3 0 2007 0 1018 1017 1090 +2058 2 3 0 2008 0 1091 1018 1090 +2059 2 3 0 2009 0 1018 1091 1019 +2060 2 3 0 2010 0 1091 1092 1019 +2061 2 3 0 2011 0 1019 1092 1020 +2062 2 3 0 2012 0 1092 1021 1020 +2063 2 3 0 2013 0 1021 1092 1093 +2064 2 3 0 2014 0 1094 1021 1093 +2065 2 3 0 2015 0 1095 1021 1094 +2066 2 3 0 2016 0 1095 1022 1021 +2067 2 3 0 2017 0 1023 1022 1095 +2068 2 3 0 2018 0 1023 1095 1096 +2069 2 3 0 2019 0 1024 1023 1096 +2070 2 3 0 2020 0 1024 1096 1097 +2071 2 3 0 2021 0 1025 1024 1097 +2072 2 3 0 2022 0 1026 1025 1097 +2073 2 3 0 2023 0 1098 1026 1097 +2074 2 3 0 2024 0 1027 1026 1098 +2075 2 3 0 2025 0 1099 1027 1098 +2076 2 3 0 2026 0 1100 1027 1099 +2077 2 3 0 2027 0 1100 1028 1027 +2078 2 3 0 2028 0 1028 1100 1029 +2079 2 3 0 2029 0 1100 1101 1029 +2080 2 3 0 2030 0 1030 1029 1101 +2081 2 3 0 2031 0 1031 1030 1101 +2082 2 3 0 2032 0 1102 1031 1101 +2083 2 3 0 2033 0 1103 1031 1102 +2084 2 3 0 2034 0 1032 1031 1103 +2085 2 3 0 2035 0 1104 1032 1103 +2086 2 3 0 2036 0 1033 1032 1104 +2087 2 3 0 2037 0 1034 1033 1104 +2088 2 3 0 2038 0 1034 1104 1105 +2089 2 3 0 2039 0 1034 1105 1106 +2090 2 3 0 2040 0 1107 1034 1106 +2091 2 3 0 2041 0 1034 1107 1035 +2092 2 3 0 2042 0 1036 1035 1107 +2093 2 3 0 2043 0 1108 1036 1107 +2094 2 3 0 2044 0 1037 1036 1108 +2095 2 3 0 2045 0 1037 1108 1109 +2096 2 3 0 2046 0 1110 1037 1109 +2097 2 3 0 2047 0 1110 1038 1037 +2098 2 3 0 2048 0 1111 1038 1110 +2099 2 3 0 2049 0 1040 1038 1111 +2100 2 3 0 2050 0 1039 1038 1040 +2101 2 3 0 2051 0 1111 1112 1040 +2102 2 3 0 2052 0 1112 1042 1040 +2103 2 3 0 2053 0 1041 1040 1042 +2104 2 3 0 2054 0 1042 1112 1113 +2105 2 3 0 2055 0 1043 1042 1113 +2106 2 3 0 2056 0 1043 1113 1114 +2107 2 3 0 2057 0 1115 1043 1114 +2108 2 3 0 2058 0 1044 1043 1115 +2109 2 3 0 2059 0 1045 1044 1115 +2110 2 3 0 2060 0 1045 1115 1116 +2111 2 3 0 2061 0 1046 1045 1116 +2112 2 3 0 2062 0 1116 1117 1046 +2113 2 3 0 2063 0 1117 1047 1046 +2114 2 3 0 2064 0 1117 1048 1047 +2115 2 3 0 2065 0 1118 1048 1117 +2116 2 3 0 2066 0 1048 1118 1119 +2117 2 3 0 2067 0 1049 1048 1119 +2118 2 3 0 2068 0 1049 1119 1120 +2119 2 3 0 2069 0 1121 1049 1120 +2120 2 3 0 2070 0 1050 1049 1121 +2121 2 3 0 2071 0 1050 1121 1051 +2122 2 3 0 2072 0 1051 1121 1122 +2123 2 3 0 2073 0 1052 1051 1122 +2124 2 3 0 2074 0 1052 1122 1123 +2125 2 3 0 2075 0 1123 1124 1052 +2126 2 3 0 2076 0 1124 1053 1052 +2127 2 3 0 2077 0 1054 1053 1124 +2128 2 3 0 2078 0 1054 1124 1125 +2129 2 3 0 2079 0 1054 1125 1126 +2130 2 3 0 2080 0 1055 1054 1126 +2131 2 3 0 2081 0 1056 1055 1126 +2132 2 3 0 2082 0 1056 1126 1127 +2133 2 3 0 2083 0 1056 1127 1057 +2134 2 3 0 2084 0 1057 1127 1128 +2135 2 3 0 2085 0 1128 1058 1057 +2136 2 3 0 2086 0 1128 1129 1058 +2137 2 3 0 2087 0 1058 1129 1130 +2138 2 3 0 2088 0 1059 1058 1130 +2139 2 3 0 2089 0 1059 1130 1060 +2140 2 3 0 2090 0 1060 1130 1131 +2141 2 3 0 2091 0 1131 1061 1060 +2142 2 3 0 2092 0 1061 1131 1132 +2143 2 3 0 2093 0 1061 1132 1133 +2144 2 3 0 2094 0 1062 1061 1133 +2145 2 3 0 2095 0 1062 1133 1134 +2146 2 3 0 2096 0 1134 1063 1062 +2147 2 3 0 2097 0 1134 1064 1063 +2148 2 3 0 2098 0 1135 1064 1134 +2149 2 3 0 2099 0 1135 1136 1064 +2150 2 3 0 2100 0 1136 1065 1064 +2151 2 3 0 2101 0 1136 1066 1065 +2152 2 3 0 2102 0 1066 1136 1137 +2153 2 3 0 2103 0 1066 1137 1138 +2154 2 3 0 2104 0 1067 1066 1138 +2155 2 3 0 2105 0 1067 1138 1068 +2156 2 3 0 2106 0 1068 1138 1139 +2157 2 3 0 2107 0 1068 1139 1140 +2158 2 3 0 2108 0 1069 1068 1140 +2159 2 3 0 2109 0 1069 1140 1070 +2160 2 3 0 2110 0 1070 1140 1141 +2161 2 3 0 2111 0 1070 1141 1142 +2162 2 3 0 2112 0 1071 1070 1142 +2163 2 3 0 2113 0 1071 1142 1072 +2164 2 3 0 2114 0 1072 1142 1143 +2165 2 3 0 2115 0 1072 1143 1144 +2166 2 3 0 2116 0 1073 1072 1144 +2167 2 3 0 2117 0 1073 1144 1074 +2168 2 3 0 2118 0 1145 1074 1144 +2169 2 3 0 2119 0 1145 1146 1074 +2170 2 3 0 2120 0 1074 1146 1147 +2171 2 3 0 2121 0 1075 1074 1147 +2172 2 3 0 2122 0 1076 1075 1147 +2173 2 3 0 2123 0 1076 1147 1077 +2174 2 3 0 2124 0 1148 1077 1147 +2175 2 3 0 2125 0 1148 1149 1077 +2176 2 3 0 2126 0 1149 1078 1077 +2177 2 3 0 2127 0 1078 1149 1079 +2178 2 3 0 2128 0 1149 1150 1079 +2179 2 3 0 2129 0 1080 1079 1150 +2180 2 3 0 2130 0 1151 1080 1150 +2181 2 3 0 2131 0 1080 1151 1081 +2182 2 3 0 2132 0 1151 1152 1081 +2183 2 3 0 2133 0 1082 1081 1152 +2184 2 3 0 2134 0 1153 1082 1152 +2185 2 3 0 2135 0 1083 1087 1154 +2186 2 3 0 2136 0 1083 1154 1084 +2187 2 3 0 2137 0 1084 1154 1089 +2188 2 3 0 2138 0 1088 1155 1085 +2189 2 3 0 2139 0 1085 1155 1156 +2190 2 3 0 2140 0 1085 1156 1157 +2191 2 3 0 2141 0 1157 1086 1085 +2192 2 3 0 2142 0 1158 1086 1157 +2193 2 3 0 2143 0 1086 1158 1087 +2194 2 3 0 2144 0 1087 1158 1154 +2195 2 3 0 2145 0 1154 1159 1089 +2196 2 3 0 2146 0 1089 1159 1160 +2197 2 3 0 2147 0 1089 1160 1090 +2198 2 3 0 2148 0 1090 1160 1091 +2199 2 3 0 2149 0 1160 1161 1091 +2200 2 3 0 2150 0 1091 1161 1093 +2201 2 3 0 2151 0 1091 1093 1092 +2202 2 3 0 2152 0 1161 1162 1093 +2203 2 3 0 2153 0 1162 1163 1093 +2204 2 3 0 2154 0 1094 1093 1163 +2205 2 3 0 2155 0 1164 1094 1163 +2206 2 3 0 2156 0 1165 1094 1164 +2207 2 3 0 2157 0 1095 1094 1165 +2208 2 3 0 2158 0 1096 1095 1165 +2209 2 3 0 2159 0 1166 1096 1165 +2210 2 3 0 2160 0 1096 1166 1167 +2211 2 3 0 2161 0 1096 1167 1097 +2212 2 3 0 2162 0 1098 1097 1167 +2213 2 3 0 2163 0 1167 1168 1098 +2214 2 3 0 2164 0 1168 1169 1098 +2215 2 3 0 2165 0 1098 1169 1099 +2216 2 3 0 2166 0 1169 1170 1099 +2217 2 3 0 2167 0 1171 1099 1170 +2218 2 3 0 2168 0 1171 1100 1099 +2219 2 3 0 2169 0 1100 1171 1101 +2220 2 3 0 2170 0 1171 1172 1101 +2221 2 3 0 2171 0 1102 1101 1172 +2222 2 3 0 2172 0 1172 1173 1102 +2223 2 3 0 2173 0 1173 1174 1102 +2224 2 3 0 2174 0 1103 1102 1174 +2225 2 3 0 2175 0 1105 1103 1174 +2226 2 3 0 2176 0 1105 1104 1103 +2227 2 3 0 2177 0 1174 1175 1105 +2228 2 3 0 2178 0 1175 1106 1105 +2229 2 3 0 2179 0 1176 1106 1175 +2230 2 3 0 2180 0 1177 1106 1176 +2231 2 3 0 2181 0 1107 1106 1177 +2232 2 3 0 2182 0 1107 1177 1108 +2233 2 3 0 2183 0 1177 1178 1108 +2234 2 3 0 2184 0 1178 1109 1108 +2235 2 3 0 2185 0 1179 1109 1178 +2236 2 3 0 2186 0 1180 1109 1179 +2237 2 3 0 2187 0 1110 1109 1180 +2238 2 3 0 2188 0 1111 1110 1180 +2239 2 3 0 2189 0 1111 1180 1181 +2240 2 3 0 2190 0 1112 1111 1181 +2241 2 3 0 2191 0 1182 1112 1181 +2242 2 3 0 2192 0 1113 1112 1182 +2243 2 3 0 2193 0 1182 1183 1113 +2244 2 3 0 2194 0 1183 1114 1113 +2245 2 3 0 2195 0 1114 1183 1184 +2246 2 3 0 2196 0 1185 1114 1184 +2247 2 3 0 2197 0 1116 1114 1185 +2248 2 3 0 2198 0 1116 1115 1114 +2249 2 3 0 2199 0 1116 1185 1186 +2250 2 3 0 2200 0 1117 1116 1186 +2251 2 3 0 2201 0 1118 1117 1186 +2252 2 3 0 2202 0 1118 1186 1187 +2253 2 3 0 2203 0 1118 1187 1188 +2254 2 3 0 2204 0 1119 1118 1188 +2255 2 3 0 2205 0 1120 1119 1188 +2256 2 3 0 2206 0 1120 1188 1189 +2257 2 3 0 2207 0 1120 1189 1190 +2258 2 3 0 2208 0 1121 1120 1190 +2259 2 3 0 2209 0 1122 1121 1190 +2260 2 3 0 2210 0 1122 1190 1123 +2261 2 3 0 2211 0 1123 1190 1191 +2262 2 3 0 2212 0 1191 1192 1123 +2263 2 3 0 2213 0 1192 1124 1123 +2264 2 3 0 2214 0 1124 1192 1193 +2265 2 3 0 2215 0 1125 1124 1193 +2266 2 3 0 2216 0 1125 1193 1194 +2267 2 3 0 2217 0 1126 1125 1194 +2268 2 3 0 2218 0 1126 1194 1127 +2269 2 3 0 2219 0 1127 1194 1195 +2270 2 3 0 2220 0 1127 1195 1128 +2271 2 3 0 2221 0 1128 1195 1196 +2272 2 3 0 2222 0 1129 1128 1196 +2273 2 3 0 2223 0 1129 1196 1197 +2274 2 3 0 2224 0 1129 1197 1198 +2275 2 3 0 2225 0 1130 1129 1198 +2276 2 3 0 2226 0 1130 1198 1131 +2277 2 3 0 2227 0 1131 1198 1199 +2278 2 3 0 2228 0 1131 1199 1132 +2279 2 3 0 2229 0 1132 1199 1200 +2280 2 3 0 2230 0 1132 1200 1201 +2281 2 3 0 2231 0 1133 1132 1201 +2282 2 3 0 2232 0 1133 1201 1202 +2283 2 3 0 2233 0 1134 1133 1202 +2284 2 3 0 2234 0 1134 1202 1135 +2285 2 3 0 2235 0 1135 1202 1203 +2286 2 3 0 2236 0 1135 1203 1204 +2287 2 3 0 2237 0 1136 1135 1204 +2288 2 3 0 2238 0 1136 1204 1137 +2289 2 3 0 2239 0 1137 1204 1205 +2290 2 3 0 2240 0 1137 1205 1206 +2291 2 3 0 2241 0 1138 1137 1206 +2292 2 3 0 2242 0 1138 1206 1139 +2293 2 3 0 2243 0 1207 1139 1206 +2294 2 3 0 2244 0 1207 1208 1139 +2295 2 3 0 2245 0 1208 1140 1139 +2296 2 3 0 2246 0 1208 1141 1140 +2297 2 3 0 2247 0 1141 1208 1209 +2298 2 3 0 2248 0 1141 1209 1210 +2299 2 3 0 2249 0 1142 1141 1210 +2300 2 3 0 2250 0 1142 1210 1143 +2301 2 3 0 2251 0 1211 1143 1210 +2302 2 3 0 2252 0 1211 1212 1143 +2303 2 3 0 2253 0 1144 1143 1212 +2304 2 3 0 2254 0 1144 1212 1145 +2305 2 3 0 2255 0 1145 1212 1213 +2306 2 3 0 2256 0 1145 1213 1214 +2307 2 3 0 2257 0 1214 1146 1145 +2308 2 3 0 2258 0 1214 1215 1146 +2309 2 3 0 2259 0 1215 1147 1146 +2310 2 3 0 2260 0 1215 1148 1147 +2311 2 3 0 2261 0 1148 1215 1216 +2312 2 3 0 2262 0 1148 1216 1150 +2313 2 3 0 2263 0 1149 1148 1150 +2314 2 3 0 2264 0 1150 1216 1217 +2315 2 3 0 2265 0 1150 1217 1151 +2316 2 3 0 2266 0 1151 1217 1152 +2317 2 3 0 2267 0 1217 1218 1152 +2318 2 3 0 2268 0 1218 1153 1152 +2319 2 3 0 2269 0 1153 1218 1219 +2320 2 3 0 2270 0 1158 1220 1154 +2321 2 3 0 2271 0 1159 1154 1220 +2322 2 3 0 2272 0 1155 1221 1156 +2323 2 3 0 2273 0 1221 1222 1156 +2324 2 3 0 2274 0 1223 1156 1222 +2325 2 3 0 2275 0 1156 1223 1157 +2326 2 3 0 2276 0 1157 1223 1224 +2327 2 3 0 2277 0 1158 1157 1224 +2328 2 3 0 2278 0 1158 1224 1220 +2329 2 3 0 2279 0 1225 1159 1220 +2330 2 3 0 2280 0 1160 1159 1225 +2331 2 3 0 2281 0 1226 1160 1225 +2332 2 3 0 2282 0 1161 1160 1226 +2333 2 3 0 2283 0 1162 1161 1226 +2334 2 3 0 2284 0 1226 1227 1162 +2335 2 3 0 2285 0 1162 1227 1228 +2336 2 3 0 2286 0 1162 1228 1163 +2337 2 3 0 2287 0 1163 1228 1164 +2338 2 3 0 2288 0 1228 1229 1164 +2339 2 3 0 2289 0 1230 1164 1229 +2340 2 3 0 2290 0 1230 1165 1164 +2341 2 3 0 2291 0 1165 1230 1166 +2342 2 3 0 2292 0 1230 1231 1166 +2343 2 3 0 2293 0 1166 1231 1232 +2344 2 3 0 2294 0 1166 1232 1167 +2345 2 3 0 2295 0 1167 1232 1168 +2346 2 3 0 2296 0 1168 1232 1233 +2347 2 3 0 2297 0 1234 1168 1233 +2348 2 3 0 2298 0 1169 1168 1234 +2349 2 3 0 2299 0 1235 1169 1234 +2350 2 3 0 2300 0 1235 1170 1169 +2351 2 3 0 2301 0 1236 1170 1235 +2352 2 3 0 2302 0 1236 1171 1170 +2353 2 3 0 2303 0 1171 1236 1172 +2354 2 3 0 2304 0 1236 1173 1172 +2355 2 3 0 2305 0 1236 1237 1173 +2356 2 3 0 2306 0 1237 1238 1173 +2357 2 3 0 2307 0 1174 1173 1238 +2358 2 3 0 2308 0 1175 1174 1238 +2359 2 3 0 2309 0 1175 1238 1239 +2360 2 3 0 2310 0 1240 1175 1239 +2361 2 3 0 2311 0 1176 1175 1240 +2362 2 3 0 2312 0 1240 1241 1176 +2363 2 3 0 2313 0 1241 1242 1176 +2364 2 3 0 2314 0 1177 1176 1242 +2365 2 3 0 2315 0 1178 1177 1242 +2366 2 3 0 2316 0 1178 1242 1243 +2367 2 3 0 2317 0 1244 1178 1243 +2368 2 3 0 2318 0 1179 1178 1244 +2369 2 3 0 2319 0 1244 1245 1179 +2370 2 3 0 2320 0 1245 1246 1179 +2371 2 3 0 2321 0 1180 1179 1246 +2372 2 3 0 2322 0 1181 1180 1246 +2373 2 3 0 2323 0 1181 1246 1247 +2374 2 3 0 2324 0 1248 1181 1247 +2375 2 3 0 2325 0 1182 1181 1248 +2376 2 3 0 2326 0 1182 1248 1249 +2377 2 3 0 2327 0 1183 1182 1249 +2378 2 3 0 2328 0 1184 1183 1249 +2379 2 3 0 2329 0 1184 1249 1250 +2380 2 3 0 2330 0 1184 1250 1251 +2381 2 3 0 2331 0 1252 1184 1251 +2382 2 3 0 2332 0 1185 1184 1252 +2383 2 3 0 2333 0 1186 1185 1252 +2384 2 3 0 2334 0 1186 1252 1253 +2385 2 3 0 2335 0 1187 1186 1253 +2386 2 3 0 2336 0 1187 1253 1254 +2387 2 3 0 2337 0 1188 1187 1254 +2388 2 3 0 2338 0 1254 1255 1188 +2389 2 3 0 2339 0 1255 1189 1188 +2390 2 3 0 2340 0 1255 1256 1189 +2391 2 3 0 2341 0 1256 1257 1189 +2392 2 3 0 2342 0 1190 1189 1257 +2393 2 3 0 2343 0 1191 1190 1257 +2394 2 3 0 2344 0 1191 1257 1258 +2395 2 3 0 2345 0 1191 1258 1259 +2396 2 3 0 2346 0 1192 1191 1259 +2397 2 3 0 2347 0 1193 1192 1259 +2398 2 3 0 2348 0 1193 1259 1260 +2399 2 3 0 2349 0 1193 1260 1261 +2400 2 3 0 2350 0 1194 1193 1261 +2401 2 3 0 2351 0 1195 1194 1261 +2402 2 3 0 2352 0 1195 1261 1262 +2403 2 3 0 2353 0 1195 1262 1196 +2404 2 3 0 2354 0 1196 1262 1263 +2405 2 3 0 2355 0 1197 1196 1263 +2406 2 3 0 2356 0 1197 1263 1264 +2407 2 3 0 2357 0 1197 1264 1199 +2408 2 3 0 2358 0 1198 1197 1199 +2409 2 3 0 2359 0 1265 1199 1264 +2410 2 3 0 2360 0 1265 1200 1199 +2411 2 3 0 2361 0 1200 1265 1266 +2412 2 3 0 2362 0 1201 1200 1266 +2413 2 3 0 2363 0 1201 1266 1267 +2414 2 3 0 2364 0 1202 1201 1267 +2415 2 3 0 2365 0 1202 1267 1203 +2416 2 3 0 2366 0 1203 1267 1268 +2417 2 3 0 2367 0 1203 1268 1269 +2418 2 3 0 2368 0 1269 1204 1203 +2419 2 3 0 2369 0 1269 1205 1204 +2420 2 3 0 2370 0 1205 1269 1270 +2421 2 3 0 2371 0 1205 1270 1271 +2422 2 3 0 2372 0 1206 1205 1271 +2423 2 3 0 2373 0 1206 1271 1207 +2424 2 3 0 2374 0 1207 1271 1272 +2425 2 3 0 2375 0 1207 1272 1273 +2426 2 3 0 2376 0 1208 1207 1273 +2427 2 3 0 2377 0 1208 1273 1209 +2428 2 3 0 2378 0 1209 1273 1274 +2429 2 3 0 2379 0 1209 1274 1275 +2430 2 3 0 2380 0 1210 1209 1275 +2431 2 3 0 2381 0 1210 1275 1211 +2432 2 3 0 2382 0 1211 1275 1276 +2433 2 3 0 2383 0 1211 1276 1277 +2434 2 3 0 2384 0 1212 1211 1277 +2435 2 3 0 2385 0 1212 1277 1213 +2436 2 3 0 2386 0 1213 1277 1278 +2437 2 3 0 2387 0 1213 1278 1279 +2438 2 3 0 2388 0 1214 1213 1279 +2439 2 3 0 2389 0 1214 1279 1280 +2440 2 3 0 2390 0 1280 1215 1214 +2441 2 3 0 2391 0 1280 1281 1215 +2442 2 3 0 2392 0 1215 1281 1216 +2443 2 3 0 2393 0 1216 1281 1217 +2444 2 3 0 2394 0 1281 1282 1217 +2445 2 3 0 2395 0 1217 1282 1218 +2446 2 3 0 2396 0 1282 1283 1218 +2447 2 3 0 2397 0 1218 1283 1219 +2448 2 3 0 2398 0 1219 1283 1284 +2449 2 3 0 2399 0 1285 1220 1224 +2450 2 3 0 2400 0 1225 1220 1285 +2451 2 3 0 2401 0 1221 1286 1222 +2452 2 3 0 2402 0 1287 1222 1286 +2453 2 3 0 2403 0 1288 1222 1287 +2454 2 3 0 2404 0 1288 1223 1222 +2455 2 3 0 2405 0 1223 1288 1289 +2456 2 3 0 2406 0 1223 1289 1290 +2457 2 3 0 2407 0 1223 1290 1224 +2458 2 3 0 2408 0 1224 1290 1285 +2459 2 3 0 2409 0 1225 1285 1291 +2460 2 3 0 2410 0 1225 1291 1226 +2461 2 3 0 2411 0 1291 1227 1226 +2462 2 3 0 2412 0 1291 1292 1227 +2463 2 3 0 2413 0 1292 1293 1227 +2464 2 3 0 2414 0 1227 1293 1228 +2465 2 3 0 2415 0 1293 1294 1228 +2466 2 3 0 2416 0 1229 1228 1294 +2467 2 3 0 2417 0 1295 1229 1294 +2468 2 3 0 2418 0 1229 1295 1230 +2469 2 3 0 2419 0 1295 1296 1230 +2470 2 3 0 2420 0 1231 1230 1296 +2471 2 3 0 2421 0 1297 1231 1296 +2472 2 3 0 2422 0 1232 1231 1297 +2473 2 3 0 2423 0 1233 1232 1297 +2474 2 3 0 2424 0 1298 1233 1297 +2475 2 3 0 2425 0 1234 1233 1298 +2476 2 3 0 2426 0 1299 1234 1298 +2477 2 3 0 2427 0 1234 1299 1300 +2478 2 3 0 2428 0 1234 1300 1235 +2479 2 3 0 2429 0 1235 1300 1236 +2480 2 3 0 2430 0 1300 1237 1236 +2481 2 3 0 2431 0 1237 1300 1301 +2482 2 3 0 2432 0 1302 1237 1301 +2483 2 3 0 2433 0 1302 1238 1237 +2484 2 3 0 2434 0 1239 1238 1302 +2485 2 3 0 2435 0 1239 1302 1303 +2486 2 3 0 2436 0 1239 1303 1304 +2487 2 3 0 2437 0 1305 1239 1304 +2488 2 3 0 2438 0 1240 1239 1305 +2489 2 3 0 2439 0 1241 1240 1305 +2490 2 3 0 2440 0 1241 1305 1306 +2491 2 3 0 2441 0 1307 1241 1306 +2492 2 3 0 2442 0 1243 1241 1307 +2493 2 3 0 2443 0 1243 1242 1241 +2494 2 3 0 2444 0 1243 1307 1308 +2495 2 3 0 2445 0 1309 1243 1308 +2496 2 3 0 2446 0 1244 1243 1309 +2497 2 3 0 2447 0 1245 1244 1309 +2498 2 3 0 2448 0 1245 1309 1310 +2499 2 3 0 2449 0 1311 1245 1310 +2500 2 3 0 2450 0 1245 1311 1247 +2501 2 3 0 2451 0 1245 1247 1246 +2502 2 3 0 2452 0 1311 1312 1247 +2503 2 3 0 2453 0 1312 1313 1247 +2504 2 3 0 2454 0 1248 1247 1313 +2505 2 3 0 2455 0 1249 1248 1313 +2506 2 3 0 2456 0 1249 1313 1314 +2507 2 3 0 2457 0 1250 1249 1314 +2508 2 3 0 2458 0 1250 1314 1315 +2509 2 3 0 2459 0 1251 1250 1315 +2510 2 3 0 2460 0 1251 1315 1316 +2511 2 3 0 2461 0 1317 1251 1316 +2512 2 3 0 2462 0 1251 1317 1253 +2513 2 3 0 2463 0 1251 1253 1252 +2514 2 3 0 2464 0 1253 1317 1318 +2515 2 3 0 2465 0 1254 1253 1318 +2516 2 3 0 2466 0 1255 1254 1318 +2517 2 3 0 2467 0 1255 1318 1319 +2518 2 3 0 2468 0 1255 1319 1256 +2519 2 3 0 2469 0 1256 1319 1320 +2520 2 3 0 2470 0 1320 1321 1256 +2521 2 3 0 2471 0 1258 1256 1321 +2522 2 3 0 2472 0 1257 1256 1258 +2523 2 3 0 2473 0 1258 1321 1322 +2524 2 3 0 2474 0 1259 1258 1322 +2525 2 3 0 2475 0 1259 1322 1323 +2526 2 3 0 2476 0 1260 1259 1323 +2527 2 3 0 2477 0 1260 1323 1324 +2528 2 3 0 2478 0 1261 1260 1324 +2529 2 3 0 2479 0 1324 1262 1261 +2530 2 3 0 2480 0 1324 1325 1262 +2531 2 3 0 2481 0 1262 1325 1263 +2532 2 3 0 2482 0 1326 1263 1325 +2533 2 3 0 2483 0 1326 1327 1263 +2534 2 3 0 2484 0 1327 1264 1263 +2535 2 3 0 2485 0 1327 1265 1264 +2536 2 3 0 2486 0 1265 1327 1328 +2537 2 3 0 2487 0 1265 1328 1329 +2538 2 3 0 2488 0 1265 1329 1266 +2539 2 3 0 2489 0 1266 1329 1330 +2540 2 3 0 2490 0 1266 1330 1331 +2541 2 3 0 2491 0 1267 1266 1331 +2542 2 3 0 2492 0 1267 1331 1268 +2543 2 3 0 2493 0 1268 1331 1332 +2544 2 3 0 2494 0 1268 1332 1333 +2545 2 3 0 2495 0 1269 1268 1333 +2546 2 3 0 2496 0 1269 1333 1270 +2547 2 3 0 2497 0 1270 1333 1334 +2548 2 3 0 2498 0 1270 1334 1335 +2549 2 3 0 2499 0 1271 1270 1335 +2550 2 3 0 2500 0 1271 1335 1272 +2551 2 3 0 2501 0 1336 1272 1335 +2552 2 3 0 2502 0 1336 1337 1272 +2553 2 3 0 2503 0 1273 1272 1337 +2554 2 3 0 2504 0 1273 1337 1274 +2555 2 3 0 2505 0 1337 1338 1274 +2556 2 3 0 2506 0 1339 1274 1338 +2557 2 3 0 2507 0 1340 1274 1339 +2558 2 3 0 2508 0 1340 1275 1274 +2559 2 3 0 2509 0 1340 1276 1275 +2560 2 3 0 2510 0 1341 1276 1340 +2561 2 3 0 2511 0 1342 1276 1341 +2562 2 3 0 2512 0 1342 1343 1276 +2563 2 3 0 2513 0 1277 1276 1343 +2564 2 3 0 2514 0 1277 1343 1278 +2565 2 3 0 2515 0 1278 1343 1344 +2566 2 3 0 2516 0 1345 1278 1344 +2567 2 3 0 2517 0 1345 1346 1278 +2568 2 3 0 2518 0 1346 1279 1278 +2569 2 3 0 2519 0 1346 1347 1279 +2570 2 3 0 2520 0 1280 1279 1347 +2571 2 3 0 2521 0 1280 1347 1348 +2572 2 3 0 2522 0 1348 1281 1280 +2573 2 3 0 2523 0 1348 1282 1281 +2574 2 3 0 2524 0 1349 1282 1348 +2575 2 3 0 2525 0 1349 1283 1282 +2576 2 3 0 2526 0 1350 1283 1349 +2577 2 3 0 2527 0 1284 1283 1350 +2578 2 3 0 2528 0 1284 1350 1351 +2579 2 3 0 2529 0 1290 1352 1285 +2580 2 3 0 2530 0 1285 1352 1291 +2581 2 3 0 2531 0 1353 1287 1286 +2582 2 3 0 2532 0 1287 1353 1354 +2583 2 3 0 2533 0 1355 1287 1354 +2584 2 3 0 2534 0 1355 1288 1287 +2585 2 3 0 2535 0 1355 1356 1288 +2586 2 3 0 2536 0 1357 1288 1356 +2587 2 3 0 2537 0 1288 1357 1289 +2588 2 3 0 2538 0 1357 1358 1289 +2589 2 3 0 2539 0 1289 1358 1359 +2590 2 3 0 2540 0 1289 1359 1352 +2591 2 3 0 2541 0 1290 1289 1352 +2592 2 3 0 2542 0 1352 1292 1291 +2593 2 3 0 2543 0 1352 1360 1292 +2594 2 3 0 2544 0 1292 1360 1293 +2595 2 3 0 2545 0 1360 1361 1293 +2596 2 3 0 2546 0 1293 1361 1294 +2597 2 3 0 2547 0 1361 1362 1294 +2598 2 3 0 2548 0 1295 1294 1362 +2599 2 3 0 2549 0 1363 1295 1362 +2600 2 3 0 2550 0 1364 1295 1363 +2601 2 3 0 2551 0 1364 1296 1295 +2602 2 3 0 2552 0 1297 1296 1364 +2603 2 3 0 2553 0 1365 1297 1364 +2604 2 3 0 2554 0 1298 1297 1365 +2605 2 3 0 2555 0 1298 1365 1366 +2606 2 3 0 2556 0 1367 1298 1366 +2607 2 3 0 2557 0 1299 1298 1367 +2608 2 3 0 2558 0 1368 1299 1367 +2609 2 3 0 2559 0 1300 1299 1368 +2610 2 3 0 2560 0 1301 1300 1368 +2611 2 3 0 2561 0 1369 1301 1368 +2612 2 3 0 2562 0 1301 1369 1302 +2613 2 3 0 2563 0 1369 1303 1302 +2614 2 3 0 2564 0 1369 1370 1303 +2615 2 3 0 2565 0 1370 1304 1303 +2616 2 3 0 2566 0 1304 1370 1371 +2617 2 3 0 2567 0 1372 1304 1371 +2618 2 3 0 2568 0 1306 1304 1372 +2619 2 3 0 2569 0 1306 1305 1304 +2620 2 3 0 2570 0 1306 1372 1373 +2621 2 3 0 2571 0 1374 1306 1373 +2622 2 3 0 2572 0 1306 1374 1307 +2623 2 3 0 2573 0 1374 1308 1307 +2624 2 3 0 2574 0 1308 1374 1375 +2625 2 3 0 2575 0 1376 1308 1375 +2626 2 3 0 2576 0 1310 1308 1376 +2627 2 3 0 2577 0 1310 1309 1308 +2628 2 3 0 2578 0 1310 1376 1377 +2629 2 3 0 2579 0 1378 1310 1377 +2630 2 3 0 2580 0 1311 1310 1378 +2631 2 3 0 2581 0 1312 1311 1378 +2632 2 3 0 2582 0 1312 1378 1379 +2633 2 3 0 2583 0 1380 1312 1379 +2634 2 3 0 2584 0 1314 1312 1380 +2635 2 3 0 2585 0 1314 1313 1312 +2636 2 3 0 2586 0 1314 1380 1381 +2637 2 3 0 2587 0 1315 1314 1381 +2638 2 3 0 2588 0 1316 1315 1381 +2639 2 3 0 2589 0 1316 1381 1382 +2640 2 3 0 2590 0 1316 1382 1383 +2641 2 3 0 2591 0 1384 1316 1383 +2642 2 3 0 2592 0 1317 1316 1384 +2643 2 3 0 2593 0 1318 1317 1384 +2644 2 3 0 2594 0 1318 1384 1319 +2645 2 3 0 2595 0 1319 1384 1385 +2646 2 3 0 2596 0 1320 1319 1385 +2647 2 3 0 2597 0 1320 1385 1386 +2648 2 3 0 2598 0 1320 1386 1387 +2649 2 3 0 2599 0 1388 1320 1387 +2650 2 3 0 2600 0 1320 1388 1321 +2651 2 3 0 2601 0 1388 1389 1321 +2652 2 3 0 2602 0 1389 1322 1321 +2653 2 3 0 2603 0 1389 1323 1322 +2654 2 3 0 2604 0 1389 1390 1323 +2655 2 3 0 2605 0 1323 1390 1391 +2656 2 3 0 2606 0 1324 1323 1391 +2657 2 3 0 2607 0 1325 1324 1391 +2658 2 3 0 2608 0 1325 1391 1326 +2659 2 3 0 2609 0 1326 1391 1392 +2660 2 3 0 2610 0 1326 1392 1393 +2661 2 3 0 2611 0 1327 1326 1393 +2662 2 3 0 2612 0 1327 1393 1328 +2663 2 3 0 2613 0 1328 1393 1394 +2664 2 3 0 2614 0 1328 1394 1395 +2665 2 3 0 2615 0 1329 1328 1395 +2666 2 3 0 2616 0 1329 1395 1330 +2667 2 3 0 2617 0 1330 1395 1396 +2668 2 3 0 2618 0 1330 1396 1397 +2669 2 3 0 2619 0 1330 1397 1398 +2670 2 3 0 2620 0 1331 1330 1398 +2671 2 3 0 2621 0 1332 1331 1398 +2672 2 3 0 2622 0 1332 1398 1399 +2673 2 3 0 2623 0 1399 1333 1332 +2674 2 3 0 2624 0 1334 1333 1399 +2675 2 3 0 2625 0 1400 1334 1399 +2676 2 3 0 2626 0 1401 1334 1400 +2677 2 3 0 2627 0 1335 1334 1401 +2678 2 3 0 2628 0 1336 1335 1401 +2679 2 3 0 2629 0 1336 1401 1402 +2680 2 3 0 2630 0 1403 1336 1402 +2681 2 3 0 2631 0 1403 1338 1336 +2682 2 3 0 2632 0 1338 1337 1336 +2683 2 3 0 2633 0 1404 1338 1403 +2684 2 3 0 2634 0 1338 1404 1339 +2685 2 3 0 2635 0 1339 1404 1405 +2686 2 3 0 2636 0 1405 1341 1339 +2687 2 3 0 2637 0 1341 1340 1339 +2688 2 3 0 2638 0 1406 1341 1405 +2689 2 3 0 2639 0 1342 1341 1406 +2690 2 3 0 2640 0 1342 1406 1407 +2691 2 3 0 2641 0 1407 1344 1342 +2692 2 3 0 2642 0 1344 1343 1342 +2693 2 3 0 2643 0 1344 1407 1408 +2694 2 3 0 2644 0 1345 1344 1408 +2695 2 3 0 2645 0 1345 1408 1409 +2696 2 3 0 2646 0 1409 1410 1345 +2697 2 3 0 2647 0 1410 1346 1345 +2698 2 3 0 2648 0 1347 1346 1410 +2699 2 3 0 2649 0 1411 1347 1410 +2700 2 3 0 2650 0 1347 1411 1412 +2701 2 3 0 2651 0 1348 1347 1412 +2702 2 3 0 2652 0 1348 1412 1349 +2703 2 3 0 2653 0 1412 1413 1349 +2704 2 3 0 2654 0 1413 1414 1349 +2705 2 3 0 2655 0 1414 1350 1349 +2706 2 3 0 2656 0 1351 1350 1414 +2707 2 3 0 2657 0 1415 1351 1414 +2708 2 3 0 2658 0 1352 1359 1360 +2709 2 3 0 2659 0 1354 1353 1416 +2710 2 3 0 2660 0 1417 1354 1416 +2711 2 3 0 2661 0 1418 1354 1417 +2712 2 3 0 2662 0 1418 1355 1354 +2713 2 3 0 2663 0 1419 1355 1418 +2714 2 3 0 2664 0 1419 1356 1355 +2715 2 3 0 2665 0 1356 1419 1420 +2716 2 3 0 2666 0 1420 1357 1356 +2717 2 3 0 2667 0 1420 1358 1357 +2718 2 3 0 2668 0 1420 1421 1358 +2719 2 3 0 2669 0 1422 1358 1421 +2720 2 3 0 2670 0 1422 1359 1358 +2721 2 3 0 2671 0 1423 1359 1422 +2722 2 3 0 2672 0 1423 1360 1359 +2723 2 3 0 2673 0 1424 1360 1423 +2724 2 3 0 2674 0 1424 1361 1360 +2725 2 3 0 2675 0 1425 1361 1424 +2726 2 3 0 2676 0 1425 1426 1361 +2727 2 3 0 2677 0 1361 1426 1362 +2728 2 3 0 2678 0 1426 1427 1362 +2729 2 3 0 2679 0 1362 1427 1363 +2730 2 3 0 2680 0 1428 1363 1427 +2731 2 3 0 2681 0 1428 1429 1363 +2732 2 3 0 2682 0 1364 1363 1429 +2733 2 3 0 2683 0 1430 1364 1429 +2734 2 3 0 2684 0 1364 1430 1365 +2735 2 3 0 2685 0 1430 1366 1365 +2736 2 3 0 2686 0 1366 1430 1431 +2737 2 3 0 2687 0 1432 1366 1431 +2738 2 3 0 2688 0 1433 1366 1432 +2739 2 3 0 2689 0 1433 1367 1366 +2740 2 3 0 2690 0 1368 1367 1433 +2741 2 3 0 2691 0 1434 1368 1433 +2742 2 3 0 2692 0 1369 1368 1434 +2743 2 3 0 2693 0 1369 1434 1435 +2744 2 3 0 2694 0 1370 1369 1435 +2745 2 3 0 2695 0 1370 1435 1436 +2746 2 3 0 2696 0 1371 1370 1436 +2747 2 3 0 2697 0 1371 1436 1437 +2748 2 3 0 2698 0 1437 1438 1371 +2749 2 3 0 2699 0 1438 1439 1371 +2750 2 3 0 2700 0 1371 1439 1372 +2751 2 3 0 2701 0 1439 1373 1372 +2752 2 3 0 2702 0 1440 1373 1439 +2753 2 3 0 2703 0 1441 1373 1440 +2754 2 3 0 2704 0 1442 1373 1441 +2755 2 3 0 2705 0 1373 1442 1374 +2756 2 3 0 2706 0 1442 1375 1374 +2757 2 3 0 2707 0 1443 1375 1442 +2758 2 3 0 2708 0 1444 1375 1443 +2759 2 3 0 2709 0 1376 1375 1444 +2760 2 3 0 2710 0 1444 1445 1376 +2761 2 3 0 2711 0 1445 1377 1376 +2762 2 3 0 2712 0 1377 1445 1446 +2763 2 3 0 2713 0 1447 1377 1446 +2764 2 3 0 2714 0 1378 1377 1447 +2765 2 3 0 2715 0 1379 1378 1447 +2766 2 3 0 2716 0 1447 1448 1379 +2767 2 3 0 2717 0 1448 1449 1379 +2768 2 3 0 2718 0 1380 1379 1449 +2769 2 3 0 2719 0 1381 1380 1449 +2770 2 3 0 2720 0 1381 1449 1450 +2771 2 3 0 2721 0 1382 1381 1450 +2772 2 3 0 2722 0 1382 1450 1451 +2773 2 3 0 2723 0 1382 1451 1383 +2774 2 3 0 2724 0 1451 1452 1383 +2775 2 3 0 2725 0 1385 1383 1452 +2776 2 3 0 2726 0 1385 1384 1383 +2777 2 3 0 2727 0 1452 1453 1385 +2778 2 3 0 2728 0 1453 1386 1385 +2779 2 3 0 2729 0 1386 1453 1454 +2780 2 3 0 2730 0 1387 1386 1454 +2781 2 3 0 2731 0 1387 1454 1455 +2782 2 3 0 2732 0 1387 1455 1456 +2783 2 3 0 2733 0 1388 1387 1456 +2784 2 3 0 2734 0 1389 1388 1456 +2785 2 3 0 2735 0 1389 1456 1457 +2786 2 3 0 2736 0 1390 1389 1457 +2787 2 3 0 2737 0 1390 1457 1392 +2788 2 3 0 2738 0 1391 1390 1392 +2789 2 3 0 2739 0 1392 1457 1458 +2790 2 3 0 2740 0 1392 1458 1459 +2791 2 3 0 2741 0 1393 1392 1459 +2792 2 3 0 2742 0 1393 1459 1394 +2793 2 3 0 2743 0 1460 1394 1459 +2794 2 3 0 2744 0 1461 1394 1460 +2795 2 3 0 2745 0 1461 1462 1394 +2796 2 3 0 2746 0 1462 1395 1394 +2797 2 3 0 2747 0 1396 1395 1462 +2798 2 3 0 2748 0 1463 1396 1462 +2799 2 3 0 2749 0 1397 1396 1463 +2800 2 3 0 2750 0 1397 1463 1464 +2801 2 3 0 2751 0 1397 1464 1465 +2802 2 3 0 2752 0 1397 1465 1466 +2803 2 3 0 2753 0 1398 1397 1466 +2804 2 3 0 2754 0 1398 1466 1467 +2805 2 3 0 2755 0 1399 1398 1467 +2806 2 3 0 2756 0 1399 1467 1468 +2807 2 3 0 2757 0 1468 1400 1399 +2808 2 3 0 2758 0 1469 1400 1468 +2809 2 3 0 2759 0 1469 1470 1400 +2810 2 3 0 2760 0 1470 1401 1400 +2811 2 3 0 2761 0 1402 1401 1470 +2812 2 3 0 2762 0 1402 1470 1471 +2813 2 3 0 2763 0 1402 1471 1472 +2814 2 3 0 2764 0 1472 1403 1402 +2815 2 3 0 2765 0 1473 1403 1472 +2816 2 3 0 2766 0 1473 1474 1403 +2817 2 3 0 2767 0 1474 1404 1403 +2818 2 3 0 2768 0 1404 1474 1475 +2819 2 3 0 2769 0 1404 1475 1405 +2820 2 3 0 2770 0 1476 1405 1475 +2821 2 3 0 2771 0 1476 1477 1405 +2822 2 3 0 2772 0 1477 1406 1405 +2823 2 3 0 2773 0 1406 1477 1478 +2824 2 3 0 2774 0 1406 1478 1407 +2825 2 3 0 2775 0 1479 1407 1478 +2826 2 3 0 2776 0 1407 1479 1408 +2827 2 3 0 2777 0 1408 1479 1480 +2828 2 3 0 2778 0 1408 1480 1481 +2829 2 3 0 2779 0 1408 1481 1409 +2830 2 3 0 2780 0 1409 1481 1482 +2831 2 3 0 2781 0 1482 1483 1409 +2832 2 3 0 2782 0 1483 1410 1409 +2833 2 3 0 2783 0 1411 1410 1483 +2834 2 3 0 2784 0 1484 1411 1483 +2835 2 3 0 2785 0 1484 1413 1411 +2836 2 3 0 2786 0 1413 1412 1411 +2837 2 3 0 2787 0 1413 1484 1485 +2838 2 3 0 2788 0 1413 1485 1414 +2839 2 3 0 2789 0 1485 1415 1414 +2840 2 3 0 2790 0 1486 1415 1485 +2841 2 3 0 2791 0 1486 1487 1415 +2842 2 3 0 2792 0 1417 1416 1488 +2843 2 3 0 2793 0 1488 1489 1417 +2844 2 3 0 2794 0 1489 1418 1417 +2845 2 3 0 2795 0 1489 1490 1418 +2846 2 3 0 2796 0 1418 1490 1419 +2847 2 3 0 2797 0 1419 1490 1491 +2848 2 3 0 2798 0 1419 1491 1492 +2849 2 3 0 2799 0 1419 1492 1420 +2850 2 3 0 2800 0 1420 1492 1421 +2851 2 3 0 2801 0 1421 1492 1493 +2852 2 3 0 2802 0 1421 1493 1494 +2853 2 3 0 2803 0 1494 1422 1421 +2854 2 3 0 2804 0 1495 1422 1494 +2855 2 3 0 2805 0 1495 1423 1422 +2856 2 3 0 2806 0 1423 1495 1496 +2857 2 3 0 2807 0 1424 1423 1496 +2858 2 3 0 2808 0 1497 1424 1496 +2859 2 3 0 2809 0 1425 1424 1497 +2860 2 3 0 2810 0 1498 1425 1497 +2861 2 3 0 2811 0 1499 1425 1498 +2862 2 3 0 2812 0 1499 1426 1425 +2863 2 3 0 2813 0 1426 1499 1500 +2864 2 3 0 2814 0 1426 1500 1427 +2865 2 3 0 2815 0 1500 1428 1427 +2866 2 3 0 2816 0 1501 1428 1500 +2867 2 3 0 2817 0 1502 1428 1501 +2868 2 3 0 2818 0 1502 1429 1428 +2869 2 3 0 2819 0 1502 1503 1429 +2870 2 3 0 2820 0 1430 1429 1503 +2871 2 3 0 2821 0 1503 1431 1430 +2872 2 3 0 2822 0 1504 1431 1503 +2873 2 3 0 2823 0 1504 1432 1431 +2874 2 3 0 2824 0 1432 1504 1505 +2875 2 3 0 2825 0 1506 1432 1505 +2876 2 3 0 2826 0 1506 1507 1432 +2877 2 3 0 2827 0 1433 1432 1507 +2878 2 3 0 2828 0 1507 1508 1433 +2879 2 3 0 2829 0 1433 1508 1434 +2880 2 3 0 2830 0 1508 1435 1434 +2881 2 3 0 2831 0 1435 1508 1509 +2882 2 3 0 2832 0 1509 1510 1435 +2883 2 3 0 2833 0 1510 1436 1435 +2884 2 3 0 2834 0 1510 1437 1436 +2885 2 3 0 2835 0 1510 1511 1437 +2886 2 3 0 2836 0 1511 1512 1437 +2887 2 3 0 2837 0 1437 1512 1438 +2888 2 3 0 2838 0 1513 1438 1512 +2889 2 3 0 2839 0 1438 1513 1440 +2890 2 3 0 2840 0 1438 1440 1439 +2891 2 3 0 2841 0 1513 1514 1440 +2892 2 3 0 2842 0 1441 1440 1514 +2893 2 3 0 2843 0 1515 1441 1514 +2894 2 3 0 2844 0 1441 1515 1443 +2895 2 3 0 2845 0 1441 1443 1442 +2896 2 3 0 2846 0 1515 1516 1443 +2897 2 3 0 2847 0 1516 1444 1443 +2898 2 3 0 2848 0 1517 1444 1516 +2899 2 3 0 2849 0 1517 1445 1444 +2900 2 3 0 2850 0 1517 1518 1445 +2901 2 3 0 2851 0 1446 1445 1518 +2902 2 3 0 2852 0 1518 1519 1446 +2903 2 3 0 2853 0 1519 1447 1446 +2904 2 3 0 2854 0 1447 1519 1448 +2905 2 3 0 2855 0 1520 1448 1519 +2906 2 3 0 2856 0 1520 1521 1448 +2907 2 3 0 2857 0 1449 1448 1521 +2908 2 3 0 2858 0 1450 1449 1521 +2909 2 3 0 2859 0 1521 1522 1450 +2910 2 3 0 2860 0 1451 1450 1522 +2911 2 3 0 2861 0 1451 1522 1523 +2912 2 3 0 2862 0 1523 1452 1451 +2913 2 3 0 2863 0 1452 1523 1524 +2914 2 3 0 2864 0 1453 1452 1524 +2915 2 3 0 2865 0 1453 1524 1525 +2916 2 3 0 2866 0 1453 1525 1526 +2917 2 3 0 2867 0 1454 1453 1526 +2918 2 3 0 2868 0 1527 1454 1526 +2919 2 3 0 2869 0 1455 1454 1527 +2920 2 3 0 2870 0 1528 1455 1527 +2921 2 3 0 2871 0 1529 1455 1528 +2922 2 3 0 2872 0 1456 1455 1529 +2923 2 3 0 2873 0 1457 1456 1529 +2924 2 3 0 2874 0 1457 1529 1458 +2925 2 3 0 2875 0 1530 1458 1529 +2926 2 3 0 2876 0 1531 1458 1530 +2927 2 3 0 2877 0 1458 1531 1532 +2928 2 3 0 2878 0 1458 1532 1459 +2929 2 3 0 2879 0 1459 1532 1533 +2930 2 3 0 2880 0 1533 1460 1459 +2931 2 3 0 2881 0 1460 1533 1534 +2932 2 3 0 2882 0 1534 1461 1460 +2933 2 3 0 2883 0 1534 1535 1461 +2934 2 3 0 2884 0 1461 1535 1536 +2935 2 3 0 2885 0 1462 1461 1536 +2936 2 3 0 2886 0 1536 1463 1462 +2937 2 3 0 2887 0 1463 1536 1537 +2938 2 3 0 2888 0 1464 1463 1537 +2939 2 3 0 2889 0 1538 1464 1537 +2940 2 3 0 2890 0 1538 1465 1464 +2941 2 3 0 2891 0 1538 1539 1465 +2942 2 3 0 2892 0 1465 1539 1540 +2943 2 3 0 2893 0 1466 1465 1540 +2944 2 3 0 2894 0 1467 1466 1540 +2945 2 3 0 2895 0 1467 1540 1541 +2946 2 3 0 2896 0 1467 1541 1468 +2947 2 3 0 2897 0 1468 1541 1542 +2948 2 3 0 2898 0 1469 1468 1542 +2949 2 3 0 2899 0 1543 1469 1542 +2950 2 3 0 2900 0 1543 1544 1469 +2951 2 3 0 2901 0 1469 1544 1471 +2952 2 3 0 2902 0 1470 1469 1471 +2953 2 3 0 2903 0 1545 1471 1544 +2954 2 3 0 2904 0 1472 1471 1545 +2955 2 3 0 2905 0 1472 1545 1473 +2956 2 3 0 2906 0 1473 1545 1546 +2957 2 3 0 2907 0 1546 1474 1473 +2958 2 3 0 2908 0 1546 1547 1474 +2959 2 3 0 2909 0 1474 1547 1475 +2960 2 3 0 2910 0 1548 1475 1547 +2961 2 3 0 2911 0 1548 1476 1475 +2962 2 3 0 2912 0 1549 1476 1548 +2963 2 3 0 2913 0 1549 1550 1476 +2964 2 3 0 2914 0 1550 1477 1476 +2965 2 3 0 2915 0 1477 1550 1478 +2966 2 3 0 2916 0 1478 1550 1551 +2967 2 3 0 2917 0 1551 1479 1478 +2968 2 3 0 2918 0 1552 1479 1551 +2969 2 3 0 2919 0 1552 1480 1479 +2970 2 3 0 2920 0 1553 1480 1552 +2971 2 3 0 2921 0 1480 1553 1554 +2972 2 3 0 2922 0 1481 1480 1554 +2973 2 3 0 2923 0 1481 1554 1482 +2974 2 3 0 2924 0 1555 1482 1554 +2975 2 3 0 2925 0 1556 1482 1555 +2976 2 3 0 2926 0 1556 1483 1482 +2977 2 3 0 2927 0 1556 1557 1483 +2978 2 3 0 2928 0 1557 1484 1483 +2979 2 3 0 2929 0 1558 1484 1557 +2980 2 3 0 2930 0 1484 1558 1485 +2981 2 3 0 2931 0 1486 1485 1558 +2982 2 3 0 2932 0 1559 1486 1558 +2983 2 3 0 2933 0 1486 1559 1487 +2984 2 3 0 2934 0 1560 1487 1559 +2985 2 3 0 2935 0 1488 1562 1561 +2986 2 3 0 2936 0 1561 1489 1488 +2987 2 3 0 2937 0 1563 1489 1561 +2988 2 3 0 2938 0 1490 1489 1563 +2989 2 3 0 2939 0 1490 1563 1491 +2990 2 3 0 2940 0 1563 1564 1491 +2991 2 3 0 2941 0 1493 1491 1564 +2992 2 3 0 2942 0 1493 1492 1491 +2993 2 3 0 2943 0 1565 1493 1564 +2994 2 3 0 2944 0 1493 1565 1566 +2995 2 3 0 2945 0 1493 1566 1494 +2996 2 3 0 2946 0 1567 1494 1566 +2997 2 3 0 2947 0 1567 1495 1494 +2998 2 3 0 2948 0 1495 1567 1568 +2999 2 3 0 2949 0 1495 1568 1496 +3000 2 3 0 2950 0 1497 1496 1568 +3001 2 3 0 2951 0 1568 1569 1497 +3002 2 3 0 2952 0 1497 1569 1498 +3003 2 3 0 2953 0 1569 1570 1498 +3004 2 3 0 2954 0 1570 1571 1498 +3005 2 3 0 2955 0 1498 1571 1499 +3006 2 3 0 2956 0 1499 1571 1572 +3007 2 3 0 2957 0 1499 1572 1500 +3008 2 3 0 2958 0 1501 1500 1572 +3009 2 3 0 2959 0 1573 1501 1572 +3010 2 3 0 2960 0 1502 1501 1573 +3011 2 3 0 2961 0 1574 1502 1573 +3012 2 3 0 2962 0 1575 1502 1574 +3013 2 3 0 2963 0 1575 1503 1502 +3014 2 3 0 2964 0 1504 1503 1575 +3015 2 3 0 2965 0 1575 1576 1504 +3016 2 3 0 2966 0 1576 1505 1504 +3017 2 3 0 2967 0 1577 1505 1576 +3018 2 3 0 2968 0 1506 1505 1577 +3019 2 3 0 2969 0 1578 1506 1577 +3020 2 3 0 2970 0 1579 1506 1578 +3021 2 3 0 2971 0 1579 1507 1506 +3022 2 3 0 2972 0 1509 1507 1579 +3023 2 3 0 2973 0 1509 1508 1507 +3024 2 3 0 2974 0 1579 1580 1509 +3025 2 3 0 2975 0 1580 1510 1509 +3026 2 3 0 2976 0 1580 1511 1510 +3027 2 3 0 2977 0 1580 1581 1511 +3028 2 3 0 2978 0 1582 1511 1581 +3029 2 3 0 2979 0 1511 1582 1512 +3030 2 3 0 2980 0 1582 1583 1512 +3031 2 3 0 2981 0 1583 1584 1512 +3032 2 3 0 2982 0 1513 1512 1584 +3033 2 3 0 2983 0 1584 1585 1513 +3034 2 3 0 2984 0 1586 1513 1585 +3035 2 3 0 2985 0 1586 1514 1513 +3036 2 3 0 2986 0 1586 1587 1514 +3037 2 3 0 2987 0 1515 1514 1587 +3038 2 3 0 2988 0 1588 1515 1587 +3039 2 3 0 2989 0 1515 1588 1516 +3040 2 3 0 2990 0 1588 1589 1516 +3041 2 3 0 2991 0 1589 1517 1516 +3042 2 3 0 2992 0 1589 1590 1517 +3043 2 3 0 2993 0 1590 1518 1517 +3044 2 3 0 2994 0 1590 1591 1518 +3045 2 3 0 2995 0 1518 1591 1519 +3046 2 3 0 2996 0 1592 1519 1591 +3047 2 3 0 2997 0 1592 1520 1519 +3048 2 3 0 2998 0 1592 1593 1520 +3049 2 3 0 2999 0 1593 1594 1520 +3050 2 3 0 3000 0 1594 1521 1520 +3051 2 3 0 3001 0 1594 1522 1521 +3052 2 3 0 3002 0 1594 1595 1522 +3053 2 3 0 3003 0 1596 1522 1595 +3054 2 3 0 3004 0 1523 1522 1596 +3055 2 3 0 3005 0 1523 1596 1597 +3056 2 3 0 3006 0 1523 1597 1524 +3057 2 3 0 3007 0 1524 1597 1598 +3058 2 3 0 3008 0 1524 1598 1599 +3059 2 3 0 3009 0 1524 1599 1525 +3060 2 3 0 3010 0 1525 1599 1600 +3061 2 3 0 3011 0 1525 1600 1601 +3062 2 3 0 3012 0 1602 1525 1601 +3063 2 3 0 3013 0 1525 1602 1526 +3064 2 3 0 3014 0 1527 1526 1602 +3065 2 3 0 3015 0 1527 1602 1603 +3066 2 3 0 3016 0 1528 1527 1603 +3067 2 3 0 3017 0 1528 1603 1604 +3068 2 3 0 3018 0 1528 1604 1605 +3069 2 3 0 3019 0 1530 1528 1605 +3070 2 3 0 3020 0 1529 1528 1530 +3071 2 3 0 3021 0 1531 1530 1605 +3072 2 3 0 3022 0 1531 1605 1606 +3073 2 3 0 3023 0 1531 1606 1607 +3074 2 3 0 3024 0 1532 1531 1607 +3075 2 3 0 3025 0 1607 1533 1532 +3076 2 3 0 3026 0 1607 1608 1533 +3077 2 3 0 3027 0 1533 1608 1534 +3078 2 3 0 3028 0 1534 1608 1609 +3079 2 3 0 3029 0 1534 1609 1610 +3080 2 3 0 3030 0 1535 1534 1610 +3081 2 3 0 3031 0 1535 1610 1611 +3082 2 3 0 3032 0 1536 1535 1611 +3083 2 3 0 3033 0 1536 1611 1537 +3084 2 3 0 3034 0 1537 1611 1612 +3085 2 3 0 3035 0 1537 1612 1613 +3086 2 3 0 3036 0 1613 1538 1537 +3087 2 3 0 3037 0 1538 1613 1614 +3088 2 3 0 3038 0 1538 1614 1615 +3089 2 3 0 3039 0 1539 1538 1615 +3090 2 3 0 3040 0 1539 1615 1616 +3091 2 3 0 3041 0 1616 1540 1539 +3092 2 3 0 3042 0 1616 1617 1540 +3093 2 3 0 3043 0 1617 1541 1540 +3094 2 3 0 3044 0 1617 1542 1541 +3095 2 3 0 3045 0 1542 1617 1618 +3096 2 3 0 3046 0 1542 1618 1543 +3097 2 3 0 3047 0 1543 1618 1619 +3098 2 3 0 3048 0 1543 1619 1620 +3099 2 3 0 3049 0 1620 1621 1543 +3100 2 3 0 3050 0 1621 1544 1543 +3101 2 3 0 3051 0 1621 1545 1544 +3102 2 3 0 3052 0 1545 1621 1622 +3103 2 3 0 3053 0 1545 1622 1546 +3104 2 3 0 3054 0 1623 1546 1622 +3105 2 3 0 3055 0 1623 1547 1546 +3106 2 3 0 3056 0 1623 1548 1547 +3107 2 3 0 3057 0 1548 1623 1624 +3108 2 3 0 3058 0 1624 1549 1548 +3109 2 3 0 3059 0 1625 1549 1624 +3110 2 3 0 3060 0 1625 1626 1549 +3111 2 3 0 3061 0 1626 1627 1549 +3112 2 3 0 3062 0 1627 1550 1549 +3113 2 3 0 3063 0 1550 1627 1551 +3114 2 3 0 3064 0 1551 1627 1552 +3115 2 3 0 3065 0 1627 1628 1552 +3116 2 3 0 3066 0 1552 1628 1629 +3117 2 3 0 3067 0 1629 1553 1552 +3118 2 3 0 3068 0 1630 1553 1629 +3119 2 3 0 3069 0 1630 1554 1553 +3120 2 3 0 3070 0 1630 1631 1554 +3121 2 3 0 3071 0 1554 1631 1555 +3122 2 3 0 3072 0 1555 1631 1632 +3123 2 3 0 3073 0 1555 1632 1633 +3124 2 3 0 3074 0 1633 1634 1555 +3125 2 3 0 3075 0 1556 1555 1634 +3126 2 3 0 3076 0 1634 1557 1556 +3127 2 3 0 3077 0 1634 1558 1557 +3128 2 3 0 3078 0 1558 1634 1559 +3129 2 3 0 3079 0 1634 1635 1559 +3130 2 3 0 3080 0 1559 1635 1560 +3131 2 3 0 3081 0 1636 1560 1635 +3132 2 3 0 3082 0 1561 1562 1637 +3133 2 3 0 3083 0 1638 1561 1637 +3134 2 3 0 3084 0 1563 1561 1638 +3135 2 3 0 3085 0 1562 1639 1637 +3136 2 3 0 3086 0 1564 1563 1638 +3137 2 3 0 3087 0 1640 1564 1638 +3138 2 3 0 3088 0 1565 1564 1640 +3139 2 3 0 3089 0 1641 1565 1640 +3140 2 3 0 3090 0 1642 1565 1641 +3141 2 3 0 3091 0 1565 1642 1566 +3142 2 3 0 3092 0 1567 1566 1642 +3143 2 3 0 3093 0 1643 1567 1642 +3144 2 3 0 3094 0 1567 1643 1644 +3145 2 3 0 3095 0 1567 1644 1568 +3146 2 3 0 3096 0 1568 1644 1569 +3147 2 3 0 3097 0 1645 1569 1644 +3148 2 3 0 3098 0 1569 1645 1570 +3149 2 3 0 3099 0 1645 1646 1570 +3150 2 3 0 3100 0 1570 1646 1647 +3151 2 3 0 3101 0 1570 1647 1571 +3152 2 3 0 3102 0 1571 1647 1572 +3153 2 3 0 3103 0 1647 1648 1572 +3154 2 3 0 3104 0 1573 1572 1648 +3155 2 3 0 3105 0 1649 1573 1648 +3156 2 3 0 3106 0 1574 1573 1649 +3157 2 3 0 3107 0 1650 1574 1649 +3158 2 3 0 3108 0 1650 1651 1574 +3159 2 3 0 3109 0 1574 1651 1575 +3160 2 3 0 3110 0 1575 1651 1576 +3161 2 3 0 3111 0 1576 1651 1652 +3162 2 3 0 3112 0 1653 1576 1652 +3163 2 3 0 3113 0 1577 1576 1653 +3164 2 3 0 3114 0 1577 1653 1654 +3165 2 3 0 3115 0 1577 1654 1578 +3166 2 3 0 3116 0 1654 1655 1578 +3167 2 3 0 3117 0 1655 1656 1578 +3168 2 3 0 3118 0 1578 1656 1579 +3169 2 3 0 3119 0 1579 1656 1580 +3170 2 3 0 3120 0 1656 1657 1580 +3171 2 3 0 3121 0 1657 1581 1580 +3172 2 3 0 3122 0 1657 1658 1581 +3173 2 3 0 3123 0 1658 1659 1581 +3174 2 3 0 3124 0 1582 1581 1659 +3175 2 3 0 3125 0 1583 1582 1659 +3176 2 3 0 3126 0 1583 1659 1660 +3177 2 3 0 3127 0 1660 1661 1583 +3178 2 3 0 3128 0 1583 1661 1584 +3179 2 3 0 3129 0 1661 1585 1584 +3180 2 3 0 3130 0 1661 1662 1585 +3181 2 3 0 3131 0 1662 1663 1585 +3182 2 3 0 3132 0 1586 1585 1663 +3183 2 3 0 3133 0 1586 1663 1664 +3184 2 3 0 3134 0 1586 1664 1587 +3185 2 3 0 3135 0 1664 1665 1587 +3186 2 3 0 3136 0 1588 1587 1665 +3187 2 3 0 3137 0 1589 1588 1665 +3188 2 3 0 3138 0 1589 1665 1666 +3189 2 3 0 3139 0 1666 1667 1589 +3190 2 3 0 3140 0 1589 1667 1590 +3191 2 3 0 3141 0 1667 1668 1590 +3192 2 3 0 3142 0 1668 1669 1590 +3193 2 3 0 3143 0 1590 1669 1591 +3194 2 3 0 3144 0 1670 1591 1669 +3195 2 3 0 3145 0 1592 1591 1670 +3196 2 3 0 3146 0 1592 1670 1671 +3197 2 3 0 3147 0 1593 1592 1671 +3198 2 3 0 3148 0 1671 1672 1593 +3199 2 3 0 3149 0 1672 1594 1593 +3200 2 3 0 3150 0 1595 1594 1672 +3201 2 3 0 3151 0 1595 1672 1673 +3202 2 3 0 3152 0 1674 1595 1673 +3203 2 3 0 3153 0 1596 1595 1674 +3204 2 3 0 3154 0 1674 1675 1596 +3205 2 3 0 3155 0 1675 1597 1596 +3206 2 3 0 3156 0 1675 1598 1597 +3207 2 3 0 3157 0 1675 1676 1598 +3208 2 3 0 3158 0 1676 1677 1598 +3209 2 3 0 3159 0 1677 1599 1598 +3210 2 3 0 3160 0 1677 1600 1599 +3211 2 3 0 3161 0 1677 1678 1600 +3212 2 3 0 3162 0 1600 1678 1679 +3213 2 3 0 3163 0 1601 1600 1679 +3214 2 3 0 3164 0 1680 1601 1679 +3215 2 3 0 3165 0 1601 1680 1602 +3216 2 3 0 3166 0 1680 1603 1602 +3217 2 3 0 3167 0 1680 1681 1603 +3218 2 3 0 3168 0 1604 1603 1681 +3219 2 3 0 3169 0 1604 1681 1682 +3220 2 3 0 3170 0 1605 1604 1682 +3221 2 3 0 3171 0 1605 1682 1683 +3222 2 3 0 3172 0 1606 1605 1683 +3223 2 3 0 3173 0 1606 1683 1684 +3224 2 3 0 3174 0 1607 1606 1684 +3225 2 3 0 3175 0 1684 1685 1607 +3226 2 3 0 3176 0 1685 1608 1607 +3227 2 3 0 3177 0 1608 1685 1609 +3228 2 3 0 3178 0 1686 1609 1685 +3229 2 3 0 3179 0 1686 1687 1609 +3230 2 3 0 3180 0 1609 1687 1688 +3231 2 3 0 3181 0 1610 1609 1688 +3232 2 3 0 3182 0 1611 1610 1688 +3233 2 3 0 3183 0 1611 1688 1612 +3234 2 3 0 3184 0 1689 1612 1688 +3235 2 3 0 3185 0 1689 1690 1612 +3236 2 3 0 3186 0 1613 1612 1690 +3237 2 3 0 3187 0 1613 1690 1614 +3238 2 3 0 3188 0 1614 1690 1691 +3239 2 3 0 3189 0 1614 1691 1692 +3240 2 3 0 3190 0 1614 1692 1693 +3241 2 3 0 3191 0 1615 1614 1693 +3242 2 3 0 3192 0 1615 1693 1694 +3243 2 3 0 3193 0 1616 1615 1694 +3244 2 3 0 3194 0 1694 1617 1616 +3245 2 3 0 3195 0 1694 1695 1617 +3246 2 3 0 3196 0 1617 1695 1618 +3247 2 3 0 3197 0 1618 1695 1619 +3248 2 3 0 3198 0 1695 1696 1619 +3249 2 3 0 3199 0 1619 1696 1697 +3250 2 3 0 3200 0 1620 1619 1697 +3251 2 3 0 3201 0 1620 1697 1698 +3252 2 3 0 3202 0 1698 1621 1620 +3253 2 3 0 3203 0 1622 1621 1698 +3254 2 3 0 3204 0 1699 1622 1698 +3255 2 3 0 3205 0 1700 1622 1699 +3256 2 3 0 3206 0 1700 1623 1622 +3257 2 3 0 3207 0 1624 1623 1700 +3258 2 3 0 3208 0 1624 1700 1701 +3259 2 3 0 3209 0 1624 1701 1625 +3260 2 3 0 3210 0 1625 1701 1702 +3261 2 3 0 3211 0 1625 1702 1703 +3262 2 3 0 3212 0 1703 1626 1625 +3263 2 3 0 3213 0 1703 1704 1626 +3264 2 3 0 3214 0 1626 1704 1628 +3265 2 3 0 3215 0 1627 1626 1628 +3266 2 3 0 3216 0 1705 1628 1704 +3267 2 3 0 3217 0 1628 1705 1629 +3268 2 3 0 3218 0 1629 1705 1706 +3269 2 3 0 3219 0 1707 1629 1706 +3270 2 3 0 3220 0 1707 1630 1629 +3271 2 3 0 3221 0 1707 1708 1630 +3272 2 3 0 3222 0 1631 1630 1708 +3273 2 3 0 3223 0 1631 1708 1632 +3274 2 3 0 3224 0 1632 1708 1709 +3275 2 3 0 3225 0 1632 1709 1710 +3276 2 3 0 3226 0 1633 1632 1710 +3277 2 3 0 3227 0 1633 1710 1635 +3278 2 3 0 3228 0 1634 1633 1635 +3279 2 3 0 3229 0 1635 1710 1636 +3280 2 3 0 3230 0 1711 1636 1710 +3281 2 3 0 3231 0 1639 1712 1637 +3282 2 3 0 3232 0 1637 1712 1638 +3283 2 3 0 3233 0 1638 1712 1640 +3284 2 3 0 3234 0 1713 1712 1639 +3285 2 3 0 3235 0 1712 1714 1640 +3286 2 3 0 3236 0 1640 1714 1641 +3287 2 3 0 3237 0 1714 1715 1641 +3288 2 3 0 3238 0 1641 1715 1716 +3289 2 3 0 3239 0 1716 1642 1641 +3290 2 3 0 3240 0 1717 1642 1716 +3291 2 3 0 3241 0 1643 1642 1717 +3292 2 3 0 3242 0 1718 1643 1717 +3293 2 3 0 3243 0 1718 1719 1643 +3294 2 3 0 3244 0 1643 1719 1644 +3295 2 3 0 3245 0 1645 1644 1719 +3296 2 3 0 3246 0 1645 1719 1720 +3297 2 3 0 3247 0 1646 1645 1720 +3298 2 3 0 3248 0 1721 1646 1720 +3299 2 3 0 3249 0 1647 1646 1721 +3300 2 3 0 3250 0 1722 1647 1721 +3301 2 3 0 3251 0 1647 1722 1648 +3302 2 3 0 3252 0 1722 1723 1648 +3303 2 3 0 3253 0 1649 1648 1723 +3304 2 3 0 3254 0 1724 1649 1723 +3305 2 3 0 3255 0 1650 1649 1724 +3306 2 3 0 3256 0 1725 1650 1724 +3307 2 3 0 3257 0 1725 1652 1650 +3308 2 3 0 3258 0 1652 1651 1650 +3309 2 3 0 3259 0 1725 1726 1652 +3310 2 3 0 3260 0 1653 1652 1726 +3311 2 3 0 3261 0 1727 1653 1726 +3312 2 3 0 3262 0 1654 1653 1727 +3313 2 3 0 3263 0 1727 1728 1654 +3314 2 3 0 3264 0 1655 1654 1728 +3315 2 3 0 3265 0 1729 1655 1728 +3316 2 3 0 3266 0 1729 1657 1655 +3317 2 3 0 3267 0 1655 1657 1656 +3318 2 3 0 3268 0 1729 1658 1657 +3319 2 3 0 3269 0 1729 1730 1658 +3320 2 3 0 3270 0 1730 1731 1658 +3321 2 3 0 3271 0 1660 1658 1731 +3322 2 3 0 3272 0 1660 1659 1658 +3323 2 3 0 3273 0 1660 1731 1732 +3324 2 3 0 3274 0 1733 1660 1732 +3325 2 3 0 3275 0 1660 1733 1661 +3326 2 3 0 3276 0 1733 1662 1661 +3327 2 3 0 3277 0 1733 1734 1662 +3328 2 3 0 3278 0 1734 1735 1662 +3329 2 3 0 3279 0 1736 1662 1735 +3330 2 3 0 3280 0 1736 1663 1662 +3331 2 3 0 3281 0 1664 1663 1736 +3332 2 3 0 3282 0 1664 1736 1737 +3333 2 3 0 3283 0 1738 1664 1737 +3334 2 3 0 3284 0 1665 1664 1738 +3335 2 3 0 3285 0 1666 1665 1738 +3336 2 3 0 3286 0 1738 1739 1666 +3337 2 3 0 3287 0 1739 1740 1666 +3338 2 3 0 3288 0 1666 1740 1667 +3339 2 3 0 3289 0 1740 1668 1667 +3340 2 3 0 3290 0 1740 1741 1668 +3341 2 3 0 3291 0 1668 1741 1742 +3342 2 3 0 3292 0 1743 1668 1742 +3343 2 3 0 3293 0 1668 1743 1669 +3344 2 3 0 3294 0 1743 1744 1669 +3345 2 3 0 3295 0 1670 1669 1744 +3346 2 3 0 3296 0 1671 1670 1744 +3347 2 3 0 3297 0 1671 1744 1745 +3348 2 3 0 3298 0 1746 1671 1745 +3349 2 3 0 3299 0 1671 1746 1672 +3350 2 3 0 3300 0 1746 1747 1672 +3351 2 3 0 3301 0 1747 1673 1672 +3352 2 3 0 3302 0 1673 1747 1748 +3353 2 3 0 3303 0 1749 1673 1748 +3354 2 3 0 3304 0 1674 1673 1749 +3355 2 3 0 3305 0 1749 1675 1674 +3356 2 3 0 3306 0 1749 1750 1675 +3357 2 3 0 3307 0 1676 1675 1750 +3358 2 3 0 3308 0 1676 1750 1751 +3359 2 3 0 3309 0 1677 1676 1751 +3360 2 3 0 3310 0 1677 1751 1752 +3361 2 3 0 3311 0 1752 1678 1677 +3362 2 3 0 3312 0 1752 1753 1678 +3363 2 3 0 3313 0 1753 1679 1678 +3364 2 3 0 3314 0 1753 1754 1679 +3365 2 3 0 3315 0 1755 1679 1754 +3366 2 3 0 3316 0 1680 1679 1755 +3367 2 3 0 3317 0 1680 1755 1756 +3368 2 3 0 3318 0 1681 1680 1756 +3369 2 3 0 3319 0 1756 1757 1681 +3370 2 3 0 3320 0 1757 1682 1681 +3371 2 3 0 3321 0 1757 1758 1682 +3372 2 3 0 3322 0 1682 1758 1683 +3373 2 3 0 3323 0 1759 1683 1758 +3374 2 3 0 3324 0 1684 1683 1759 +3375 2 3 0 3325 0 1684 1759 1760 +3376 2 3 0 3326 0 1760 1685 1684 +3377 2 3 0 3327 0 1760 1686 1685 +3378 2 3 0 3328 0 1686 1760 1761 +3379 2 3 0 3329 0 1687 1686 1761 +3380 2 3 0 3330 0 1687 1761 1762 +3381 2 3 0 3331 0 1687 1762 1763 +3382 2 3 0 3332 0 1763 1688 1687 +3383 2 3 0 3333 0 1763 1689 1688 +3384 2 3 0 3334 0 1764 1689 1763 +3385 2 3 0 3335 0 1690 1689 1764 +3386 2 3 0 3336 0 1690 1764 1691 +3387 2 3 0 3337 0 1691 1764 1765 +3388 2 3 0 3338 0 1691 1765 1692 +3389 2 3 0 3339 0 1692 1765 1766 +3390 2 3 0 3340 0 1692 1766 1767 +3391 2 3 0 3341 0 1767 1693 1692 +3392 2 3 0 3342 0 1767 1768 1693 +3393 2 3 0 3343 0 1694 1693 1768 +3394 2 3 0 3344 0 1694 1768 1769 +3395 2 3 0 3345 0 1695 1694 1769 +3396 2 3 0 3346 0 1695 1769 1696 +3397 2 3 0 3347 0 1696 1769 1770 +3398 2 3 0 3348 0 1696 1770 1771 +3399 2 3 0 3349 0 1696 1771 1697 +3400 2 3 0 3350 0 1772 1697 1771 +3401 2 3 0 3351 0 1772 1773 1697 +3402 2 3 0 3352 0 1773 1698 1697 +3403 2 3 0 3353 0 1773 1774 1698 +3404 2 3 0 3354 0 1774 1699 1698 +3405 2 3 0 3355 0 1699 1774 1775 +3406 2 3 0 3356 0 1775 1700 1699 +3407 2 3 0 3357 0 1776 1700 1775 +3408 2 3 0 3358 0 1700 1776 1701 +3409 2 3 0 3359 0 1701 1776 1702 +3410 2 3 0 3360 0 1776 1777 1702 +3411 2 3 0 3361 0 1778 1702 1777 +3412 2 3 0 3362 0 1778 1779 1702 +3413 2 3 0 3363 0 1779 1703 1702 +3414 2 3 0 3364 0 1779 1780 1703 +3415 2 3 0 3365 0 1780 1704 1703 +3416 2 3 0 3366 0 1780 1705 1704 +3417 2 3 0 3367 0 1705 1780 1706 +3418 2 3 0 3368 0 1780 1781 1706 +3419 2 3 0 3369 0 1782 1706 1781 +3420 2 3 0 3370 0 1706 1782 1707 +3421 2 3 0 3371 0 1707 1782 1783 +3422 2 3 0 3372 0 1783 1708 1707 +3423 2 3 0 3373 0 1783 1784 1708 +3424 2 3 0 3374 0 1708 1784 1709 +3425 2 3 0 3375 0 1709 1784 1785 +3426 2 3 0 3376 0 1711 1709 1785 +3427 2 3 0 3377 0 1710 1709 1711 +3428 2 3 0 3378 0 1711 1785 1786 +3429 2 3 0 3379 0 1787 1712 1713 +3430 2 3 0 3380 0 1714 1712 1787 +3431 2 3 0 3381 0 1787 1713 1788 +3432 2 3 0 3382 0 1789 1714 1787 +3433 2 3 0 3383 0 1714 1789 1715 +3434 2 3 0 3384 0 1789 1790 1715 +3435 2 3 0 3385 0 1791 1715 1790 +3436 2 3 0 3386 0 1791 1792 1715 +3437 2 3 0 3387 0 1715 1792 1716 +3438 2 3 0 3388 0 1716 1792 1793 +3439 2 3 0 3389 0 1716 1793 1717 +3440 2 3 0 3390 0 1717 1793 1718 +3441 2 3 0 3391 0 1793 1794 1718 +3442 2 3 0 3392 0 1718 1794 1795 +3443 2 3 0 3393 0 1718 1795 1720 +3444 2 3 0 3394 0 1720 1719 1718 +3445 2 3 0 3395 0 1720 1795 1721 +3446 2 3 0 3396 0 1795 1796 1721 +3447 2 3 0 3397 0 1721 1796 1722 +3448 2 3 0 3398 0 1797 1722 1796 +3449 2 3 0 3399 0 1722 1797 1723 +3450 2 3 0 3400 0 1724 1723 1797 +3451 2 3 0 3401 0 1797 1798 1724 +3452 2 3 0 3402 0 1724 1798 1725 +3453 2 3 0 3403 0 1799 1725 1798 +3454 2 3 0 3404 0 1725 1799 1726 +3455 2 3 0 3405 0 1799 1800 1726 +3456 2 3 0 3406 0 1726 1800 1727 +3457 2 3 0 3407 0 1800 1801 1727 +3458 2 3 0 3408 0 1727 1801 1728 +3459 2 3 0 3409 0 1802 1728 1801 +3460 2 3 0 3410 0 1729 1728 1802 +3461 2 3 0 3411 0 1729 1802 1803 +3462 2 3 0 3412 0 1730 1729 1803 +3463 2 3 0 3413 0 1730 1803 1804 +3464 2 3 0 3414 0 1805 1730 1804 +3465 2 3 0 3415 0 1730 1805 1731 +3466 2 3 0 3416 0 1805 1732 1731 +3467 2 3 0 3417 0 1805 1806 1732 +3468 2 3 0 3418 0 1806 1807 1732 +3469 2 3 0 3419 0 1732 1807 1734 +3470 2 3 0 3420 0 1732 1734 1733 +3471 2 3 0 3421 0 1807 1808 1734 +3472 2 3 0 3422 0 1734 1808 1735 +3473 2 3 0 3423 0 1809 1735 1808 +3474 2 3 0 3424 0 1736 1735 1809 +3475 2 3 0 3425 0 1737 1736 1809 +3476 2 3 0 3426 0 1809 1810 1737 +3477 2 3 0 3427 0 1810 1811 1737 +3478 2 3 0 3428 0 1737 1811 1812 +3479 2 3 0 3429 0 1737 1812 1738 +3480 2 3 0 3430 0 1812 1739 1738 +3481 2 3 0 3431 0 1812 1813 1739 +3482 2 3 0 3432 0 1813 1741 1739 +3483 2 3 0 3433 0 1739 1741 1740 +3484 2 3 0 3434 0 1742 1741 1813 +3485 2 3 0 3435 0 1742 1813 1814 +3486 2 3 0 3436 0 1814 1815 1742 +3487 2 3 0 3437 0 1815 1743 1742 +3488 2 3 0 3438 0 1743 1815 1745 +3489 2 3 0 3439 0 1743 1745 1744 +3490 2 3 0 3440 0 1815 1816 1745 +3491 2 3 0 3441 0 1816 1817 1745 +3492 2 3 0 3442 0 1746 1745 1817 +3493 2 3 0 3443 0 1747 1746 1817 +3494 2 3 0 3444 0 1747 1817 1818 +3495 2 3 0 3445 0 1747 1818 1819 +3496 2 3 0 3446 0 1748 1747 1819 +3497 2 3 0 3447 0 1819 1820 1748 +3498 2 3 0 3448 0 1820 1821 1748 +3499 2 3 0 3449 0 1748 1821 1750 +3500 2 3 0 3450 0 1748 1750 1749 +3501 2 3 0 3451 0 1821 1822 1750 +3502 2 3 0 3452 0 1822 1751 1750 +3503 2 3 0 3453 0 1752 1751 1822 +3504 2 3 0 3454 0 1752 1822 1823 +3505 2 3 0 3455 0 1823 1753 1752 +3506 2 3 0 3456 0 1823 1824 1753 +3507 2 3 0 3457 0 1824 1825 1753 +3508 2 3 0 3458 0 1825 1754 1753 +3509 2 3 0 3459 0 1754 1825 1826 +3510 2 3 0 3460 0 1827 1754 1826 +3511 2 3 0 3461 0 1755 1754 1827 +3512 2 3 0 3462 0 1756 1755 1827 +3513 2 3 0 3463 0 1756 1827 1828 +3514 2 3 0 3464 0 1756 1828 1829 +3515 2 3 0 3465 0 1757 1756 1829 +3516 2 3 0 3466 0 1830 1757 1829 +3517 2 3 0 3467 0 1757 1830 1758 +3518 2 3 0 3468 0 1830 1759 1758 +3519 2 3 0 3469 0 1759 1830 1831 +3520 2 3 0 3470 0 1760 1759 1831 +3521 2 3 0 3471 0 1760 1831 1832 +3522 2 3 0 3472 0 1760 1832 1761 +3523 2 3 0 3473 0 1761 1832 1762 +3524 2 3 0 3474 0 1762 1832 1833 +3525 2 3 0 3475 0 1762 1833 1834 +3526 2 3 0 3476 0 1762 1834 1835 +3527 2 3 0 3477 0 1763 1762 1835 +3528 2 3 0 3478 0 1763 1835 1836 +3529 2 3 0 3479 0 1836 1764 1763 +3530 2 3 0 3480 0 1764 1836 1765 +3531 2 3 0 3481 0 1836 1837 1765 +3532 2 3 0 3482 0 1765 1837 1766 +3533 2 3 0 3483 0 1766 1837 1838 +3534 2 3 0 3484 0 1766 1838 1839 +3535 2 3 0 3485 0 1766 1839 1840 +3536 2 3 0 3486 0 1767 1766 1840 +3537 2 3 0 3487 0 1840 1841 1767 +3538 2 3 0 3488 0 1841 1768 1767 +3539 2 3 0 3489 0 1768 1841 1770 +3540 2 3 0 3490 0 1769 1768 1770 +3541 2 3 0 3491 0 1842 1770 1841 +3542 2 3 0 3492 0 1842 1843 1770 +3543 2 3 0 3493 0 1843 1771 1770 +3544 2 3 0 3494 0 1843 1772 1771 +3545 2 3 0 3495 0 1772 1843 1844 +3546 2 3 0 3496 0 1844 1845 1772 +3547 2 3 0 3497 0 1845 1773 1772 +3548 2 3 0 3498 0 1845 1774 1773 +3549 2 3 0 3499 0 1845 1846 1774 +3550 2 3 0 3500 0 1774 1846 1775 +3551 2 3 0 3501 0 1775 1846 1847 +3552 2 3 0 3502 0 1775 1847 1848 +3553 2 3 0 3503 0 1848 1776 1775 +3554 2 3 0 3504 0 1777 1776 1848 +3555 2 3 0 3505 0 1849 1777 1848 +3556 2 3 0 3506 0 1850 1777 1849 +3557 2 3 0 3507 0 1850 1778 1777 +3558 2 3 0 3508 0 1778 1850 1851 +3559 2 3 0 3509 0 1778 1851 1852 +3560 2 3 0 3510 0 1778 1852 1853 +3561 2 3 0 3511 0 1779 1778 1853 +3562 2 3 0 3512 0 1780 1779 1853 +3563 2 3 0 3513 0 1780 1853 1781 +3564 2 3 0 3514 0 1854 1781 1853 +3565 2 3 0 3515 0 1854 1855 1781 +3566 2 3 0 3516 0 1855 1782 1781 +3567 2 3 0 3517 0 1782 1855 1856 +3568 2 3 0 3518 0 1782 1856 1783 +3569 2 3 0 3519 0 1857 1783 1856 +3570 2 3 0 3520 0 1857 1858 1783 +3571 2 3 0 3521 0 1858 1784 1783 +3572 2 3 0 3522 0 1784 1858 1785 +3573 2 3 0 3523 0 1785 1858 1786 +3574 2 3 0 3524 0 1786 1858 1859 +3575 2 3 0 3525 0 1860 1787 1788 +3576 2 3 0 3526 0 1789 1787 1860 +3577 2 3 0 3527 0 1860 1788 1861 +3578 2 3 0 3528 0 1862 1789 1860 +3579 2 3 0 3529 0 1789 1862 1790 +3580 2 3 0 3530 0 1862 1863 1790 +3581 2 3 0 3531 0 1791 1790 1863 +3582 2 3 0 3532 0 1864 1791 1863 +3583 2 3 0 3533 0 1865 1791 1864 +3584 2 3 0 3534 0 1792 1791 1865 +3585 2 3 0 3535 0 1792 1865 1793 +3586 2 3 0 3536 0 1866 1793 1865 +3587 2 3 0 3537 0 1866 1794 1793 +3588 2 3 0 3538 0 1866 1867 1794 +3589 2 3 0 3539 0 1794 1867 1795 +3590 2 3 0 3540 0 1796 1795 1867 +3591 2 3 0 3541 0 1868 1796 1867 +3592 2 3 0 3542 0 1869 1796 1868 +3593 2 3 0 3543 0 1797 1796 1869 +3594 2 3 0 3544 0 1869 1870 1797 +3595 2 3 0 3545 0 1797 1870 1798 +3596 2 3 0 3546 0 1871 1798 1870 +3597 2 3 0 3547 0 1799 1798 1871 +3598 2 3 0 3548 0 1872 1799 1871 +3599 2 3 0 3549 0 1799 1872 1800 +3600 2 3 0 3550 0 1872 1873 1800 +3601 2 3 0 3551 0 1801 1800 1873 +3602 2 3 0 3552 0 1874 1801 1873 +3603 2 3 0 3553 0 1802 1801 1874 +3604 2 3 0 3554 0 1874 1803 1802 +3605 2 3 0 3555 0 1874 1875 1803 +3606 2 3 0 3556 0 1804 1803 1875 +3607 2 3 0 3557 0 1804 1875 1876 +3608 2 3 0 3558 0 1877 1804 1876 +3609 2 3 0 3559 0 1805 1804 1877 +3610 2 3 0 3560 0 1806 1805 1877 +3611 2 3 0 3561 0 1877 1878 1806 +3612 2 3 0 3562 0 1878 1879 1806 +3613 2 3 0 3563 0 1880 1806 1879 +3614 2 3 0 3564 0 1880 1807 1806 +3615 2 3 0 3565 0 1807 1880 1808 +3616 2 3 0 3566 0 1808 1880 1881 +3617 2 3 0 3567 0 1882 1808 1881 +3618 2 3 0 3568 0 1809 1808 1882 +3619 2 3 0 3569 0 1882 1810 1809 +3620 2 3 0 3570 0 1882 1883 1810 +3621 2 3 0 3571 0 1884 1810 1883 +3622 2 3 0 3572 0 1810 1884 1811 +3623 2 3 0 3573 0 1884 1885 1811 +3624 2 3 0 3574 0 1812 1811 1885 +3625 2 3 0 3575 0 1813 1812 1885 +3626 2 3 0 3576 0 1886 1813 1885 +3627 2 3 0 3577 0 1886 1814 1813 +3628 2 3 0 3578 0 1886 1887 1814 +3629 2 3 0 3579 0 1887 1888 1814 +3630 2 3 0 3580 0 1815 1814 1888 +3631 2 3 0 3581 0 1815 1888 1889 +3632 2 3 0 3582 0 1816 1815 1889 +3633 2 3 0 3583 0 1889 1890 1816 +3634 2 3 0 3584 0 1816 1890 1818 +3635 2 3 0 3585 0 1816 1818 1817 +3636 2 3 0 3586 0 1890 1819 1818 +3637 2 3 0 3587 0 1891 1819 1890 +3638 2 3 0 3588 0 1891 1820 1819 +3639 2 3 0 3589 0 1891 1892 1820 +3640 2 3 0 3590 0 1892 1893 1820 +3641 2 3 0 3591 0 1821 1820 1893 +3642 2 3 0 3592 0 1822 1821 1893 +3643 2 3 0 3593 0 1822 1893 1894 +3644 2 3 0 3594 0 1823 1822 1894 +3645 2 3 0 3595 0 1894 1824 1823 +3646 2 3 0 3596 0 1894 1895 1824 +3647 2 3 0 3597 0 1825 1824 1895 +3648 2 3 0 3598 0 1825 1895 1896 +3649 2 3 0 3599 0 1825 1896 1897 +3650 2 3 0 3600 0 1826 1825 1897 +3651 2 3 0 3601 0 1826 1897 1898 +3652 2 3 0 3602 0 1899 1826 1898 +3653 2 3 0 3603 0 1826 1899 1828 +3654 2 3 0 3604 0 1826 1828 1827 +3655 2 3 0 3605 0 1900 1828 1899 +3656 2 3 0 3606 0 1829 1828 1900 +3657 2 3 0 3607 0 1829 1900 1901 +3658 2 3 0 3608 0 1830 1829 1901 +3659 2 3 0 3609 0 1830 1901 1831 +3660 2 3 0 3610 0 1902 1831 1901 +3661 2 3 0 3611 0 1831 1902 1833 +3662 2 3 0 3612 0 1832 1831 1833 +3663 2 3 0 3613 0 1833 1902 1903 +3664 2 3 0 3614 0 1903 1834 1833 +3665 2 3 0 3615 0 1904 1834 1903 +3666 2 3 0 3616 0 1835 1834 1904 +3667 2 3 0 3617 0 1835 1904 1905 +3668 2 3 0 3618 0 1836 1835 1905 +3669 2 3 0 3619 0 1836 1905 1837 +3670 2 3 0 3620 0 1837 1905 1906 +3671 2 3 0 3621 0 1837 1906 1838 +3672 2 3 0 3622 0 1907 1838 1906 +3673 2 3 0 3623 0 1908 1838 1907 +3674 2 3 0 3624 0 1908 1839 1838 +3675 2 3 0 3625 0 1909 1839 1908 +3676 2 3 0 3626 0 1909 1910 1839 +3677 2 3 0 3627 0 1910 1840 1839 +3678 2 3 0 3628 0 1910 1841 1840 +3679 2 3 0 3629 0 1910 1842 1841 +3680 2 3 0 3630 0 1842 1910 1911 +3681 2 3 0 3631 0 1842 1911 1912 +3682 2 3 0 3632 0 1843 1842 1912 +3683 2 3 0 3633 0 1843 1912 1844 +3684 2 3 0 3634 0 1844 1912 1913 +3685 2 3 0 3635 0 1913 1914 1844 +3686 2 3 0 3636 0 1914 1845 1844 +3687 2 3 0 3637 0 1914 1846 1845 +3688 2 3 0 3638 0 1914 1847 1846 +3689 2 3 0 3639 0 1847 1914 1915 +3690 2 3 0 3640 0 1847 1915 1916 +3691 2 3 0 3641 0 1848 1847 1916 +3692 2 3 0 3642 0 1848 1916 1849 +3693 2 3 0 3643 0 1849 1916 1917 +3694 2 3 0 3644 0 1917 1850 1849 +3695 2 3 0 3645 0 1851 1850 1917 +3696 2 3 0 3646 0 1918 1851 1917 +3697 2 3 0 3647 0 1919 1851 1918 +3698 2 3 0 3648 0 1851 1919 1852 +3699 2 3 0 3649 0 1852 1919 1920 +3700 2 3 0 3650 0 1853 1852 1920 +3701 2 3 0 3651 0 1853 1920 1854 +3702 2 3 0 3652 0 1921 1854 1920 +3703 2 3 0 3653 0 1855 1854 1921 +3704 2 3 0 3654 0 1855 1921 1922 +3705 2 3 0 3655 0 1855 1922 1856 +3706 2 3 0 3656 0 1923 1856 1922 +3707 2 3 0 3657 0 1923 1857 1856 +3708 2 3 0 3658 0 1924 1857 1923 +3709 2 3 0 3659 0 1924 1859 1857 +3710 2 3 0 3660 0 1859 1858 1857 +3711 2 3 0 3661 0 1862 1860 1861 +3712 2 3 0 3662 0 1926 1925 1861 +3713 2 3 0 3663 0 1862 1861 1925 +3714 2 3 0 3664 0 1862 1925 1927 +3715 2 3 0 3665 0 1862 1927 1863 +3716 2 3 0 3666 0 1863 1927 1864 +3717 2 3 0 3667 0 1927 1928 1864 +3718 2 3 0 3668 0 1928 1929 1864 +3719 2 3 0 3669 0 1864 1929 1930 +3720 2 3 0 3670 0 1930 1865 1864 +3721 2 3 0 3671 0 1865 1930 1866 +3722 2 3 0 3672 0 1930 1931 1866 +3723 2 3 0 3673 0 1866 1931 1867 +3724 2 3 0 3674 0 1931 1932 1867 +3725 2 3 0 3675 0 1868 1867 1932 +3726 2 3 0 3676 0 1933 1868 1932 +3727 2 3 0 3677 0 1869 1868 1933 +3728 2 3 0 3678 0 1934 1869 1933 +3729 2 3 0 3679 0 1869 1934 1935 +3730 2 3 0 3680 0 1869 1935 1870 +3731 2 3 0 3681 0 1871 1870 1935 +3732 2 3 0 3682 0 1936 1871 1935 +3733 2 3 0 3683 0 1872 1871 1936 +3734 2 3 0 3684 0 1936 1937 1872 +3735 2 3 0 3685 0 1872 1937 1938 +3736 2 3 0 3686 0 1872 1938 1873 +3737 2 3 0 3687 0 1874 1873 1938 +3738 2 3 0 3688 0 1875 1874 1938 +3739 2 3 0 3689 0 1875 1938 1939 +3740 2 3 0 3690 0 1876 1875 1939 +3741 2 3 0 3691 0 1876 1939 1940 +3742 2 3 0 3692 0 1941 1876 1940 +3743 2 3 0 3693 0 1877 1876 1941 +3744 2 3 0 3694 0 1941 1878 1877 +3745 2 3 0 3695 0 1941 1942 1878 +3746 2 3 0 3696 0 1942 1943 1878 +3747 2 3 0 3697 0 1878 1943 1879 +3748 2 3 0 3698 0 1943 1944 1879 +3749 2 3 0 3699 0 1881 1879 1944 +3750 2 3 0 3700 0 1881 1880 1879 +3751 2 3 0 3701 0 1944 1945 1881 +3752 2 3 0 3702 0 1945 1946 1881 +3753 2 3 0 3703 0 1881 1946 1882 +3754 2 3 0 3704 0 1946 1883 1882 +3755 2 3 0 3705 0 1946 1947 1883 +3756 2 3 0 3706 0 1884 1883 1947 +3757 2 3 0 3707 0 1948 1884 1947 +3758 2 3 0 3708 0 1884 1948 1885 +3759 2 3 0 3709 0 1948 1949 1885 +3760 2 3 0 3710 0 1886 1885 1949 +3761 2 3 0 3711 0 1949 1887 1886 +3762 2 3 0 3712 0 1949 1950 1887 +3763 2 3 0 3713 0 1887 1950 1951 +3764 2 3 0 3714 0 1952 1887 1951 +3765 2 3 0 3715 0 1888 1887 1952 +3766 2 3 0 3716 0 1889 1888 1952 +3767 2 3 0 3717 0 1952 1953 1889 +3768 2 3 0 3718 0 1890 1889 1953 +3769 2 3 0 3719 0 1954 1890 1953 +3770 2 3 0 3720 0 1891 1890 1954 +3771 2 3 0 3721 0 1954 1955 1891 +3772 2 3 0 3722 0 1892 1891 1955 +3773 2 3 0 3723 0 1892 1955 1956 +3774 2 3 0 3724 0 1956 1957 1892 +3775 2 3 0 3725 0 1892 1957 1893 +3776 2 3 0 3726 0 1957 1894 1893 +3777 2 3 0 3727 0 1957 1958 1894 +3778 2 3 0 3728 0 1958 1895 1894 +3779 2 3 0 3729 0 1958 1896 1895 +3780 2 3 0 3730 0 1958 1959 1896 +3781 2 3 0 3731 0 1959 1897 1896 +3782 2 3 0 3732 0 1959 1960 1897 +3783 2 3 0 3733 0 1960 1961 1897 +3784 2 3 0 3734 0 1961 1898 1897 +3785 2 3 0 3735 0 1961 1962 1898 +3786 2 3 0 3736 0 1962 1963 1898 +3787 2 3 0 3737 0 1898 1963 1964 +3788 2 3 0 3738 0 1898 1964 1899 +3789 2 3 0 3739 0 1900 1899 1964 +3790 2 3 0 3740 0 1964 1965 1900 +3791 2 3 0 3741 0 1965 1901 1900 +3792 2 3 0 3742 0 1965 1902 1901 +3793 2 3 0 3743 0 1902 1965 1966 +3794 2 3 0 3744 0 1902 1966 1903 +3795 2 3 0 3745 0 1903 1966 1967 +3796 2 3 0 3746 0 1967 1904 1903 +3797 2 3 0 3747 0 1968 1904 1967 +3798 2 3 0 3748 0 1904 1968 1906 +3799 2 3 0 3749 0 1905 1904 1906 +3800 2 3 0 3750 0 1907 1906 1968 +3801 2 3 0 3751 0 1969 1907 1968 +3802 2 3 0 3752 0 1969 1970 1907 +3803 2 3 0 3753 0 1970 1908 1907 +3804 2 3 0 3754 0 1908 1970 1971 +3805 2 3 0 3755 0 1908 1971 1909 +3806 2 3 0 3756 0 1972 1909 1971 +3807 2 3 0 3757 0 1973 1909 1972 +3808 2 3 0 3758 0 1910 1909 1973 +3809 2 3 0 3759 0 1910 1973 1911 +3810 2 3 0 3760 0 1974 1911 1973 +3811 2 3 0 3761 0 1974 1975 1911 +3812 2 3 0 3762 0 1975 1912 1911 +3813 2 3 0 3763 0 1975 1976 1912 +3814 2 3 0 3764 0 1912 1976 1913 +3815 2 3 0 3765 0 1913 1976 1977 +3816 2 3 0 3766 0 1977 1915 1913 +3817 2 3 0 3767 0 1915 1914 1913 +3818 2 3 0 3768 0 1978 1915 1977 +3819 2 3 0 3769 0 1978 1979 1915 +3820 2 3 0 3770 0 1979 1916 1915 +3821 2 3 0 3771 0 1916 1979 1917 +3822 2 3 0 3772 0 1917 1979 1980 +3823 2 3 0 3773 0 1917 1980 1918 +3824 2 3 0 3774 0 1918 1980 1981 +3825 2 3 0 3775 0 1918 1981 1982 +3826 2 3 0 3776 0 1982 1919 1918 +3827 2 3 0 3777 0 1983 1919 1982 +3828 2 3 0 3778 0 1983 1984 1919 +3829 2 3 0 3779 0 1984 1920 1919 +3830 2 3 0 3780 0 1984 1921 1920 +3831 2 3 0 3781 0 1985 1921 1984 +3832 2 3 0 3782 0 1922 1921 1985 +3833 2 3 0 3783 0 1922 1985 1986 +3834 2 3 0 3784 0 1986 1923 1922 +3835 2 3 0 3785 0 1987 1923 1986 +3836 2 3 0 3786 0 1987 1924 1923 +3837 2 3 0 3787 0 1925 1926 1988 +3838 2 3 0 3788 0 1988 1989 1925 +3839 2 3 0 3789 0 1925 1989 1927 +3840 2 3 0 3790 0 1989 1990 1927 +3841 2 3 0 3791 0 1928 1927 1990 +3842 2 3 0 3792 0 1991 1928 1990 +3843 2 3 0 3793 0 1928 1991 1992 +3844 2 3 0 3794 0 1928 1992 1929 +3845 2 3 0 3795 0 1929 1992 1993 +3846 2 3 0 3796 0 1930 1929 1993 +3847 2 3 0 3797 0 1930 1993 1931 +3848 2 3 0 3798 0 1932 1931 1993 +3849 2 3 0 3799 0 1994 1932 1993 +3850 2 3 0 3800 0 1932 1994 1933 +3851 2 3 0 3801 0 1994 1995 1933 +3852 2 3 0 3802 0 1934 1933 1995 +3853 2 3 0 3803 0 1934 1995 1996 +3854 2 3 0 3804 0 1997 1934 1996 +3855 2 3 0 3805 0 1934 1997 1935 +3856 2 3 0 3806 0 1936 1935 1997 +3857 2 3 0 3807 0 1998 1936 1997 +3858 2 3 0 3808 0 1936 1998 1937 +3859 2 3 0 3809 0 1998 1999 1937 +3860 2 3 0 3810 0 1999 2000 1937 +3861 2 3 0 3811 0 1937 2000 1939 +3862 2 3 0 3812 0 1937 1939 1938 +3863 2 3 0 3813 0 2000 2001 1939 +3864 2 3 0 3814 0 2001 1940 1939 +3865 2 3 0 3815 0 2002 1940 2001 +3866 2 3 0 3816 0 1942 1940 2002 +3867 2 3 0 3817 0 1942 1941 1940 +3868 2 3 0 3818 0 2002 2003 1942 +3869 2 3 0 3819 0 2003 2004 1942 +3870 2 3 0 3820 0 1942 2004 1943 +3871 2 3 0 3821 0 2005 1943 2004 +3872 2 3 0 3822 0 1943 2005 2006 +3873 2 3 0 3823 0 1943 2006 1944 +3874 2 3 0 3824 0 1944 2006 1945 +3875 2 3 0 3825 0 1945 2006 2007 +3876 2 3 0 3826 0 1945 2007 2008 +3877 2 3 0 3827 0 1945 2008 1946 +3878 2 3 0 3828 0 2008 1947 1946 +3879 2 3 0 3829 0 2009 1947 2008 +3880 2 3 0 3830 0 1948 1947 2009 +3881 2 3 0 3831 0 2009 2010 1948 +3882 2 3 0 3832 0 1948 2010 1950 +3883 2 3 0 3833 0 1948 1950 1949 +3884 2 3 0 3834 0 1951 1950 2010 +3885 2 3 0 3835 0 1951 2010 2011 +3886 2 3 0 3836 0 1951 2011 2012 +3887 2 3 0 3837 0 2013 1951 2012 +3888 2 3 0 3838 0 1952 1951 2013 +3889 2 3 0 3839 0 1953 1952 2013 +3890 2 3 0 3840 0 2013 2014 1953 +3891 2 3 0 3841 0 1954 1953 2014 +3892 2 3 0 3842 0 2014 2015 1954 +3893 2 3 0 3843 0 2015 1955 1954 +3894 2 3 0 3844 0 1955 2015 2016 +3895 2 3 0 3845 0 1956 1955 2016 +3896 2 3 0 3846 0 2016 2017 1956 +3897 2 3 0 3847 0 2017 2018 1956 +3898 2 3 0 3848 0 1956 2018 1957 +3899 2 3 0 3849 0 1957 2018 2019 +3900 2 3 0 3850 0 1958 1957 2019 +3901 2 3 0 3851 0 1959 1958 2019 +3902 2 3 0 3852 0 1959 2019 2020 +3903 2 3 0 3853 0 1960 1959 2020 +3904 2 3 0 3854 0 1960 2020 2021 +3905 2 3 0 3855 0 1961 1960 2021 +3906 2 3 0 3856 0 1961 2021 2022 +3907 2 3 0 3857 0 1962 1961 2022 +3908 2 3 0 3858 0 1962 2022 2023 +3909 2 3 0 3859 0 2024 1962 2023 +3910 2 3 0 3860 0 1962 2024 2025 +3911 2 3 0 3861 0 1962 2025 1963 +3912 2 3 0 3862 0 1965 1963 2025 +3913 2 3 0 3863 0 1965 1964 1963 +3914 2 3 0 3864 0 1965 2025 1966 +3915 2 3 0 3865 0 2024 1966 2025 +3916 2 3 0 3866 0 2024 2026 1966 +3917 2 3 0 3867 0 1967 1966 2026 +3918 2 3 0 3868 0 1967 2026 2027 +3919 2 3 0 3869 0 2027 1968 1967 +3920 2 3 0 3870 0 2028 1968 2027 +3921 2 3 0 3871 0 2028 1969 1968 +3922 2 3 0 3872 0 2029 1969 2028 +3923 2 3 0 3873 0 2029 2030 1969 +3924 2 3 0 3874 0 2030 2031 1969 +3925 2 3 0 3875 0 2031 1970 1969 +3926 2 3 0 3876 0 1970 2031 1971 +3927 2 3 0 3877 0 1971 2031 2032 +3928 2 3 0 3878 0 1971 2032 2033 +3929 2 3 0 3879 0 2033 1972 1971 +3930 2 3 0 3880 0 1972 2033 2034 +3931 2 3 0 3881 0 1972 2034 2035 +3932 2 3 0 3882 0 1974 1972 2035 +3933 2 3 0 3883 0 1973 1972 1974 +3934 2 3 0 3884 0 1975 1974 2035 +3935 2 3 0 3885 0 1975 2035 2036 +3936 2 3 0 3886 0 1976 1975 2036 +3937 2 3 0 3887 0 1976 2036 2037 +3938 2 3 0 3888 0 1976 2037 1977 +3939 2 3 0 3889 0 2038 1977 2037 +3940 2 3 0 3890 0 2038 1978 1977 +3941 2 3 0 3891 0 1978 2038 2039 +3942 2 3 0 3892 0 1978 2039 2040 +3943 2 3 0 3893 0 1980 1978 2040 +3944 2 3 0 3894 0 1979 1978 1980 +3945 2 3 0 3895 0 2040 1981 1980 +3946 2 3 0 3896 0 1981 2040 2041 +3947 2 3 0 3897 0 1981 2041 2042 +3948 2 3 0 3898 0 1982 1981 2042 +3949 2 3 0 3899 0 1982 2042 2043 +3950 2 3 0 3900 0 2043 1983 1982 +3951 2 3 0 3901 0 1983 2043 2044 +3952 2 3 0 3902 0 1983 2044 2045 +3953 2 3 0 3903 0 1984 1983 2045 +3954 2 3 0 3904 0 2045 1985 1984 +3955 2 3 0 3905 0 1985 2045 2046 +3956 2 3 0 3906 0 1985 2046 2047 +3957 2 3 0 3907 0 1986 1985 2047 +3958 2 3 0 3908 0 1986 2047 1987 +3959 2 3 0 3909 0 1987 2047 2048 +3960 2 3 0 3910 0 1989 1988 2049 +3961 2 3 0 3911 0 1989 2049 2050 +3962 2 3 0 3912 0 1989 2050 1990 +3963 2 3 0 3913 0 2050 2051 1990 +3964 2 3 0 3914 0 1990 2051 1991 +3965 2 3 0 3915 0 2051 2052 1991 +3966 2 3 0 3916 0 1991 2052 2053 +3967 2 3 0 3917 0 1991 2053 1992 +3968 2 3 0 3918 0 2054 1992 2053 +3969 2 3 0 3919 0 2054 2055 1992 +3970 2 3 0 3920 0 1992 2055 1993 +3971 2 3 0 3921 0 1994 1993 2055 +3972 2 3 0 3922 0 2056 1994 2055 +3973 2 3 0 3923 0 1994 2056 2057 +3974 2 3 0 3924 0 1994 2057 1995 +3975 2 3 0 3925 0 1996 1995 2057 +3976 2 3 0 3926 0 2058 1996 2057 +3977 2 3 0 3927 0 1996 2058 2059 +3978 2 3 0 3928 0 1996 2059 1997 +3979 2 3 0 3929 0 1998 1997 2059 +3980 2 3 0 3930 0 1998 2059 2060 +3981 2 3 0 3931 0 1999 1998 2060 +3982 2 3 0 3932 0 2060 2061 1999 +3983 2 3 0 3933 0 2061 2062 1999 +3984 2 3 0 3934 0 2000 1999 2062 +3985 2 3 0 3935 0 2001 2000 2062 +3986 2 3 0 3936 0 2001 2062 2063 +3987 2 3 0 3937 0 2064 2001 2063 +3988 2 3 0 3938 0 2002 2001 2064 +3989 2 3 0 3939 0 2064 2003 2002 +3990 2 3 0 3940 0 2064 2065 2003 +3991 2 3 0 3941 0 2065 2066 2003 +3992 2 3 0 3942 0 2004 2003 2066 +3993 2 3 0 3943 0 2067 2004 2066 +3994 2 3 0 3944 0 2005 2004 2067 +3995 2 3 0 3945 0 2068 2005 2067 +3996 2 3 0 3946 0 2005 2068 2006 +3997 2 3 0 3947 0 2068 2007 2006 +3998 2 3 0 3948 0 2068 2069 2007 +3999 2 3 0 3949 0 2069 2070 2007 +4000 2 3 0 3950 0 2071 2007 2070 +4001 2 3 0 3951 0 2071 2008 2007 +4002 2 3 0 3952 0 2009 2008 2071 +4003 2 3 0 3953 0 2071 2072 2009 +4004 2 3 0 3954 0 2009 2072 2010 +4005 2 3 0 3955 0 2072 2011 2010 +4006 2 3 0 3956 0 2072 2073 2011 +4007 2 3 0 3957 0 2012 2011 2073 +4008 2 3 0 3958 0 2012 2073 2074 +4009 2 3 0 3959 0 2074 2075 2012 +4010 2 3 0 3960 0 2012 2075 2013 +4011 2 3 0 3961 0 2075 2076 2013 +4012 2 3 0 3962 0 2013 2076 2014 +4013 2 3 0 3963 0 2076 2015 2014 +4014 2 3 0 3964 0 2076 2077 2015 +4015 2 3 0 3965 0 2077 2078 2015 +4016 2 3 0 3966 0 2078 2016 2015 +4017 2 3 0 3967 0 2078 2079 2016 +4018 2 3 0 3968 0 2079 2017 2016 +4019 2 3 0 3969 0 2017 2079 2080 +4020 2 3 0 3970 0 2081 2017 2080 +4021 2 3 0 3971 0 2019 2017 2081 +4022 2 3 0 3972 0 2019 2018 2017 +4023 2 3 0 3973 0 2020 2019 2081 +4024 2 3 0 3974 0 2020 2081 2082 +4025 2 3 0 3975 0 2082 2083 2020 +4026 2 3 0 3976 0 2083 2021 2020 +4027 2 3 0 3977 0 2083 2022 2021 +4028 2 3 0 3978 0 2083 2084 2022 +4029 2 3 0 3979 0 2023 2022 2084 +4030 2 3 0 3980 0 2023 2084 2085 +4031 2 3 0 3981 0 2085 2086 2023 +4032 2 3 0 3982 0 2086 2087 2023 +4033 2 3 0 3983 0 2024 2023 2087 +4034 2 3 0 3984 0 2026 2024 2087 +4035 2 3 0 3985 0 2026 2087 2088 +4036 2 3 0 3986 0 2027 2026 2088 +4037 2 3 0 3987 0 2027 2088 2028 +4038 2 3 0 3988 0 2028 2088 2029 +4039 2 3 0 3989 0 2088 2089 2029 +4040 2 3 0 3990 0 2029 2089 2090 +4041 2 3 0 3991 0 2090 2030 2029 +4042 2 3 0 3992 0 2090 2091 2030 +4043 2 3 0 3993 0 2091 2031 2030 +4044 2 3 0 3994 0 2091 2032 2031 +4045 2 3 0 3995 0 2032 2091 2092 +4046 2 3 0 3996 0 2032 2092 2093 +4047 2 3 0 3997 0 2033 2032 2093 +4048 2 3 0 3998 0 2033 2093 2094 +4049 2 3 0 3999 0 2033 2094 2034 +4050 2 3 0 4000 0 2034 2094 2095 +4051 2 3 0 4001 0 2034 2095 2096 +4052 2 3 0 4002 0 2035 2034 2096 +4053 2 3 0 4003 0 2096 2097 2035 +4054 2 3 0 4004 0 2097 2036 2035 +4055 2 3 0 4005 0 2097 2098 2036 +4056 2 3 0 4006 0 2098 2037 2036 +4057 2 3 0 4007 0 2098 2038 2037 +4058 2 3 0 4008 0 2038 2098 2039 +4059 2 3 0 4009 0 2098 2099 2039 +4060 2 3 0 4010 0 2039 2099 2100 +4061 2 3 0 4011 0 2100 2040 2039 +4062 2 3 0 4012 0 2040 2100 2041 +4063 2 3 0 4013 0 2100 2101 2041 +4064 2 3 0 4014 0 2102 2041 2101 +4065 2 3 0 4015 0 2041 2102 2103 +4066 2 3 0 4016 0 2042 2041 2103 +4067 2 3 0 4017 0 2043 2042 2103 +4068 2 3 0 4018 0 2043 2103 2104 +4069 2 3 0 4019 0 2043 2104 2044 +4070 2 3 0 4020 0 2105 2044 2104 +4071 2 3 0 4021 0 2105 2106 2044 +4072 2 3 0 4022 0 2044 2106 2107 +4073 2 3 0 4023 0 2045 2044 2107 +4074 2 3 0 4024 0 2045 2107 2046 +4075 2 3 0 4025 0 2108 2046 2107 +4076 2 3 0 4026 0 2108 2048 2046 +4077 2 3 0 4027 0 2048 2047 2046 +4078 2 3 0 4028 0 2050 2049 2109 +4079 2 3 0 4029 0 2109 2110 2050 +4080 2 3 0 4030 0 2051 2050 2110 +4081 2 3 0 4031 0 2110 2111 2051 +4082 2 3 0 4032 0 2052 2051 2111 +4083 2 3 0 4033 0 2112 2052 2111 +4084 2 3 0 4034 0 2053 2052 2112 +4085 2 3 0 4035 0 2113 2053 2112 +4086 2 3 0 4036 0 2054 2053 2113 +4087 2 3 0 4037 0 2114 2054 2113 +4088 2 3 0 4038 0 2054 2114 2115 +4089 2 3 0 4039 0 2115 2056 2054 +4090 2 3 0 4040 0 2056 2055 2054 +4091 2 3 0 4041 0 2116 2056 2115 +4092 2 3 0 4042 0 2116 2057 2056 +4093 2 3 0 4043 0 2058 2057 2116 +4094 2 3 0 4044 0 2058 2116 2117 +4095 2 3 0 4045 0 2118 2058 2117 +4096 2 3 0 4046 0 2058 2118 2060 +4097 2 3 0 4047 0 2058 2060 2059 +4098 2 3 0 4048 0 2118 2061 2060 +4099 2 3 0 4049 0 2118 2119 2061 +4100 2 3 0 4050 0 2062 2061 2119 +4101 2 3 0 4051 0 2063 2062 2119 +4102 2 3 0 4052 0 2119 2120 2063 +4103 2 3 0 4053 0 2120 2121 2063 +4104 2 3 0 4054 0 2063 2121 2065 +4105 2 3 0 4055 0 2063 2065 2064 +4106 2 3 0 4056 0 2122 2065 2121 +4107 2 3 0 4057 0 2065 2122 2066 +4108 2 3 0 4058 0 2122 2123 2066 +4109 2 3 0 4059 0 2123 2124 2066 +4110 2 3 0 4060 0 2067 2066 2124 +4111 2 3 0 4061 0 2125 2067 2124 +4112 2 3 0 4062 0 2068 2067 2125 +4113 2 3 0 4063 0 2125 2069 2068 +4114 2 3 0 4064 0 2125 2126 2069 +4115 2 3 0 4065 0 2126 2127 2069 +4116 2 3 0 4066 0 2127 2128 2069 +4117 2 3 0 4067 0 2069 2128 2070 +4118 2 3 0 4068 0 2128 2129 2070 +4119 2 3 0 4069 0 2070 2129 2130 +4120 2 3 0 4070 0 2070 2130 2071 +4121 2 3 0 4071 0 2071 2130 2072 +4122 2 3 0 4072 0 2130 2131 2072 +4123 2 3 0 4073 0 2131 2073 2072 +4124 2 3 0 4074 0 2073 2131 2132 +4125 2 3 0 4075 0 2074 2073 2132 +4126 2 3 0 4076 0 2132 2133 2074 +4127 2 3 0 4077 0 2074 2133 2075 +4128 2 3 0 4078 0 2133 2134 2075 +4129 2 3 0 4079 0 2077 2075 2134 +4130 2 3 0 4080 0 2077 2076 2075 +4131 2 3 0 4081 0 2078 2077 2134 +4132 2 3 0 4082 0 2078 2134 2135 +4133 2 3 0 4083 0 2135 2079 2078 +4134 2 3 0 4084 0 2136 2079 2135 +4135 2 3 0 4085 0 2136 2137 2079 +4136 2 3 0 4086 0 2137 2080 2079 +4137 2 3 0 4087 0 2138 2080 2137 +4138 2 3 0 4088 0 2082 2080 2138 +4139 2 3 0 4089 0 2082 2081 2080 +4140 2 3 0 4090 0 2138 2139 2082 +4141 2 3 0 4091 0 2139 2083 2082 +4142 2 3 0 4092 0 2083 2139 2140 +4143 2 3 0 4093 0 2084 2083 2140 +4144 2 3 0 4094 0 2140 2085 2084 +4145 2 3 0 4095 0 2140 2141 2085 +4146 2 3 0 4096 0 2086 2085 2141 +4147 2 3 0 4097 0 2086 2141 2142 +4148 2 3 0 4098 0 2089 2086 2142 +4149 2 3 0 4099 0 2086 2089 2087 +4150 2 3 0 4100 0 2089 2088 2087 +4151 2 3 0 4101 0 2089 2142 2143 +4152 2 3 0 4102 0 2089 2143 2090 +4153 2 3 0 4103 0 2090 2143 2144 +4154 2 3 0 4104 0 2144 2092 2090 +4155 2 3 0 4105 0 2092 2091 2090 +4156 2 3 0 4106 0 2145 2092 2144 +4157 2 3 0 4107 0 2145 2146 2092 +4158 2 3 0 4108 0 2146 2093 2092 +4159 2 3 0 4109 0 2147 2093 2146 +4160 2 3 0 4110 0 2147 2094 2093 +4161 2 3 0 4111 0 2094 2147 2095 +4162 2 3 0 4112 0 2148 2095 2147 +4163 2 3 0 4113 0 2148 2096 2095 +4164 2 3 0 4114 0 2096 2148 2149 +4165 2 3 0 4115 0 2150 2096 2149 +4166 2 3 0 4116 0 2097 2096 2150 +4167 2 3 0 4117 0 2098 2097 2150 +4168 2 3 0 4118 0 2098 2150 2099 +4169 2 3 0 4119 0 2151 2099 2150 +4170 2 3 0 4120 0 2151 2152 2099 +4171 2 3 0 4121 0 2099 2152 2100 +4172 2 3 0 4122 0 2101 2100 2152 +4173 2 3 0 4123 0 2153 2101 2152 +4174 2 3 0 4124 0 2154 2101 2153 +4175 2 3 0 4125 0 2154 2102 2101 +4176 2 3 0 4126 0 2102 2154 2155 +4177 2 3 0 4127 0 2102 2155 2156 +4178 2 3 0 4128 0 2156 2157 2102 +4179 2 3 0 4129 0 2157 2103 2102 +4180 2 3 0 4130 0 2104 2103 2157 +4181 2 3 0 4131 0 2104 2157 2105 +4182 2 3 0 4132 0 2105 2157 2158 +4183 2 3 0 4133 0 2158 2159 2105 +4184 2 3 0 4134 0 2159 2106 2105 +4185 2 3 0 4135 0 2160 2106 2159 +4186 2 3 0 4136 0 2160 2161 2106 +4187 2 3 0 4137 0 2161 2107 2106 +4188 2 3 0 4138 0 2161 2108 2107 +4189 2 3 0 4139 0 2110 2109 2162 +4190 2 3 0 4140 0 2162 2163 2110 +4191 2 3 0 4141 0 2110 2163 2111 +4192 2 3 0 4142 0 2163 2164 2111 +4193 2 3 0 4143 0 2164 2112 2111 +4194 2 3 0 4144 0 2112 2164 2165 +4195 2 3 0 4145 0 2112 2165 2113 +4196 2 3 0 4146 0 2165 2166 2113 +4197 2 3 0 4147 0 2113 2166 2167 +4198 2 3 0 4148 0 2113 2167 2114 +4199 2 3 0 4149 0 2168 2114 2167 +4200 2 3 0 4150 0 2114 2168 2115 +4201 2 3 0 4151 0 2116 2115 2168 +4202 2 3 0 4152 0 2117 2116 2168 +4203 2 3 0 4153 0 2117 2168 2169 +4204 2 3 0 4154 0 2170 2117 2169 +4205 2 3 0 4155 0 2118 2117 2170 +4206 2 3 0 4156 0 2119 2118 2170 +4207 2 3 0 4157 0 2171 2119 2170 +4208 2 3 0 4158 0 2171 2120 2119 +4209 2 3 0 4159 0 2171 2172 2120 +4210 2 3 0 4160 0 2121 2120 2172 +4211 2 3 0 4161 0 2173 2121 2172 +4212 2 3 0 4162 0 2122 2121 2173 +4213 2 3 0 4163 0 2122 2173 2174 +4214 2 3 0 4164 0 2123 2122 2174 +4215 2 3 0 4165 0 2174 2175 2123 +4216 2 3 0 4166 0 2175 2176 2123 +4217 2 3 0 4167 0 2123 2176 2124 +4218 2 3 0 4168 0 2126 2124 2176 +4219 2 3 0 4169 0 2126 2125 2124 +4220 2 3 0 4170 0 2177 2126 2176 +4221 2 3 0 4171 0 2127 2126 2177 +4222 2 3 0 4172 0 2177 2178 2127 +4223 2 3 0 4173 0 2179 2127 2178 +4224 2 3 0 4174 0 2128 2127 2179 +4225 2 3 0 4175 0 2128 2179 2180 +4226 2 3 0 4176 0 2128 2180 2129 +4227 2 3 0 4177 0 2131 2129 2180 +4228 2 3 0 4178 0 2131 2130 2129 +4229 2 3 0 4179 0 2131 2180 2181 +4230 2 3 0 4180 0 2132 2131 2181 +4231 2 3 0 4181 0 2181 2182 2132 +4232 2 3 0 4182 0 2183 2132 2182 +4233 2 3 0 4183 0 2183 2133 2132 +4234 2 3 0 4184 0 2184 2133 2183 +4235 2 3 0 4185 0 2133 2184 2134 +4236 2 3 0 4186 0 2134 2184 2185 +4237 2 3 0 4187 0 2135 2134 2185 +4238 2 3 0 4188 0 2185 2136 2135 +4239 2 3 0 4189 0 2136 2185 2186 +4240 2 3 0 4190 0 2187 2136 2186 +4241 2 3 0 4191 0 2187 2137 2136 +4242 2 3 0 4192 0 2137 2187 2188 +4243 2 3 0 4193 0 2189 2137 2188 +4244 2 3 0 4194 0 2138 2137 2189 +4245 2 3 0 4195 0 2189 2139 2138 +4246 2 3 0 4196 0 2189 2190 2139 +4247 2 3 0 4197 0 2190 2191 2139 +4248 2 3 0 4198 0 2191 2140 2139 +4249 2 3 0 4199 0 2191 2192 2140 +4250 2 3 0 4200 0 2192 2141 2140 +4251 2 3 0 4201 0 2192 2193 2141 +4252 2 3 0 4202 0 2193 2142 2141 +4253 2 3 0 4203 0 2193 2143 2142 +4254 2 3 0 4204 0 2193 2194 2143 +4255 2 3 0 4205 0 2143 2194 2144 +4256 2 3 0 4206 0 2144 2194 2195 +4257 2 3 0 4207 0 2144 2195 2145 +4258 2 3 0 4208 0 2145 2195 2196 +4259 2 3 0 4209 0 2196 2197 2145 +4260 2 3 0 4210 0 2197 2146 2145 +4261 2 3 0 4211 0 2146 2197 2198 +4262 2 3 0 4212 0 2147 2146 2198 +4263 2 3 0 4213 0 2147 2198 2199 +4264 2 3 0 4214 0 2199 2148 2147 +4265 2 3 0 4215 0 2200 2148 2199 +4266 2 3 0 4216 0 2148 2200 2149 +4267 2 3 0 4217 0 2201 2149 2200 +4268 2 3 0 4218 0 2151 2149 2201 +4269 2 3 0 4219 0 2150 2149 2151 +4270 2 3 0 4220 0 2151 2201 2202 +4271 2 3 0 4221 0 2152 2151 2202 +4272 2 3 0 4222 0 2152 2202 2153 +4273 2 3 0 4223 0 2153 2202 2203 +4274 2 3 0 4224 0 2203 2154 2153 +4275 2 3 0 4225 0 2154 2203 2155 +4276 2 3 0 4226 0 2203 2204 2155 +4277 2 3 0 4227 0 2205 2155 2204 +4278 2 3 0 4228 0 2155 2205 2206 +4279 2 3 0 4229 0 2156 2155 2206 +4280 2 3 0 4230 0 2156 2206 2207 +4281 2 3 0 4231 0 2157 2156 2207 +4282 2 3 0 4232 0 2157 2207 2158 +4283 2 3 0 4233 0 2158 2207 2208 +4284 2 3 0 4234 0 2208 2209 2158 +4285 2 3 0 4235 0 2210 2158 2209 +4286 2 3 0 4236 0 2159 2158 2210 +4287 2 3 0 4237 0 2160 2159 2210 +4288 2 3 0 4238 0 2162 2211 2163 +4289 2 3 0 4239 0 2212 2163 2211 +4290 2 3 0 4240 0 2212 2213 2163 +4291 2 3 0 4241 0 2213 2164 2163 +4292 2 3 0 4242 0 2213 2214 2164 +4293 2 3 0 4243 0 2214 2165 2164 +4294 2 3 0 4244 0 2214 2215 2165 +4295 2 3 0 4245 0 2216 2165 2215 +4296 2 3 0 4246 0 2216 2166 2165 +4297 2 3 0 4247 0 2217 2166 2216 +4298 2 3 0 4248 0 2167 2166 2217 +4299 2 3 0 4249 0 2167 2217 2218 +4300 2 3 0 4250 0 2167 2218 2169 +4301 2 3 0 4251 0 2169 2168 2167 +4302 2 3 0 4252 0 2219 2169 2218 +4303 2 3 0 4253 0 2219 2170 2169 +4304 2 3 0 4254 0 2171 2170 2219 +4305 2 3 0 4255 0 2220 2171 2219 +4306 2 3 0 4256 0 2171 2220 2172 +4307 2 3 0 4257 0 2220 2221 2172 +4308 2 3 0 4258 0 2221 2222 2172 +4309 2 3 0 4259 0 2173 2172 2222 +4310 2 3 0 4260 0 2174 2173 2222 +4311 2 3 0 4261 0 2174 2222 2223 +4312 2 3 0 4262 0 2175 2174 2223 +4313 2 3 0 4263 0 2175 2223 2224 +4314 2 3 0 4264 0 2225 2175 2224 +4315 2 3 0 4265 0 2175 2225 2226 +4316 2 3 0 4266 0 2175 2226 2176 +4317 2 3 0 4267 0 2176 2226 2177 +4318 2 3 0 4268 0 2226 2227 2177 +4319 2 3 0 4269 0 2177 2227 2178 +4320 2 3 0 4270 0 2178 2227 2228 +4321 2 3 0 4271 0 2229 2178 2228 +4322 2 3 0 4272 0 2179 2178 2229 +4323 2 3 0 4273 0 2230 2179 2229 +4324 2 3 0 4274 0 2180 2179 2230 +4325 2 3 0 4275 0 2181 2180 2230 +4326 2 3 0 4276 0 2181 2230 2231 +4327 2 3 0 4277 0 2182 2181 2231 +4328 2 3 0 4278 0 2232 2182 2231 +4329 2 3 0 4279 0 2182 2232 2183 +4330 2 3 0 4280 0 2232 2233 2183 +4331 2 3 0 4281 0 2184 2183 2233 +4332 2 3 0 4282 0 2185 2184 2233 +4333 2 3 0 4283 0 2233 2186 2185 +4334 2 3 0 4284 0 2234 2186 2233 +4335 2 3 0 4285 0 2234 2235 2186 +4336 2 3 0 4286 0 2187 2186 2235 +4337 2 3 0 4287 0 2236 2187 2235 +4338 2 3 0 4288 0 2188 2187 2236 +4339 2 3 0 4289 0 2236 2237 2188 +4340 2 3 0 4290 0 2188 2237 2190 +4341 2 3 0 4291 0 2188 2190 2189 +4342 2 3 0 4292 0 2190 2237 2238 +4343 2 3 0 4293 0 2191 2190 2238 +4344 2 3 0 4294 0 2192 2191 2238 +4345 2 3 0 4295 0 2192 2238 2239 +4346 2 3 0 4296 0 2193 2192 2239 +4347 2 3 0 4297 0 2193 2239 2240 +4348 2 3 0 4298 0 2194 2193 2240 +4349 2 3 0 4299 0 2194 2240 2195 +4350 2 3 0 4300 0 2241 2195 2240 +4351 2 3 0 4301 0 2241 2242 2195 +4352 2 3 0 4302 0 2195 2242 2196 +4353 2 3 0 4303 0 2196 2242 2243 +4354 2 3 0 4304 0 2196 2243 2244 +4355 2 3 0 4305 0 2244 2245 2196 +4356 2 3 0 4306 0 2245 2197 2196 +4357 2 3 0 4307 0 2245 2198 2197 +4358 2 3 0 4308 0 2245 2246 2198 +4359 2 3 0 4309 0 2199 2198 2246 +4360 2 3 0 4310 0 2199 2246 2247 +4361 2 3 0 4311 0 2247 2200 2199 +4362 2 3 0 4312 0 2200 2247 2248 +4363 2 3 0 4313 0 2248 2201 2200 +4364 2 3 0 4314 0 2249 2201 2248 +4365 2 3 0 4315 0 2249 2250 2201 +4366 2 3 0 4316 0 2250 2202 2201 +4367 2 3 0 4317 0 2202 2250 2203 +4368 2 3 0 4318 0 2251 2203 2250 +4369 2 3 0 4319 0 2251 2204 2203 +4370 2 3 0 4320 0 2204 2251 2252 +4371 2 3 0 4321 0 2204 2252 2253 +4372 2 3 0 4322 0 2253 2205 2204 +4373 2 3 0 4323 0 2254 2205 2253 +4374 2 3 0 4324 0 2255 2205 2254 +4375 2 3 0 4325 0 2205 2255 2206 +4376 2 3 0 4326 0 2206 2255 2256 +4377 2 3 0 4327 0 2257 2206 2256 +4378 2 3 0 4328 0 2207 2206 2257 +4379 2 3 0 4329 0 2208 2207 2257 +4380 2 3 0 4330 0 2213 2212 2258 +4381 2 3 0 4331 0 2258 2259 2213 +4382 2 3 0 4332 0 2213 2259 2214 +4383 2 3 0 4333 0 2259 2215 2214 +4384 2 3 0 4334 0 2260 2215 2259 +4385 2 3 0 4335 0 2215 2260 2261 +4386 2 3 0 4336 0 2262 2215 2261 +4387 2 3 0 4337 0 2216 2215 2262 +4388 2 3 0 4338 0 2263 2216 2262 +4389 2 3 0 4339 0 2264 2216 2263 +4390 2 3 0 4340 0 2264 2217 2216 +4391 2 3 0 4341 0 2218 2217 2264 +4392 2 3 0 4342 0 2265 2218 2264 +4393 2 3 0 4343 0 2266 2218 2265 +4394 2 3 0 4344 0 2266 2219 2218 +4395 2 3 0 4345 0 2220 2219 2266 +4396 2 3 0 4346 0 2266 2267 2220 +4397 2 3 0 4347 0 2267 2221 2220 +4398 2 3 0 4348 0 2267 2268 2221 +4399 2 3 0 4349 0 2223 2221 2268 +4400 2 3 0 4350 0 2221 2223 2222 +4401 2 3 0 4351 0 2269 2223 2268 +4402 2 3 0 4352 0 2269 2224 2223 +4403 2 3 0 4353 0 2269 2270 2224 +4404 2 3 0 4354 0 2224 2270 2225 +4405 2 3 0 4355 0 2270 2271 2225 +4406 2 3 0 4356 0 2272 2225 2271 +4407 2 3 0 4357 0 2272 2226 2225 +4408 2 3 0 4358 0 2226 2272 2227 +4409 2 3 0 4359 0 2228 2227 2272 +4410 2 3 0 4360 0 2228 2272 2273 +4411 2 3 0 4361 0 2273 2274 2228 +4412 2 3 0 4362 0 2228 2274 2275 +4413 2 3 0 4363 0 2228 2275 2229 +4414 2 3 0 4364 0 2229 2275 2230 +4415 2 3 0 4365 0 2275 2231 2230 +4416 2 3 0 4366 0 2275 2276 2231 +4417 2 3 0 4367 0 2276 2277 2231 +4418 2 3 0 4368 0 2232 2231 2277 +4419 2 3 0 4369 0 2278 2232 2277 +4420 2 3 0 4370 0 2232 2278 2233 +4421 2 3 0 4371 0 2278 2234 2233 +4422 2 3 0 4372 0 2234 2278 2279 +4423 2 3 0 4373 0 2234 2279 2280 +4424 2 3 0 4374 0 2235 2234 2280 +4425 2 3 0 4375 0 2281 2235 2280 +4426 2 3 0 4376 0 2235 2281 2236 +4427 2 3 0 4377 0 2281 2282 2236 +4428 2 3 0 4378 0 2236 2282 2237 +4429 2 3 0 4379 0 2238 2237 2282 +4430 2 3 0 4380 0 2238 2282 2283 +4431 2 3 0 4381 0 2239 2238 2283 +4432 2 3 0 4382 0 2239 2283 2284 +4433 2 3 0 4383 0 2284 2240 2239 +4434 2 3 0 4384 0 2284 2241 2240 +4435 2 3 0 4385 0 2241 2284 2285 +4436 2 3 0 4386 0 2241 2285 2286 +4437 2 3 0 4387 0 2242 2241 2286 +4438 2 3 0 4388 0 2242 2286 2243 +4439 2 3 0 4389 0 2287 2243 2286 +4440 2 3 0 4390 0 2287 2288 2243 +4441 2 3 0 4391 0 2243 2288 2289 +4442 2 3 0 4392 0 2244 2243 2289 +4443 2 3 0 4393 0 2289 2290 2244 +4444 2 3 0 4394 0 2290 2245 2244 +4445 2 3 0 4395 0 2246 2245 2290 +4446 2 3 0 4396 0 2246 2290 2291 +4447 2 3 0 4397 0 2247 2246 2291 +4448 2 3 0 4398 0 2247 2291 2292 +4449 2 3 0 4399 0 2247 2292 2248 +4450 2 3 0 4400 0 2293 2248 2292 +4451 2 3 0 4401 0 2293 2249 2248 +4452 2 3 0 4402 0 2249 2293 2294 +4453 2 3 0 4403 0 2249 2294 2295 +4454 2 3 0 4404 0 2249 2295 2251 +4455 2 3 0 4405 0 2250 2249 2251 +4456 2 3 0 4406 0 2252 2251 2295 +4457 2 3 0 4407 0 2296 2252 2295 +4458 2 3 0 4408 0 2252 2296 2297 +4459 2 3 0 4409 0 2252 2297 2298 +4460 2 3 0 4410 0 2253 2252 2298 +4461 2 3 0 4411 0 2298 2254 2253 +4462 2 3 0 4412 0 2298 2299 2254 +4463 2 3 0 4413 0 2299 2300 2254 +4464 2 3 0 4414 0 2254 2300 2301 +4465 2 3 0 4415 0 2301 2255 2254 +4466 2 3 0 4416 0 2256 2255 2301 +4467 2 3 0 4417 0 2260 2259 2258 +4468 2 3 0 4418 0 2261 2302 2262 +4469 2 3 0 4419 0 2262 2302 2303 +4470 2 3 0 4420 0 2263 2262 2303 +4471 2 3 0 4421 0 2304 2263 2303 +4472 2 3 0 4422 0 2264 2263 2304 +4473 2 3 0 4423 0 2305 2264 2304 +4474 2 3 0 4424 0 2264 2305 2265 +4475 2 3 0 4425 0 2305 2306 2265 +4476 2 3 0 4426 0 2265 2306 2266 +4477 2 3 0 4427 0 2306 2267 2266 +4478 2 3 0 4428 0 2267 2306 2307 +4479 2 3 0 4429 0 2268 2267 2307 +4480 2 3 0 4430 0 2307 2308 2268 +4481 2 3 0 4431 0 2268 2308 2269 +4482 2 3 0 4432 0 2309 2269 2308 +4483 2 3 0 4433 0 2269 2309 2270 +4484 2 3 0 4434 0 2309 2310 2270 +4485 2 3 0 4435 0 2310 2311 2270 +4486 2 3 0 4436 0 2271 2270 2311 +4487 2 3 0 4437 0 2312 2271 2311 +4488 2 3 0 4438 0 2272 2271 2312 +4489 2 3 0 4439 0 2273 2272 2312 +4490 2 3 0 4440 0 2312 2313 2273 +4491 2 3 0 4441 0 2313 2314 2273 +4492 2 3 0 4442 0 2314 2274 2273 +4493 2 3 0 4443 0 2314 2315 2274 +4494 2 3 0 4444 0 2315 2316 2274 +4495 2 3 0 4445 0 2275 2274 2316 +4496 2 3 0 4446 0 2276 2275 2316 +4497 2 3 0 4447 0 2316 2317 2276 +4498 2 3 0 4448 0 2277 2276 2317 +4499 2 3 0 4449 0 2318 2277 2317 +4500 2 3 0 4450 0 2278 2277 2318 +4501 2 3 0 4451 0 2278 2318 2279 +4502 2 3 0 4452 0 2279 2318 2319 +4503 2 3 0 4453 0 2319 2320 2279 +4504 2 3 0 4454 0 2320 2280 2279 +4505 2 3 0 4455 0 2280 2320 2321 +4506 2 3 0 4456 0 2322 2280 2321 +4507 2 3 0 4457 0 2281 2280 2322 +4508 2 3 0 4458 0 2322 2323 2281 +4509 2 3 0 4459 0 2281 2323 2282 +4510 2 3 0 4460 0 2323 2283 2282 +4511 2 3 0 4461 0 2323 2324 2283 +4512 2 3 0 4462 0 2324 2284 2283 +4513 2 3 0 4463 0 2324 2285 2284 +4514 2 3 0 4464 0 2285 2324 2325 +4515 2 3 0 4465 0 2285 2325 2326 +4516 2 3 0 4466 0 2326 2286 2285 +4517 2 3 0 4467 0 2326 2287 2286 +4518 2 3 0 4468 0 2327 2287 2326 +4519 2 3 0 4469 0 2288 2287 2327 +4520 2 3 0 4470 0 2288 2327 2328 +4521 2 3 0 4471 0 2288 2328 2329 +4522 2 3 0 4472 0 2289 2288 2329 +4523 2 3 0 4473 0 2329 2330 2289 +4524 2 3 0 4474 0 2330 2290 2289 +4525 2 3 0 4475 0 2330 2331 2290 +4526 2 3 0 4476 0 2331 2291 2290 +4527 2 3 0 4477 0 2291 2331 2332 +4528 2 3 0 4478 0 2292 2291 2332 +4529 2 3 0 4479 0 2332 2293 2292 +4530 2 3 0 4480 0 2293 2332 2294 +4531 2 3 0 4481 0 2332 2333 2294 +4532 2 3 0 4482 0 2294 2333 2334 +4533 2 3 0 4483 0 2334 2296 2294 +4534 2 3 0 4484 0 2296 2295 2294 +4535 2 3 0 4485 0 2334 2335 2296 +4536 2 3 0 4486 0 2296 2335 2336 +4537 2 3 0 4487 0 2296 2336 2297 +4538 2 3 0 4488 0 2297 2336 2337 +4539 2 3 0 4489 0 2297 2337 2338 +4540 2 3 0 4490 0 2338 2298 2297 +4541 2 3 0 4491 0 2298 2338 2299 +4542 2 3 0 4492 0 2302 2339 2303 +4543 2 3 0 4493 0 2303 2339 2340 +4544 2 3 0 4494 0 2303 2340 2304 +4545 2 3 0 4495 0 2340 2341 2304 +4546 2 3 0 4496 0 2305 2304 2341 +4547 2 3 0 4497 0 2342 2305 2341 +4548 2 3 0 4498 0 2305 2342 2306 +4549 2 3 0 4499 0 2342 2307 2306 +4550 2 3 0 4500 0 2342 2343 2307 +4551 2 3 0 4501 0 2343 2344 2307 +4552 2 3 0 4502 0 2307 2344 2308 +4553 2 3 0 4503 0 2345 2308 2344 +4554 2 3 0 4504 0 2309 2308 2345 +4555 2 3 0 4505 0 2345 2346 2309 +4556 2 3 0 4506 0 2346 2310 2309 +4557 2 3 0 4507 0 2346 2347 2310 +4558 2 3 0 4508 0 2310 2347 2348 +4559 2 3 0 4509 0 2310 2348 2311 +4560 2 3 0 4510 0 2311 2348 2312 +4561 2 3 0 4511 0 2348 2313 2312 +4562 2 3 0 4512 0 2313 2348 2349 +4563 2 3 0 4513 0 2350 2313 2349 +4564 2 3 0 4514 0 2314 2313 2350 +4565 2 3 0 4515 0 2315 2314 2350 +4566 2 3 0 4516 0 2351 2315 2350 +4567 2 3 0 4517 0 2315 2351 2352 +4568 2 3 0 4518 0 2315 2352 2316 +4569 2 3 0 4519 0 2316 2352 2317 +4570 2 3 0 4520 0 2317 2352 2353 +4571 2 3 0 4521 0 2319 2317 2353 +4572 2 3 0 4522 0 2318 2317 2319 +4573 2 3 0 4523 0 2320 2319 2353 +4574 2 3 0 4524 0 2320 2353 2354 +4575 2 3 0 4525 0 2355 2320 2354 +4576 2 3 0 4526 0 2321 2320 2355 +4577 2 3 0 4527 0 2355 2356 2321 +4578 2 3 0 4528 0 2357 2321 2356 +4579 2 3 0 4529 0 2357 2322 2321 +4580 2 3 0 4530 0 2322 2357 2323 +4581 2 3 0 4531 0 2357 2324 2323 +4582 2 3 0 4532 0 2357 2325 2324 +4583 2 3 0 4533 0 2358 2325 2357 +4584 2 3 0 4534 0 2325 2358 2359 +4585 2 3 0 4535 0 2326 2325 2359 +4586 2 3 0 4536 0 2359 2327 2326 +4587 2 3 0 4537 0 2360 2327 2359 +4588 2 3 0 4538 0 2360 2361 2327 +4589 2 3 0 4539 0 2328 2327 2361 +4590 2 3 0 4540 0 2328 2361 2362 +4591 2 3 0 4541 0 2328 2362 2363 +4592 2 3 0 4542 0 2329 2328 2363 +4593 2 3 0 4543 0 2330 2329 2363 +4594 2 3 0 4544 0 2330 2363 2364 +4595 2 3 0 4545 0 2330 2364 2365 +4596 2 3 0 4546 0 2331 2330 2365 +4597 2 3 0 4547 0 2365 2332 2331 +4598 2 3 0 4548 0 2365 2333 2332 +4599 2 3 0 4549 0 2366 2333 2365 +4600 2 3 0 4550 0 2366 2367 2333 +4601 2 3 0 4551 0 2333 2367 2334 +4602 2 3 0 4552 0 2335 2334 2367 +4603 2 3 0 4553 0 2368 2335 2367 +4604 2 3 0 4554 0 2369 2335 2368 +4605 2 3 0 4555 0 2369 2370 2335 +4606 2 3 0 4556 0 2370 2336 2335 +4607 2 3 0 4557 0 2370 2371 2336 +4608 2 3 0 4558 0 2336 2371 2337 +4609 2 3 0 4559 0 2339 2372 2340 +4610 2 3 0 4560 0 2340 2372 2373 +4611 2 3 0 4561 0 2374 2340 2373 +4612 2 3 0 4562 0 2374 2341 2340 +4613 2 3 0 4563 0 2341 2374 2342 +4614 2 3 0 4564 0 2374 2343 2342 +4615 2 3 0 4565 0 2343 2374 2375 +4616 2 3 0 4566 0 2376 2343 2375 +4617 2 3 0 4567 0 2343 2376 2344 +4618 2 3 0 4568 0 2377 2344 2376 +4619 2 3 0 4569 0 2377 2345 2344 +4620 2 3 0 4570 0 2377 2378 2345 +4621 2 3 0 4571 0 2345 2378 2346 +4622 2 3 0 4572 0 2378 2379 2346 +4623 2 3 0 4573 0 2379 2347 2346 +4624 2 3 0 4574 0 2347 2379 2380 +4625 2 3 0 4575 0 2381 2347 2380 +4626 2 3 0 4576 0 2347 2381 2348 +4627 2 3 0 4577 0 2381 2349 2348 +4628 2 3 0 4578 0 2381 2382 2349 +4629 2 3 0 4579 0 2382 2383 2349 +4630 2 3 0 4580 0 2350 2349 2383 +4631 2 3 0 4581 0 2384 2350 2383 +4632 2 3 0 4582 0 2351 2350 2384 +4633 2 3 0 4583 0 2351 2384 2385 +4634 2 3 0 4584 0 2386 2351 2385 +4635 2 3 0 4585 0 2351 2386 2352 +4636 2 3 0 4586 0 2386 2353 2352 +4637 2 3 0 4587 0 2386 2354 2353 +4638 2 3 0 4588 0 2354 2386 2387 +4639 2 3 0 4589 0 2388 2354 2387 +4640 2 3 0 4590 0 2355 2354 2388 +4641 2 3 0 4591 0 2388 2389 2355 +4642 2 3 0 4592 0 2355 2389 2356 +4643 2 3 0 4593 0 2358 2356 2389 +4644 2 3 0 4594 0 2356 2358 2357 +4645 2 3 0 4595 0 2358 2389 2390 +4646 2 3 0 4596 0 2359 2358 2390 +4647 2 3 0 4597 0 2359 2390 2360 +4648 2 3 0 4598 0 2391 2360 2390 +4649 2 3 0 4599 0 2391 2361 2360 +4650 2 3 0 4600 0 2391 2392 2361 +4651 2 3 0 4601 0 2362 2361 2392 +4652 2 3 0 4602 0 2362 2392 2393 +4653 2 3 0 4603 0 2362 2393 2394 +4654 2 3 0 4604 0 2363 2362 2394 +4655 2 3 0 4605 0 2394 2364 2363 +4656 2 3 0 4606 0 2395 2364 2394 +4657 2 3 0 4607 0 2395 2365 2364 +4658 2 3 0 4608 0 2395 2366 2365 +4659 2 3 0 4609 0 2396 2366 2395 +4660 2 3 0 4610 0 2396 2367 2366 +4661 2 3 0 4611 0 2396 2368 2367 +4662 2 3 0 4612 0 2368 2396 2397 +4663 2 3 0 4613 0 2397 2369 2368 +4664 2 3 0 4614 0 2369 2397 2398 +4665 2 3 0 4615 0 2398 2399 2369 +4666 2 3 0 4616 0 2370 2369 2399 +4667 2 3 0 4617 0 2371 2370 2399 +4668 2 3 0 4618 0 2400 2374 2373 +4669 2 3 0 4619 0 2375 2374 2400 +4670 2 3 0 4620 0 2400 2401 2375 +4671 2 3 0 4621 0 2375 2401 2402 +4672 2 3 0 4622 0 2375 2402 2376 +4673 2 3 0 4623 0 2402 2403 2376 +4674 2 3 0 4624 0 2377 2376 2403 +4675 2 3 0 4625 0 2377 2403 2404 +4676 2 3 0 4626 0 2405 2377 2404 +4677 2 3 0 4627 0 2377 2405 2378 +4678 2 3 0 4628 0 2405 2379 2378 +4679 2 3 0 4629 0 2379 2405 2406 +4680 2 3 0 4630 0 2406 2380 2379 +4681 2 3 0 4631 0 2407 2380 2406 +4682 2 3 0 4632 0 2381 2380 2407 +4683 2 3 0 4633 0 2407 2408 2381 +4684 2 3 0 4634 0 2408 2382 2381 +4685 2 3 0 4635 0 2409 2382 2408 +4686 2 3 0 4636 0 2409 2383 2382 +4687 2 3 0 4637 0 2410 2383 2409 +4688 2 3 0 4638 0 2410 2384 2383 +4689 2 3 0 4639 0 2410 2411 2384 +4690 2 3 0 4640 0 2411 2385 2384 +4691 2 3 0 4641 0 2411 2387 2385 +4692 2 3 0 4642 0 2386 2385 2387 +4693 2 3 0 4643 0 2411 2412 2387 +4694 2 3 0 4644 0 2413 2387 2412 +4695 2 3 0 4645 0 2388 2387 2413 +4696 2 3 0 4646 0 2413 2414 2388 +4697 2 3 0 4647 0 2414 2415 2388 +4698 2 3 0 4648 0 2388 2415 2389 +4699 2 3 0 4649 0 2415 2390 2389 +4700 2 3 0 4650 0 2415 2416 2390 +4701 2 3 0 4651 0 2416 2391 2390 +4702 2 3 0 4652 0 2391 2416 2417 +4703 2 3 0 4653 0 2417 2392 2391 +4704 2 3 0 4654 0 2417 2418 2392 +4705 2 3 0 4655 0 2418 2393 2392 +4706 2 3 0 4656 0 2418 2419 2393 +4707 2 3 0 4657 0 2393 2419 2420 +4708 2 3 0 4658 0 2394 2393 2420 +4709 2 3 0 4659 0 2420 2421 2394 +4710 2 3 0 4660 0 2421 2395 2394 +4711 2 3 0 4661 0 2421 2396 2395 +4712 2 3 0 4662 0 2422 2396 2421 +4713 2 3 0 4663 0 2396 2422 2397 +4714 2 3 0 4664 0 2397 2422 2423 +4715 2 3 0 4665 0 2397 2423 2424 +4716 2 3 0 4666 0 2424 2398 2397 +4717 2 3 0 4667 0 2402 2401 2425 +4718 2 3 0 4668 0 2402 2425 2426 +4719 2 3 0 4669 0 2403 2402 2426 +4720 2 3 0 4670 0 2427 2403 2426 +4721 2 3 0 4671 0 2404 2403 2427 +4722 2 3 0 4672 0 2428 2404 2427 +4723 2 3 0 4673 0 2405 2404 2428 +4724 2 3 0 4674 0 2405 2428 2429 +4725 2 3 0 4675 0 2405 2429 2406 +4726 2 3 0 4676 0 2429 2430 2406 +4727 2 3 0 4677 0 2407 2406 2430 +4728 2 3 0 4678 0 2431 2407 2430 +4729 2 3 0 4679 0 2408 2407 2431 +4730 2 3 0 4680 0 2432 2408 2431 +4731 2 3 0 4681 0 2409 2408 2432 +4732 2 3 0 4682 0 2433 2409 2432 +4733 2 3 0 4683 0 2433 2410 2409 +4734 2 3 0 4684 0 2410 2433 2434 +4735 2 3 0 4685 0 2411 2410 2434 +4736 2 3 0 4686 0 2411 2434 2412 +4737 2 3 0 4687 0 2435 2412 2434 +4738 2 3 0 4688 0 2436 2412 2435 +4739 2 3 0 4689 0 2436 2437 2412 +4740 2 3 0 4690 0 2413 2412 2437 +4741 2 3 0 4691 0 2437 2414 2413 +4742 2 3 0 4692 0 2437 2438 2414 +4743 2 3 0 4693 0 2438 2439 2414 +4744 2 3 0 4694 0 2416 2414 2439 +4745 2 3 0 4695 0 2416 2415 2414 +4746 2 3 0 4696 0 2416 2439 2417 +4747 2 3 0 4697 0 2417 2439 2440 +4748 2 3 0 4698 0 2440 2441 2417 +4749 2 3 0 4699 0 2441 2418 2417 +4750 2 3 0 4700 0 2441 2442 2418 +4751 2 3 0 4701 0 2442 2419 2418 +4752 2 3 0 4702 0 2419 2442 2443 +4753 2 3 0 4703 0 2420 2419 2443 +4754 2 3 0 4704 0 2443 2421 2420 +4755 2 3 0 4705 0 2443 2444 2421 +4756 2 3 0 4706 0 2444 2422 2421 +4757 2 3 0 4707 0 2422 2444 2445 +4758 2 3 0 4708 0 2423 2422 2445 +4759 2 3 0 4709 0 2427 2426 2446 +4760 2 3 0 4710 0 2427 2446 2447 +4761 2 3 0 4711 0 2447 2448 2427 +4762 2 3 0 4712 0 2427 2448 2428 +4763 2 3 0 4713 0 2448 2449 2428 +4764 2 3 0 4714 0 2429 2428 2449 +4765 2 3 0 4715 0 2450 2429 2449 +4766 2 3 0 4716 0 2429 2450 2430 +4767 2 3 0 4717 0 2430 2450 2451 +4768 2 3 0 4718 0 2452 2430 2451 +4769 2 3 0 4719 0 2431 2430 2452 +4770 2 3 0 4720 0 2452 2453 2431 +4771 2 3 0 4721 0 2454 2431 2453 +4772 2 3 0 4722 0 2432 2431 2454 +4773 2 3 0 4723 0 2455 2432 2454 +4774 2 3 0 4724 0 2433 2432 2455 +4775 2 3 0 4725 0 2455 2456 2433 +4776 2 3 0 4726 0 2456 2434 2433 +4777 2 3 0 4727 0 2456 2435 2434 +4778 2 3 0 4728 0 2456 2457 2435 +4779 2 3 0 4729 0 2457 2458 2435 +4780 2 3 0 4730 0 2458 2436 2435 +4781 2 3 0 4731 0 2458 2459 2436 +4782 2 3 0 4732 0 2459 2460 2436 +4783 2 3 0 4733 0 2460 2437 2436 +4784 2 3 0 4734 0 2460 2438 2437 +4785 2 3 0 4735 0 2460 2461 2438 +4786 2 3 0 4736 0 2462 2438 2461 +4787 2 3 0 4737 0 2438 2462 2439 +4788 2 3 0 4738 0 2439 2462 2440 +4789 2 3 0 4739 0 2440 2462 2463 +4790 2 3 0 4740 0 2440 2463 2464 +4791 2 3 0 4741 0 2464 2441 2440 +4792 2 3 0 4742 0 2465 2441 2464 +4793 2 3 0 4743 0 2441 2465 2466 +4794 2 3 0 4744 0 2442 2441 2466 +4795 2 3 0 4745 0 2442 2466 2467 +4796 2 3 0 4746 0 2443 2442 2467 +4797 2 3 0 4747 0 2467 2468 2443 +4798 2 3 0 4748 0 2468 2444 2443 +4799 2 3 0 4749 0 2445 2444 2468 +4800 2 3 0 4750 0 2445 2468 2469 +4801 2 3 0 4751 0 2447 2470 2448 +4802 2 3 0 4752 0 2471 2448 2470 +4803 2 3 0 4753 0 2471 2449 2448 +4804 2 3 0 4754 0 2472 2449 2471 +4805 2 3 0 4755 0 2449 2472 2450 +4806 2 3 0 4756 0 2472 2473 2450 +4807 2 3 0 4757 0 2473 2451 2450 +4808 2 3 0 4758 0 2473 2474 2451 +4809 2 3 0 4759 0 2451 2474 2475 +4810 2 3 0 4760 0 2452 2451 2475 +4811 2 3 0 4761 0 2452 2475 2453 +4812 2 3 0 4762 0 2453 2475 2476 +4813 2 3 0 4763 0 2477 2453 2476 +4814 2 3 0 4764 0 2477 2454 2453 +4815 2 3 0 4765 0 2478 2454 2477 +4816 2 3 0 4766 0 2455 2454 2478 +4817 2 3 0 4767 0 2455 2478 2479 +4818 2 3 0 4768 0 2456 2455 2479 +4819 2 3 0 4769 0 2457 2456 2479 +4820 2 3 0 4770 0 2457 2479 2480 +4821 2 3 0 4771 0 2457 2480 2481 +4822 2 3 0 4772 0 2458 2457 2481 +4823 2 3 0 4773 0 2482 2458 2481 +4824 2 3 0 4774 0 2459 2458 2482 +4825 2 3 0 4775 0 2482 2483 2459 +4826 2 3 0 4776 0 2459 2483 2461 +4827 2 3 0 4777 0 2461 2460 2459 +4828 2 3 0 4778 0 2461 2483 2484 +4829 2 3 0 4779 0 2484 2463 2461 +4830 2 3 0 4780 0 2462 2461 2463 +4831 2 3 0 4781 0 2484 2485 2463 +4832 2 3 0 4782 0 2485 2486 2463 +4833 2 3 0 4783 0 2486 2464 2463 +4834 2 3 0 4784 0 2487 2464 2486 +4835 2 3 0 4785 0 2487 2465 2464 +4836 2 3 0 4786 0 2465 2487 2488 +4837 2 3 0 4787 0 2466 2465 2488 +4838 2 3 0 4788 0 2466 2488 2489 +4839 2 3 0 4789 0 2489 2490 2466 +4840 2 3 0 4790 0 2466 2490 2467 +4841 2 3 0 4791 0 2491 2467 2490 +4842 2 3 0 4792 0 2491 2468 2467 +4843 2 3 0 4793 0 2469 2468 2491 +4844 2 3 0 4794 0 2493 2492 2470 +4845 2 3 0 4795 0 2492 2471 2470 +4846 2 3 0 4796 0 2494 2471 2492 +4847 2 3 0 4797 0 2494 2472 2471 +4848 2 3 0 4798 0 2494 2495 2472 +4849 2 3 0 4799 0 2473 2472 2495 +4850 2 3 0 4800 0 2473 2495 2496 +4851 2 3 0 4801 0 2473 2496 2474 +4852 2 3 0 4802 0 2474 2496 2497 +4853 2 3 0 4803 0 2498 2474 2497 +4854 2 3 0 4804 0 2498 2475 2474 +4855 2 3 0 4805 0 2498 2476 2475 +4856 2 3 0 4806 0 2498 2499 2476 +4857 2 3 0 4807 0 2476 2499 2500 +4858 2 3 0 4808 0 2477 2476 2500 +4859 2 3 0 4809 0 2477 2500 2501 +4860 2 3 0 4810 0 2502 2477 2501 +4861 2 3 0 4811 0 2477 2502 2478 +4862 2 3 0 4812 0 2502 2503 2478 +4863 2 3 0 4813 0 2503 2479 2478 +4864 2 3 0 4814 0 2480 2479 2503 +4865 2 3 0 4815 0 2503 2504 2480 +4866 2 3 0 4816 0 2505 2480 2504 +4867 2 3 0 4817 0 2505 2506 2480 +4868 2 3 0 4818 0 2481 2480 2506 +4869 2 3 0 4819 0 2507 2481 2506 +4870 2 3 0 4820 0 2481 2507 2482 +4871 2 3 0 4821 0 2508 2482 2507 +4872 2 3 0 4822 0 2482 2508 2509 +4873 2 3 0 4823 0 2483 2482 2509 +4874 2 3 0 4824 0 2510 2483 2509 +4875 2 3 0 4825 0 2510 2484 2483 +4876 2 3 0 4826 0 2485 2484 2510 +4877 2 3 0 4827 0 2485 2510 2511 +4878 2 3 0 4828 0 2512 2485 2511 +4879 2 3 0 4829 0 2512 2486 2485 +4880 2 3 0 4830 0 2513 2486 2512 +4881 2 3 0 4831 0 2513 2487 2486 +4882 2 3 0 4832 0 2487 2513 2514 +4883 2 3 0 4833 0 2487 2514 2515 +4884 2 3 0 4834 0 2488 2487 2515 +4885 2 3 0 4835 0 2493 2516 2492 +4886 2 3 0 4836 0 2517 2492 2516 +4887 2 3 0 4837 0 2494 2492 2517 +4888 2 3 0 4838 0 2494 2517 2518 +4889 2 3 0 4839 0 2494 2518 2495 +4890 2 3 0 4840 0 2495 2518 2496 +4891 2 3 0 4841 0 2519 2496 2518 +4892 2 3 0 4842 0 2519 2497 2496 +4893 2 3 0 4843 0 2519 2520 2497 +4894 2 3 0 4844 0 2520 2499 2497 +4895 2 3 0 4845 0 2498 2497 2499 +4896 2 3 0 4846 0 2521 2499 2520 +4897 2 3 0 4847 0 2521 2500 2499 +4898 2 3 0 4848 0 2521 2522 2500 +4899 2 3 0 4849 0 2501 2500 2522 +4900 2 3 0 4850 0 2523 2501 2522 +4901 2 3 0 4851 0 2523 2502 2501 +4902 2 3 0 4852 0 2523 2524 2502 +4903 2 3 0 4853 0 2503 2502 2524 +4904 2 3 0 4854 0 2503 2524 2525 +4905 2 3 0 4855 0 2503 2525 2504 +4906 2 3 0 4856 0 2504 2525 2526 +4907 2 3 0 4857 0 2505 2504 2526 +4908 2 3 0 4858 0 2505 2526 2527 +4909 2 3 0 4859 0 2505 2527 2528 +4910 2 3 0 4860 0 2505 2528 2529 +4911 2 3 0 4861 0 2505 2529 2506 +4912 2 3 0 4862 0 2530 2506 2529 +4913 2 3 0 4863 0 2530 2531 2506 +4914 2 3 0 4864 0 2531 2507 2506 +4915 2 3 0 4865 0 2508 2507 2531 +4916 2 3 0 4866 0 2508 2531 2532 +4917 2 3 0 4867 0 2508 2532 2533 +4918 2 3 0 4868 0 2508 2533 2509 +4919 2 3 0 4869 0 2534 2509 2533 +4920 2 3 0 4870 0 2510 2509 2534 +4921 2 3 0 4871 0 2511 2510 2534 +4922 2 3 0 4872 0 2535 2511 2534 +4923 2 3 0 4873 0 2535 2536 2511 +4924 2 3 0 4874 0 2512 2511 2536 +4925 2 3 0 4875 0 2537 2512 2536 +4926 2 3 0 4876 0 2513 2512 2537 +4927 2 3 0 4877 0 2513 2537 2514 +4928 2 3 0 4878 0 2538 2517 2516 +4929 2 3 0 4879 0 2538 2539 2517 +4930 2 3 0 4880 0 2518 2517 2539 +4931 2 3 0 4881 0 2519 2518 2539 +4932 2 3 0 4882 0 2519 2539 2540 +4933 2 3 0 4883 0 2519 2540 2541 +4934 2 3 0 4884 0 2519 2541 2520 +4935 2 3 0 4885 0 2520 2541 2542 +4936 2 3 0 4886 0 2521 2520 2542 +4937 2 3 0 4887 0 2521 2542 2543 +4938 2 3 0 4888 0 2521 2543 2544 +4939 2 3 0 4889 0 2521 2544 2522 +4940 2 3 0 4890 0 2544 2545 2522 +4941 2 3 0 4891 0 2523 2522 2545 +4942 2 3 0 4892 0 2523 2545 2524 +4943 2 3 0 4893 0 2525 2524 2545 +4944 2 3 0 4894 0 2546 2525 2545 +4945 2 3 0 4895 0 2546 2526 2525 +4946 2 3 0 4896 0 2546 2547 2526 +4947 2 3 0 4897 0 2526 2547 2527 +4948 2 3 0 4898 0 2548 2527 2547 +4949 2 3 0 4899 0 2548 2549 2527 +4950 2 3 0 4900 0 2527 2549 2528 +4951 2 3 0 4901 0 2550 2528 2549 +4952 2 3 0 4902 0 2550 2551 2528 +4953 2 3 0 4903 0 2529 2528 2551 +4954 2 3 0 4904 0 2530 2529 2551 +4955 2 3 0 4905 0 2530 2551 2552 +4956 2 3 0 4906 0 2530 2552 2531 +4957 2 3 0 4907 0 2531 2552 2532 +4958 2 3 0 4908 0 2553 2532 2552 +4959 2 3 0 4909 0 2553 2554 2532 +4960 2 3 0 4910 0 2532 2554 2533 +4961 2 3 0 4911 0 2555 2533 2554 +4962 2 3 0 4912 0 2555 2534 2533 +4963 2 3 0 4913 0 2555 2535 2534 +4964 2 3 0 4914 0 2555 2556 2535 +4965 2 3 0 4915 0 2557 2535 2556 +4966 2 3 0 4916 0 2535 2557 2536 +4967 2 3 0 4917 0 2538 2558 2539 +4968 2 3 0 4918 0 2540 2539 2558 +4969 2 3 0 4919 0 2559 2540 2558 +4970 2 3 0 4920 0 2559 2560 2540 +4971 2 3 0 4921 0 2560 2541 2540 +4972 2 3 0 4922 0 2560 2542 2541 +4973 2 3 0 4923 0 2561 2542 2560 +4974 2 3 0 4924 0 2543 2542 2561 +4975 2 3 0 4925 0 2543 2561 2562 +4976 2 3 0 4926 0 2543 2562 2563 +4977 2 3 0 4927 0 2563 2544 2543 +4978 2 3 0 4928 0 2546 2544 2563 +4979 2 3 0 4929 0 2546 2545 2544 +4980 2 3 0 4930 0 2546 2563 2547 +4981 2 3 0 4931 0 2547 2563 2564 +4982 2 3 0 4932 0 2548 2547 2564 +4983 2 3 0 4933 0 2548 2564 2565 +4984 2 3 0 4934 0 2548 2565 2566 +4985 2 3 0 4935 0 2548 2566 2549 +4986 2 3 0 4936 0 2567 2549 2566 +4987 2 3 0 4937 0 2550 2549 2567 +4988 2 3 0 4938 0 2550 2567 2568 +4989 2 3 0 4939 0 2550 2568 2569 +4990 2 3 0 4940 0 2550 2569 2551 +4991 2 3 0 4941 0 2551 2569 2552 +4992 2 3 0 4942 0 2553 2552 2569 +4993 2 3 0 4943 0 2553 2569 2570 +4994 2 3 0 4944 0 2553 2570 2571 +4995 2 3 0 4945 0 2553 2571 2554 +4996 2 3 0 4946 0 2554 2571 2572 +4997 2 3 0 4947 0 2555 2554 2572 +4998 2 3 0 4948 0 2555 2572 2556 +4999 2 3 0 4949 0 2573 2556 2572 +5000 2 3 0 4950 0 2557 2556 2573 +5001 2 3 0 4951 0 2560 2559 2574 +5002 2 3 0 4952 0 2575 2560 2574 +5003 2 3 0 4953 0 2575 2561 2560 +5004 2 3 0 4954 0 2561 2575 2576 +5005 2 3 0 4955 0 2577 2561 2576 +5006 2 3 0 4956 0 2561 2577 2562 +5007 2 3 0 4957 0 2578 2562 2577 +5008 2 3 0 4958 0 2578 2579 2562 +5009 2 3 0 4959 0 2579 2564 2562 +5010 2 3 0 4960 0 2564 2563 2562 +5011 2 3 0 4961 0 2579 2580 2564 +5012 2 3 0 4962 0 2565 2564 2580 +5013 2 3 0 4963 0 2581 2565 2580 +5014 2 3 0 4964 0 2582 2565 2581 +5015 2 3 0 4965 0 2583 2565 2582 +5016 2 3 0 4966 0 2566 2565 2583 +5017 2 3 0 4967 0 2566 2583 2584 +5018 2 3 0 4968 0 2584 2567 2566 +5019 2 3 0 4969 0 2585 2567 2584 +5020 2 3 0 4970 0 2568 2567 2585 +5021 2 3 0 4971 0 2568 2585 2586 +5022 2 3 0 4972 0 2568 2586 2570 +5023 2 3 0 4973 0 2570 2569 2568 +5024 2 3 0 4974 0 2587 2570 2586 +5025 2 3 0 4975 0 2570 2587 2571 +5026 2 3 0 4976 0 2588 2571 2587 +5027 2 3 0 4977 0 2588 2572 2571 +5028 2 3 0 4978 0 2588 2573 2572 +5029 2 3 0 4979 0 2577 2576 2589 +5030 2 3 0 4980 0 2578 2590 2579 +5031 2 3 0 4981 0 2590 2591 2579 +5032 2 3 0 4982 0 2591 2580 2579 +5033 2 3 0 4983 0 2591 2592 2580 +5034 2 3 0 4984 0 2592 2581 2580 +5035 2 3 0 4985 0 2581 2592 2593 +5036 2 3 0 4986 0 2594 2581 2593 +5037 2 3 0 4987 0 2594 2582 2581 +5038 2 3 0 4988 0 2594 2595 2582 +5039 2 3 0 4989 0 2582 2595 2596 +5040 2 3 0 4990 0 2596 2583 2582 +5041 2 3 0 4991 0 2583 2596 2597 +5042 2 3 0 4992 0 2583 2597 2598 +5043 2 3 0 4993 0 2583 2598 2584 +5044 2 3 0 4994 0 2584 2598 2599 +5045 2 3 0 4995 0 2599 2585 2584 +5046 2 3 0 4996 0 2600 2585 2599 +5047 2 3 0 4997 0 2586 2585 2600 +5048 2 3 0 4998 0 2586 2600 2601 +5049 2 3 0 4999 0 2586 2601 2602 +5050 2 3 0 5000 0 2602 2587 2586 +5051 2 3 0 5001 0 2590 2603 2591 +5052 2 3 0 5002 0 2604 2591 2603 +5053 2 3 0 5003 0 2604 2605 2591 +5054 2 3 0 5004 0 2592 2591 2605 +5055 2 3 0 5005 0 2592 2605 2593 +5056 2 3 0 5006 0 2593 2605 2606 +5057 2 3 0 5007 0 2593 2606 2607 +5058 2 3 0 5008 0 2594 2593 2607 +5059 2 3 0 5009 0 2595 2608 2596 +5060 2 3 0 5010 0 2609 2596 2608 +5061 2 3 0 5011 0 2596 2609 2610 +5062 2 3 0 5012 0 2610 2597 2596 +5063 2 3 0 5013 0 2610 2611 2597 +5064 2 3 0 5014 0 2597 2611 2612 +5065 2 3 0 5015 0 2598 2597 2612 +5066 2 3 0 5016 0 2598 2612 2613 +5067 2 3 0 5017 0 2599 2598 2613 +5068 2 3 0 5018 0 2599 2613 2614 +5069 2 3 0 5019 0 2600 2599 2614 +5070 2 3 0 5020 0 2600 2614 2615 +5071 2 3 0 5021 0 2601 2600 2615 +5072 2 3 0 5022 0 2616 2604 2603 +5073 2 3 0 5023 0 2617 2604 2616 +5074 2 3 0 5024 0 2618 2604 2617 +5075 2 3 0 5025 0 2618 2605 2604 +5076 2 3 0 5026 0 2606 2605 2618 +5077 2 3 0 5027 0 2606 2618 2619 +5078 2 3 0 5028 0 2619 2620 2606 +5079 2 3 0 5029 0 2621 2606 2620 +5080 2 3 0 5030 0 2607 2606 2621 +5081 2 3 0 5031 0 2617 2616 2622 +5082 2 3 0 5032 0 2622 2623 2617 +5083 2 3 0 5033 0 2623 2624 2617 +5084 2 3 0 5034 0 2617 2624 2618 +5085 2 3 0 5035 0 2618 2624 2625 +5086 2 3 0 5036 0 2618 2625 2626 +5087 2 3 0 5037 0 2618 2626 2619 +5088 2 3 0 5038 0 2619 2626 2627 +5089 2 3 0 5039 0 2627 2620 2619 +5090 2 3 0 5040 0 2628 2623 2622 +5091 2 3 0 5041 0 2628 2629 2623 +5092 2 3 0 5042 0 2630 2623 2629 +5093 2 3 0 5043 0 2631 2623 2630 +5094 2 3 0 5044 0 2631 2624 2623 +5095 2 3 0 5045 0 2631 2625 2624 +5096 2 3 0 5046 0 2631 2632 2625 +5097 2 3 0 5047 0 2625 2632 2633 +5098 2 3 0 5048 0 2633 2634 2625 +5099 2 3 0 5049 0 2625 2634 2626 +5100 2 3 0 5050 0 2626 2634 2635 +5101 2 3 0 5051 0 2626 2635 2636 +5102 2 3 0 5052 0 2627 2626 2636 +5103 2 3 0 5053 0 2637 2629 2638 +5104 2 3 0 5054 0 2637 2630 2629 +5105 2 3 0 5055 0 2639 2630 2637 +5106 2 3 0 5056 0 2630 2639 2640 +5107 2 3 0 5057 0 2631 2630 2640 +5108 2 3 0 5058 0 2631 2640 2632 +5109 2 3 0 5059 0 2641 2632 2640 +5110 2 3 0 5060 0 2642 2632 2641 +5111 2 3 0 5061 0 2642 2633 2632 +5112 2 3 0 5062 0 2642 2643 2633 +5113 2 3 0 5063 0 2644 2633 2643 +5114 2 3 0 5064 0 2633 2644 2634 +5115 2 3 0 5065 0 2644 2645 2634 +5116 2 3 0 5066 0 2634 2645 2635 +5117 2 3 0 5067 0 2646 2637 2638 +5118 2 3 0 5068 0 2647 2637 2646 +5119 2 3 0 5069 0 2647 2639 2637 +5120 2 3 0 5070 0 2647 2648 2639 +5121 2 3 0 5071 0 2639 2648 2649 +5122 2 3 0 5072 0 2650 2639 2649 +5123 2 3 0 5073 0 2650 2640 2639 +5124 2 3 0 5074 0 2650 2641 2640 +5125 2 3 0 5075 0 2650 2651 2641 +5126 2 3 0 5076 0 2651 2652 2641 +5127 2 3 0 5077 0 2642 2641 2652 +5128 2 3 0 5078 0 2642 2652 2653 +5129 2 3 0 5079 0 2642 2653 2643 +5130 2 3 0 5080 0 2653 2654 2643 +5131 2 3 0 5081 0 2655 2643 2654 +5132 2 3 0 5082 0 2644 2643 2655 +5133 2 3 0 5083 0 2656 2644 2655 +5134 2 3 0 5084 0 2644 2656 2645 +5135 2 3 0 5085 0 2646 2657 2647 +5136 2 3 0 5086 0 2657 2658 2647 +5137 2 3 0 5087 0 2647 2658 2648 +5138 2 3 0 5088 0 2658 2659 2648 +5139 2 3 0 5089 0 2660 2648 2659 +5140 2 3 0 5090 0 2660 2649 2648 +5141 2 3 0 5091 0 2660 2661 2649 +5142 2 3 0 5092 0 2662 2649 2661 +5143 2 3 0 5093 0 2650 2649 2662 +5144 2 3 0 5094 0 2650 2662 2651 +5145 2 3 0 5095 0 2651 2662 2663 +5146 2 3 0 5096 0 2664 2651 2663 +5147 2 3 0 5097 0 2664 2652 2651 +5148 2 3 0 5098 0 2664 2665 2652 +5149 2 3 0 5099 0 2652 2665 2653 +5150 2 3 0 5100 0 2666 2653 2665 +5151 2 3 0 5101 0 2667 2653 2666 +5152 2 3 0 5102 0 2667 2654 2653 +5153 2 3 0 5103 0 2667 2668 2654 +5154 2 3 0 5104 0 2654 2668 2669 +5155 2 3 0 5105 0 2655 2654 2669 +5156 2 3 0 5106 0 2655 2669 2670 +5157 2 3 0 5107 0 2656 2655 2670 +5158 2 3 0 5108 0 2671 2659 2658 +5159 2 3 0 5109 0 2671 2672 2659 +5160 2 3 0 5110 0 2659 2672 2673 +5161 2 3 0 5111 0 2660 2659 2673 +5162 2 3 0 5112 0 2660 2673 2674 +5163 2 3 0 5113 0 2660 2674 2661 +5164 2 3 0 5114 0 2675 2661 2674 +5165 2 3 0 5115 0 2676 2661 2675 +5166 2 3 0 5116 0 2676 2663 2661 +5167 2 3 0 5117 0 2663 2662 2661 +5168 2 3 0 5118 0 2676 2677 2663 +5169 2 3 0 5119 0 2663 2677 2678 +5170 2 3 0 5120 0 2664 2663 2678 +5171 2 3 0 5121 0 2664 2678 2665 +5172 2 3 0 5122 0 2665 2678 2679 +5173 2 3 0 5123 0 2666 2665 2679 +5174 2 3 0 5124 0 2666 2679 2680 +5175 2 3 0 5125 0 2666 2680 2681 +5176 2 3 0 5126 0 2667 2666 2681 +5177 2 3 0 5127 0 2667 2681 2682 +5178 2 3 0 5128 0 2667 2682 2668 +5179 2 3 0 5129 0 2683 2668 2682 +5180 2 3 0 5130 0 2684 2668 2683 +5181 2 3 0 5131 0 2669 2668 2684 +5182 2 3 0 5132 0 2685 2669 2684 +5183 2 3 0 5133 0 2669 2685 2686 +5184 2 3 0 5134 0 2670 2669 2686 +5185 2 3 0 5135 0 2671 2687 2672 +5186 2 3 0 5136 0 2687 2688 2672 +5187 2 3 0 5137 0 2689 2672 2688 +5188 2 3 0 5138 0 2689 2673 2672 +5189 2 3 0 5139 0 2689 2690 2673 +5190 2 3 0 5140 0 2673 2690 2674 +5191 2 3 0 5141 0 2691 2674 2690 +5192 2 3 0 5142 0 2691 2675 2674 +5193 2 3 0 5143 0 2691 2692 2675 +5194 2 3 0 5144 0 2692 2693 2675 +5195 2 3 0 5145 0 2676 2675 2693 +5196 2 3 0 5146 0 2693 2694 2676 +5197 2 3 0 5147 0 2676 2694 2677 +5198 2 3 0 5148 0 2677 2694 2695 +5199 2 3 0 5149 0 2696 2677 2695 +5200 2 3 0 5150 0 2696 2678 2677 +5201 2 3 0 5151 0 2696 2679 2678 +5202 2 3 0 5152 0 2696 2697 2679 +5203 2 3 0 5153 0 2698 2679 2697 +5204 2 3 0 5154 0 2679 2698 2680 +5205 2 3 0 5155 0 2698 2699 2680 +5206 2 3 0 5156 0 2680 2699 2681 +5207 2 3 0 5157 0 2700 2681 2699 +5208 2 3 0 5158 0 2701 2681 2700 +5209 2 3 0 5159 0 2701 2682 2681 +5210 2 3 0 5160 0 2701 2683 2682 +5211 2 3 0 5161 0 2701 2702 2683 +5212 2 3 0 5162 0 2703 2683 2702 +5213 2 3 0 5163 0 2683 2703 2704 +5214 2 3 0 5164 0 2683 2704 2684 +5215 2 3 0 5165 0 2684 2704 2705 +5216 2 3 0 5166 0 2706 2684 2705 +5217 2 3 0 5167 0 2706 2685 2684 +5218 2 3 0 5168 0 2707 2688 2687 +5219 2 3 0 5169 0 2707 2708 2688 +5220 2 3 0 5170 0 2708 2709 2688 +5221 2 3 0 5171 0 2688 2709 2710 +5222 2 3 0 5172 0 2689 2688 2710 +5223 2 3 0 5173 0 2689 2710 2690 +5224 2 3 0 5174 0 2710 2711 2690 +5225 2 3 0 5175 0 2691 2690 2711 +5226 2 3 0 5176 0 2691 2711 2692 +5227 2 3 0 5177 0 2712 2692 2711 +5228 2 3 0 5178 0 2712 2713 2692 +5229 2 3 0 5179 0 2713 2693 2692 +5230 2 3 0 5180 0 2713 2714 2693 +5231 2 3 0 5181 0 2693 2714 2694 +5232 2 3 0 5182 0 2694 2714 2695 +5233 2 3 0 5183 0 2715 2695 2714 +5234 2 3 0 5184 0 2715 2716 2695 +5235 2 3 0 5185 0 2716 2697 2695 +5236 2 3 0 5186 0 2696 2695 2697 +5237 2 3 0 5187 0 2698 2697 2716 +5238 2 3 0 5188 0 2698 2716 2717 +5239 2 3 0 5189 0 2698 2717 2699 +5240 2 3 0 5190 0 2718 2699 2717 +5241 2 3 0 5191 0 2699 2718 2700 +5242 2 3 0 5192 0 2718 2719 2700 +5243 2 3 0 5193 0 2719 2720 2700 +5244 2 3 0 5194 0 2700 2720 2721 +5245 2 3 0 5195 0 2701 2700 2721 +5246 2 3 0 5196 0 2701 2721 2702 +5247 2 3 0 5197 0 2721 2722 2702 +5248 2 3 0 5198 0 2722 2723 2702 +5249 2 3 0 5199 0 2723 2703 2702 +5250 2 3 0 5200 0 2724 2703 2723 +5251 2 3 0 5201 0 2725 2703 2724 +5252 2 3 0 5202 0 2704 2703 2725 +5253 2 3 0 5203 0 2705 2704 2725 +5254 2 3 0 5204 0 2707 2726 2708 +5255 2 3 0 5205 0 2726 2727 2708 +5256 2 3 0 5206 0 2728 2708 2727 +5257 2 3 0 5207 0 2728 2729 2708 +5258 2 3 0 5208 0 2708 2729 2709 +5259 2 3 0 5209 0 2730 2709 2729 +5260 2 3 0 5210 0 2730 2710 2709 +5261 2 3 0 5211 0 2730 2711 2710 +5262 2 3 0 5212 0 2730 2731 2711 +5263 2 3 0 5213 0 2731 2712 2711 +5264 2 3 0 5214 0 2731 2732 2712 +5265 2 3 0 5215 0 2712 2732 2733 +5266 2 3 0 5216 0 2733 2713 2712 +5267 2 3 0 5217 0 2733 2734 2713 +5268 2 3 0 5218 0 2734 2735 2713 +5269 2 3 0 5219 0 2735 2714 2713 +5270 2 3 0 5220 0 2714 2735 2736 +5271 2 3 0 5221 0 2715 2714 2736 +5272 2 3 0 5222 0 2715 2736 2737 +5273 2 3 0 5223 0 2715 2737 2738 +5274 2 3 0 5224 0 2715 2738 2716 +5275 2 3 0 5225 0 2738 2717 2716 +5276 2 3 0 5226 0 2739 2717 2738 +5277 2 3 0 5227 0 2739 2718 2717 +5278 2 3 0 5228 0 2739 2740 2718 +5279 2 3 0 5229 0 2718 2740 2719 +5280 2 3 0 5230 0 2741 2719 2740 +5281 2 3 0 5231 0 2720 2719 2741 +5282 2 3 0 5232 0 2742 2720 2741 +5283 2 3 0 5233 0 2742 2743 2720 +5284 2 3 0 5234 0 2720 2743 2721 +5285 2 3 0 5235 0 2722 2721 2743 +5286 2 3 0 5236 0 2722 2743 2744 +5287 2 3 0 5237 0 2722 2744 2723 +5288 2 3 0 5238 0 2745 2723 2744 +5289 2 3 0 5239 0 2724 2723 2745 +5290 2 3 0 5240 0 2724 2745 2746 +5291 2 3 0 5241 0 2747 2727 2726 +5292 2 3 0 5242 0 2747 2748 2727 +5293 2 3 0 5243 0 2728 2727 2748 +5294 2 3 0 5244 0 2748 2749 2728 +5295 2 3 0 5245 0 2728 2749 2750 +5296 2 3 0 5246 0 2750 2729 2728 +5297 2 3 0 5247 0 2750 2732 2729 +5298 2 3 0 5248 0 2729 2732 2731 +5299 2 3 0 5249 0 2730 2729 2731 +5300 2 3 0 5250 0 2732 2750 2751 +5301 2 3 0 5251 0 2732 2751 2752 +5302 2 3 0 5252 0 2732 2752 2733 +5303 2 3 0 5253 0 2733 2752 2753 +5304 2 3 0 5254 0 2734 2733 2753 +5305 2 3 0 5255 0 2734 2753 2754 +5306 2 3 0 5256 0 2734 2754 2755 +5307 2 3 0 5257 0 2755 2735 2734 +5308 2 3 0 5258 0 2755 2756 2735 +5309 2 3 0 5259 0 2736 2735 2756 +5310 2 3 0 5260 0 2736 2756 2757 +5311 2 3 0 5261 0 2758 2736 2757 +5312 2 3 0 5262 0 2737 2736 2758 +5313 2 3 0 5263 0 2737 2758 2759 +5314 2 3 0 5264 0 2738 2737 2759 +5315 2 3 0 5265 0 2759 2739 2738 +5316 2 3 0 5266 0 2739 2759 2740 +5317 2 3 0 5267 0 2760 2740 2759 +5318 2 3 0 5268 0 2760 2741 2740 +5319 2 3 0 5269 0 2760 2761 2741 +5320 2 3 0 5270 0 2741 2761 2762 +5321 2 3 0 5271 0 2742 2741 2762 +5322 2 3 0 5272 0 2742 2762 2763 +5323 2 3 0 5273 0 2742 2763 2764 +5324 2 3 0 5274 0 2742 2764 2743 +5325 2 3 0 5275 0 2764 2744 2743 +5326 2 3 0 5276 0 2765 2744 2764 +5327 2 3 0 5277 0 2765 2745 2744 +5328 2 3 0 5278 0 2765 2766 2745 +5329 2 3 0 5279 0 2745 2766 2746 +5330 2 3 0 5280 0 2767 2746 2766 +5331 2 3 0 5281 0 2748 2768 2749 +5332 2 3 0 5282 0 2749 2768 2769 +5333 2 3 0 5283 0 2770 2749 2769 +5334 2 3 0 5284 0 2749 2770 2750 +5335 2 3 0 5285 0 2750 2770 2751 +5336 2 3 0 5286 0 2770 2771 2751 +5337 2 3 0 5287 0 2751 2771 2772 +5338 2 3 0 5288 0 2772 2752 2751 +5339 2 3 0 5289 0 2772 2753 2752 +5340 2 3 0 5290 0 2773 2753 2772 +5341 2 3 0 5291 0 2774 2753 2773 +5342 2 3 0 5292 0 2754 2753 2774 +5343 2 3 0 5293 0 2754 2774 2775 +5344 2 3 0 5294 0 2754 2775 2776 +5345 2 3 0 5295 0 2755 2754 2776 +5346 2 3 0 5296 0 2756 2755 2776 +5347 2 3 0 5297 0 2776 2777 2756 +5348 2 3 0 5298 0 2777 2757 2756 +5349 2 3 0 5299 0 2778 2757 2777 +5350 2 3 0 5300 0 2779 2757 2778 +5351 2 3 0 5301 0 2779 2758 2757 +5352 2 3 0 5302 0 2779 2760 2758 +5353 2 3 0 5303 0 2760 2759 2758 +5354 2 3 0 5304 0 2760 2779 2761 +5355 2 3 0 5305 0 2780 2761 2779 +5356 2 3 0 5306 0 2780 2762 2761 +5357 2 3 0 5307 0 2780 2781 2762 +5358 2 3 0 5308 0 2763 2762 2781 +5359 2 3 0 5309 0 2782 2763 2781 +5360 2 3 0 5310 0 2782 2783 2763 +5361 2 3 0 5311 0 2764 2763 2783 +5362 2 3 0 5312 0 2765 2764 2783 +5363 2 3 0 5313 0 2765 2783 2784 +5364 2 3 0 5314 0 2765 2784 2766 +5365 2 3 0 5315 0 2785 2766 2784 +5366 2 3 0 5316 0 2767 2766 2785 +5367 2 3 0 5317 0 2767 2785 2786 +5368 2 3 0 5318 0 2769 2768 2787 +5369 2 3 0 5319 0 2787 2788 2769 +5370 2 3 0 5320 0 2788 2789 2769 +5371 2 3 0 5321 0 2769 2789 2771 +5372 2 3 0 5322 0 2770 2769 2771 +5373 2 3 0 5323 0 2789 2790 2771 +5374 2 3 0 5324 0 2772 2771 2790 +5375 2 3 0 5325 0 2773 2772 2790 +5376 2 3 0 5326 0 2791 2773 2790 +5377 2 3 0 5327 0 2791 2792 2773 +5378 2 3 0 5328 0 2792 2774 2773 +5379 2 3 0 5329 0 2774 2792 2793 +5380 2 3 0 5330 0 2774 2793 2794 +5381 2 3 0 5331 0 2775 2774 2794 +5382 2 3 0 5332 0 2775 2794 2795 +5383 2 3 0 5333 0 2795 2796 2775 +5384 2 3 0 5334 0 2776 2775 2796 +5385 2 3 0 5335 0 2776 2796 2797 +5386 2 3 0 5336 0 2777 2776 2797 +5387 2 3 0 5337 0 2798 2777 2797 +5388 2 3 0 5338 0 2798 2778 2777 +5389 2 3 0 5339 0 2799 2778 2798 +5390 2 3 0 5340 0 2800 2778 2799 +5391 2 3 0 5341 0 2800 2779 2778 +5392 2 3 0 5342 0 2779 2800 2780 +5393 2 3 0 5343 0 2780 2800 2801 +5394 2 3 0 5344 0 2780 2801 2781 +5395 2 3 0 5345 0 2782 2781 2801 +5396 2 3 0 5346 0 2801 2802 2782 +5397 2 3 0 5347 0 2802 2803 2782 +5398 2 3 0 5348 0 2782 2803 2783 +5399 2 3 0 5349 0 2784 2783 2803 +5400 2 3 0 5350 0 2804 2784 2803 +5401 2 3 0 5351 0 2804 2785 2784 +5402 2 3 0 5352 0 2804 2805 2785 +5403 2 3 0 5353 0 2786 2785 2805 +5404 2 3 0 5354 0 2806 2786 2805 +5405 2 3 0 5355 0 2807 2788 2787 +5406 2 3 0 5356 0 2788 2807 2808 +5407 2 3 0 5357 0 2808 2809 2788 +5408 2 3 0 5358 0 2788 2809 2810 +5409 2 3 0 5359 0 2789 2788 2810 +5410 2 3 0 5360 0 2789 2810 2790 +5411 2 3 0 5361 0 2811 2790 2810 +5412 2 3 0 5362 0 2811 2791 2790 +5413 2 3 0 5363 0 2812 2791 2811 +5414 2 3 0 5364 0 2812 2813 2791 +5415 2 3 0 5365 0 2813 2792 2791 +5416 2 3 0 5366 0 2813 2793 2792 +5417 2 3 0 5367 0 2813 2814 2793 +5418 2 3 0 5368 0 2815 2793 2814 +5419 2 3 0 5369 0 2815 2816 2793 +5420 2 3 0 5370 0 2794 2793 2816 +5421 2 3 0 5371 0 2816 2817 2794 +5422 2 3 0 5372 0 2794 2817 2795 +5423 2 3 0 5373 0 2817 2818 2795 +5424 2 3 0 5374 0 2819 2795 2818 +5425 2 3 0 5375 0 2795 2819 2796 +5426 2 3 0 5376 0 2820 2796 2819 +5427 2 3 0 5377 0 2797 2796 2820 +5428 2 3 0 5378 0 2821 2797 2820 +5429 2 3 0 5379 0 2822 2797 2821 +5430 2 3 0 5380 0 2797 2822 2798 +5431 2 3 0 5381 0 2822 2823 2798 +5432 2 3 0 5382 0 2823 2799 2798 +5433 2 3 0 5383 0 2824 2799 2823 +5434 2 3 0 5384 0 2824 2825 2799 +5435 2 3 0 5385 0 2799 2825 2800 +5436 2 3 0 5386 0 2825 2826 2800 +5437 2 3 0 5387 0 2800 2826 2801 +5438 2 3 0 5388 0 2801 2826 2827 +5439 2 3 0 5389 0 2801 2827 2802 +5440 2 3 0 5390 0 2827 2828 2802 +5441 2 3 0 5391 0 2802 2828 2829 +5442 2 3 0 5392 0 2802 2829 2803 +5443 2 3 0 5393 0 2804 2803 2829 +5444 2 3 0 5394 0 2829 2830 2804 +5445 2 3 0 5395 0 2804 2830 2805 +5446 2 3 0 5396 0 2806 2805 2830 +5447 2 3 0 5397 0 2808 2831 2809 +5448 2 3 0 5398 0 2831 2832 2809 +5449 2 3 0 5399 0 2809 2832 2810 +5450 2 3 0 5400 0 2833 2810 2832 +5451 2 3 0 5401 0 2833 2811 2810 +5452 2 3 0 5402 0 2811 2833 2834 +5453 2 3 0 5403 0 2811 2834 2812 +5454 2 3 0 5404 0 2835 2812 2834 +5455 2 3 0 5405 0 2836 2812 2835 +5456 2 3 0 5406 0 2813 2812 2836 +5457 2 3 0 5407 0 2813 2836 2837 +5458 2 3 0 5408 0 2814 2813 2837 +5459 2 3 0 5409 0 2816 2815 2838 +5460 2 3 0 5410 0 2838 2839 2816 +5461 2 3 0 5411 0 2816 2839 2817 +5462 2 3 0 5412 0 2839 2840 2817 +5463 2 3 0 5413 0 2840 2818 2817 +5464 2 3 0 5414 0 2840 2841 2818 +5465 2 3 0 5415 0 2819 2818 2841 +5466 2 3 0 5416 0 2842 2819 2841 +5467 2 3 0 5417 0 2842 2820 2819 +5468 2 3 0 5418 0 2820 2842 2843 +5469 2 3 0 5419 0 2820 2843 2821 +5470 2 3 0 5420 0 2844 2825 2824 +5471 2 3 0 5421 0 2826 2825 2844 +5472 2 3 0 5422 0 2845 2826 2844 +5473 2 3 0 5423 0 2827 2826 2845 +5474 2 3 0 5424 0 2846 2827 2845 +5475 2 3 0 5425 0 2827 2846 2828 +5476 2 3 0 5426 0 2828 2846 2847 +5477 2 3 0 5427 0 2848 2828 2847 +5478 2 3 0 5428 0 2848 2830 2828 +5479 2 3 0 5429 0 2830 2829 2828 +5480 2 3 0 5430 0 2830 2848 2849 +5481 2 3 0 5431 0 2850 2831 2851 +5482 2 3 0 5432 0 2850 2832 2831 +5483 2 3 0 5433 0 2850 2852 2832 +5484 2 3 0 5434 0 2832 2852 2833 +5485 2 3 0 5435 0 2852 2853 2833 +5486 2 3 0 5436 0 2853 2854 2833 +5487 2 3 0 5437 0 2834 2833 2854 +5488 2 3 0 5438 0 2834 2854 2855 +5489 2 3 0 5439 0 2835 2834 2855 +5490 2 3 0 5440 0 2856 2841 2840 +5491 2 3 0 5441 0 2841 2856 2857 +5492 2 3 0 5442 0 2857 2858 2841 +5493 2 3 0 5443 0 2842 2841 2858 +5494 2 3 0 5444 0 2842 2858 2859 +5495 2 3 0 5445 0 2843 2842 2859 +5496 2 3 0 5446 0 2859 2860 2843 +5497 2 3 0 5447 0 2861 2845 2844 +5498 2 3 0 5448 0 2846 2845 2861 +5499 2 3 0 5449 0 2862 2846 2861 +5500 2 3 0 5450 0 2846 2862 2863 +5501 2 3 0 5451 0 2846 2863 2847 +5502 2 3 0 5452 0 2847 2863 2864 +5503 2 3 0 5453 0 2847 2864 2865 +5504 2 3 0 5454 0 2865 2866 2847 +5505 2 3 0 5455 0 2848 2847 2866 +5506 2 3 0 5456 0 2849 2848 2866 +5507 2 3 0 5457 0 2850 2851 2867 +5508 2 3 0 5458 0 2868 2850 2867 +5509 2 3 0 5459 0 2850 2868 2852 +5510 2 3 0 5460 0 2869 2854 2853 +5511 2 3 0 5461 0 2870 2854 2869 +5512 2 3 0 5462 0 2855 2854 2870 +5513 2 3 0 5463 0 2855 2870 2871 +5514 2 3 0 5464 0 2858 2857 2872 +5515 2 3 0 5465 0 2873 2858 2872 +5516 2 3 0 5466 0 2873 2859 2858 +5517 2 3 0 5467 0 2860 2859 2873 +5518 2 3 0 5468 0 2874 2860 2873 +5519 2 3 0 5469 0 2875 2862 2876 +5520 2 3 0 5470 0 2875 2877 2862 +5521 2 3 0 5471 0 2862 2877 2863 +5522 2 3 0 5472 0 2864 2863 2877 +5523 2 3 0 5473 0 2878 2864 2877 +5524 2 3 0 5474 0 2864 2878 2879 +5525 2 3 0 5475 0 2864 2879 2865 +5526 2 3 0 5476 0 2879 2880 2865 +5527 2 3 0 5477 0 2882 2881 2867 +5528 2 3 0 5478 0 2881 2868 2867 +5529 2 3 0 5479 0 2883 2870 2869 +5530 2 3 0 5480 0 2883 2871 2870 +5531 2 3 0 5481 0 2871 2883 2884 +5532 2 3 0 5482 0 2871 2884 2885 +5533 2 3 0 5483 0 2886 2872 2887 +5534 2 3 0 5484 0 2886 2873 2872 +5535 2 3 0 5485 0 2873 2886 2874 +5536 2 3 0 5486 0 2888 2874 2886 +5537 2 3 0 5487 0 2876 2889 2875 +5538 2 3 0 5488 0 2890 2875 2889 +5539 2 3 0 5489 0 2890 2878 2875 +5540 2 3 0 5490 0 2878 2877 2875 +5541 2 3 0 5491 0 2889 2876 2891 +5542 2 3 0 5492 0 2890 2892 2878 +5543 2 3 0 5493 0 2893 2878 2892 +5544 2 3 0 5494 0 2879 2878 2893 +5545 2 3 0 5495 0 2894 2879 2893 +5546 2 3 0 5496 0 2879 2894 2895 +5547 2 3 0 5497 0 2895 2880 2879 +5548 2 3 0 5498 0 2882 2896 2881 +5549 2 3 0 5499 0 2897 2896 2882 +5550 2 3 0 5500 0 2888 2886 2887 +5551 2 3 0 5501 0 2898 2889 2891 +5552 2 3 0 5502 0 2898 2899 2889 +5553 2 3 0 5503 0 2899 2890 2889 +5554 2 3 0 5504 0 2899 2892 2890 +5555 2 3 0 5505 0 2900 2892 2899 +5556 2 3 0 5506 0 2901 2892 2900 +5557 2 3 0 5507 0 2893 2892 2901 +5558 2 3 0 5508 0 2902 2893 2901 +5559 2 3 0 5509 0 2902 2894 2893 +5560 2 3 0 5510 0 2903 2894 2902 +5561 2 3 0 5511 0 2895 2894 2903 +5562 2 3 0 5512 0 2904 2895 2903 +5563 2 3 0 5513 0 2896 2897 2905 +5564 2 3 0 5514 0 2906 2896 2905 +5565 2 3 0 5515 0 2907 2905 2897 +5566 2 3 0 5516 0 2908 2898 2909 +5567 2 3 0 5517 0 2908 2910 2898 +5568 2 3 0 5518 0 2899 2898 2910 +5569 2 3 0 5519 0 2900 2899 2910 +5570 2 3 0 5520 0 2910 2911 2900 +5571 2 3 0 5521 0 2912 2900 2911 +5572 2 3 0 5522 0 2901 2900 2912 +5573 2 3 0 5523 0 2913 2901 2912 +5574 2 3 0 5524 0 2902 2901 2913 +5575 2 3 0 5525 0 2913 2914 2902 +5576 2 3 0 5526 0 2915 2902 2914 +5577 2 3 0 5527 0 2915 2903 2902 +5578 2 3 0 5528 0 2903 2915 2904 +5579 2 3 0 5529 0 2916 2905 2907 +5580 2 3 0 5530 0 2905 2916 2917 +5581 2 3 0 5531 0 2905 2917 2906 +5582 2 3 0 5532 0 2906 2917 2918 +5583 2 3 0 5533 0 2919 2906 2918 +5584 2 3 0 5534 0 2920 2907 2921 +5585 2 3 0 5535 0 2920 2916 2907 +5586 2 3 0 5536 0 2909 2922 2908 +5587 2 3 0 5537 0 2922 2911 2908 +5588 2 3 0 5538 0 2911 2910 2908 +5589 2 3 0 5539 0 2922 2909 2923 +5590 2 3 0 5540 0 2911 2924 2912 +5591 2 3 0 5541 0 2925 2912 2924 +5592 2 3 0 5542 0 2912 2925 2913 +5593 2 3 0 5543 0 2925 2926 2913 +5594 2 3 0 5544 0 2913 2926 2914 +5595 2 3 0 5545 0 2926 2927 2914 +5596 2 3 0 5546 0 2914 2927 2928 +5597 2 3 0 5547 0 2928 2929 2914 +5598 2 3 0 5548 0 2914 2929 2915 +5599 2 3 0 5549 0 2920 2930 2916 +5600 2 3 0 5550 0 2916 2930 2917 +5601 2 3 0 5551 0 2917 2930 2918 +5602 2 3 0 5552 0 2930 2931 2918 +5603 2 3 0 5553 0 2919 2918 2931 +5604 2 3 0 5554 0 2932 2919 2931 +5605 2 3 0 5555 0 2933 2919 2932 +5606 2 3 0 5556 0 2920 2921 2934 +5607 2 3 0 5557 0 2920 2934 2935 +5608 2 3 0 5558 0 2936 2920 2935 +5609 2 3 0 5559 0 2920 2936 2930 +5610 2 3 0 5560 0 2937 2934 2921 +5611 2 3 0 5561 0 2938 2924 2939 +5612 2 3 0 5562 0 2938 2925 2924 +5613 2 3 0 5563 0 2940 2925 2938 +5614 2 3 0 5564 0 2940 2926 2925 +5615 2 3 0 5565 0 2926 2940 2927 +5616 2 3 0 5566 0 2941 2927 2940 +5617 2 3 0 5567 0 2941 2942 2927 +5618 2 3 0 5568 0 2943 2927 2942 +5619 2 3 0 5569 0 2927 2943 2928 +5620 2 3 0 5570 0 2943 2944 2928 +5621 2 3 0 5571 0 2944 2929 2928 +5622 2 3 0 5572 0 2931 2930 2936 +5623 2 3 0 5573 0 2931 2936 2932 +5624 2 3 0 5574 0 2932 2945 2933 +5625 2 3 0 5575 0 2933 2945 2946 +5626 2 3 0 5576 0 2937 2947 2934 +5627 2 3 0 5577 0 2947 2935 2934 +5628 2 3 0 5578 0 2947 2948 2935 +5629 2 3 0 5579 0 2948 2936 2935 +5630 2 3 0 5580 0 2947 2937 2949 +5631 2 3 0 5581 0 2950 2938 2939 +5632 2 3 0 5582 0 2951 2938 2950 +5633 2 3 0 5583 0 2940 2938 2951 +5634 2 3 0 5584 0 2950 2939 2952 +5635 2 3 0 5585 0 2941 2940 2951 +5636 2 3 0 5586 0 2951 2953 2941 +5637 2 3 0 5587 0 2953 2954 2941 +5638 2 3 0 5588 0 2954 2942 2941 +5639 2 3 0 5589 0 2955 2942 2954 +5640 2 3 0 5590 0 2956 2942 2955 +5641 2 3 0 5591 0 2956 2943 2942 +5642 2 3 0 5592 0 2957 2943 2956 +5643 2 3 0 5593 0 2957 2944 2943 +5644 2 3 0 5594 0 2949 2948 2947 +5645 2 3 0 5595 0 2950 2952 2958 +5646 2 3 0 5596 0 2950 2958 2959 +5647 2 3 0 5597 0 2950 2959 2951 +5648 2 3 0 5598 0 2959 2953 2951 +5649 2 3 0 5599 0 2952 2961 2960 +5650 2 3 0 5600 0 2962 2952 2960 +5651 2 3 0 5601 0 2958 2952 2962 +5652 2 3 0 5602 0 2963 2953 2959 +5653 2 3 0 5603 0 2953 2963 2964 +5654 2 3 0 5604 0 2953 2964 2965 +5655 2 3 0 5605 0 2953 2965 2954 +5656 2 3 0 5606 0 2955 2954 2965 +5657 2 3 0 5607 0 2966 2955 2965 +5658 2 3 0 5608 0 2967 2955 2966 +5659 2 3 0 5609 0 2955 2967 2968 +5660 2 3 0 5610 0 2968 2956 2955 +5661 2 3 0 5611 0 2969 2956 2968 +5662 2 3 0 5612 0 2969 2970 2956 +5663 2 3 0 5613 0 2970 2957 2956 +5664 2 3 0 5614 0 2958 2962 2971 +5665 2 3 0 5615 0 2963 2958 2971 +5666 2 3 0 5616 0 2963 2959 2958 +5667 2 3 0 5617 0 2972 2960 2961 +5668 2 3 0 5618 0 2972 2973 2960 +5669 2 3 0 5619 0 2973 2962 2960 +5670 2 3 0 5620 0 2961 2975 2974 +5671 2 3 0 5621 0 2961 2974 2972 +5672 2 3 0 5622 0 2973 2976 2962 +5673 2 3 0 5623 0 2976 2971 2962 +5674 2 3 0 5624 0 2963 2971 2977 +5675 2 3 0 5625 0 2978 2963 2977 +5676 2 3 0 5626 0 2964 2963 2978 +5677 2 3 0 5627 0 2978 2979 2964 +5678 2 3 0 5628 0 2979 2980 2964 +5679 2 3 0 5629 0 2964 2980 2965 +5680 2 3 0 5630 0 2966 2965 2980 +5681 2 3 0 5631 0 2981 2966 2980 +5682 2 3 0 5632 0 2966 2981 2982 +5683 2 3 0 5633 0 2982 2967 2966 +5684 2 3 0 5634 0 2967 2982 2983 +5685 2 3 0 5635 0 2967 2983 2968 +5686 2 3 0 5636 0 2968 2983 2984 +5687 2 3 0 5637 0 2984 2985 2968 +5688 2 3 0 5638 0 2985 2969 2968 +5689 2 3 0 5639 0 2971 2976 2977 +5690 2 3 0 5640 0 2986 2972 2974 +5691 2 3 0 5641 0 2973 2972 2986 +5692 2 3 0 5642 0 2973 2986 2987 +5693 2 3 0 5643 0 2973 2987 2988 +5694 2 3 0 5644 0 2976 2973 2988 +5695 2 3 0 5645 0 2975 2989 2974 +5696 2 3 0 5646 0 2989 2986 2974 +5697 2 3 0 5647 0 2990 2989 2975 +5698 2 3 0 5648 0 2976 2988 2991 +5699 2 3 0 5649 0 2976 2991 2992 +5700 2 3 0 5650 0 2992 2977 2976 +5701 2 3 0 5651 0 2993 2977 2992 +5702 2 3 0 5652 0 2977 2993 2978 +5703 2 3 0 5653 0 2993 2979 2978 +5704 2 3 0 5654 0 2994 2981 2995 +5705 2 3 0 5655 0 2994 2982 2981 +5706 2 3 0 5656 0 2996 2982 2994 +5707 2 3 0 5657 0 2982 2996 2983 +5708 2 3 0 5658 0 2983 2996 2984 +5709 2 3 0 5659 0 2996 2997 2984 +5710 2 3 0 5660 0 2997 2998 2984 +5711 2 3 0 5661 0 2998 2985 2984 +5712 2 3 0 5662 0 2989 2999 2986 +5713 2 3 0 5663 0 2999 2987 2986 +5714 2 3 0 5664 0 2999 3000 2987 +5715 2 3 0 5665 0 3000 3001 2987 +5716 2 3 0 5666 0 3001 2988 2987 +5717 2 3 0 5667 0 2988 3001 3002 +5718 2 3 0 5668 0 2991 2988 3002 +5719 2 3 0 5669 0 2999 2989 2990 +5720 2 3 0 5670 0 3003 2999 2990 +5721 2 3 0 5671 0 2995 3004 2994 +5722 2 3 0 5672 0 3005 2994 3004 +5723 2 3 0 5673 0 3005 2996 2994 +5724 2 3 0 5674 0 3006 3004 2995 +5725 2 3 0 5675 0 2996 3005 2997 +5726 2 3 0 5676 0 3005 3007 2997 +5727 2 3 0 5677 0 3007 3008 2997 +5728 2 3 0 5678 0 3008 2998 2997 +5729 2 3 0 5679 0 2999 3003 3000 +5730 2 3 0 5680 0 3009 3000 3003 +5731 2 3 0 5681 0 3001 3000 3009 +5732 2 3 0 5682 0 3001 3009 3010 +5733 2 3 0 5683 0 3002 3001 3010 +5734 2 3 0 5684 0 3011 3002 3010 +5735 2 3 0 5685 0 3003 3012 3009 +5736 2 3 0 5686 0 3013 3004 3006 +5737 2 3 0 5687 0 3013 3014 3004 +5738 2 3 0 5688 0 3004 3014 3005 +5739 2 3 0 5689 0 3014 3015 3005 +5740 2 3 0 5690 0 3015 3007 3005 +5741 2 3 0 5691 0 3016 3006 3017 +5742 2 3 0 5692 0 3006 3016 3013 +5743 2 3 0 5693 0 3018 3007 3015 +5744 2 3 0 5694 0 3007 3018 3019 +5745 2 3 0 5695 0 3019 3020 3007 +5746 2 3 0 5696 0 3007 3020 3008 +5747 2 3 0 5697 0 3008 3020 3021 +5748 2 3 0 5698 0 3012 3010 3009 +5749 2 3 0 5699 0 3012 3011 3010 +5750 2 3 0 5700 0 3022 3013 3016 +5751 2 3 0 5701 0 3023 3013 3022 +5752 2 3 0 5702 0 3023 3014 3013 +5753 2 3 0 5703 0 3024 3014 3023 +5754 2 3 0 5704 0 3024 3015 3014 +5755 2 3 0 5705 0 3024 3018 3015 +5756 2 3 0 5706 0 3017 3025 3016 +5757 2 3 0 5707 0 3022 3016 3025 +5758 2 3 0 5708 0 3026 3025 3017 +5759 2 3 0 5709 0 3027 3018 3024 +5760 2 3 0 5710 0 3018 3027 3028 +5761 2 3 0 5711 0 3028 3019 3018 +5762 2 3 0 5712 0 3028 3029 3019 +5763 2 3 0 5713 0 3029 3030 3019 +5764 2 3 0 5714 0 3019 3030 3020 +5765 2 3 0 5715 0 3021 3020 3030 +5766 2 3 0 5716 0 3031 3022 3025 +5767 2 3 0 5717 0 3023 3022 3031 +5768 2 3 0 5718 0 3032 3023 3031 +5769 2 3 0 5719 0 3033 3023 3032 +5770 2 3 0 5720 0 3033 3024 3023 +5771 2 3 0 5721 0 3033 3027 3024 +5772 2 3 0 5722 0 3026 3034 3025 +5773 2 3 0 5723 0 3035 3025 3034 +5774 2 3 0 5724 0 3031 3025 3035 +5775 2 3 0 5725 0 3036 3034 3026 +5776 2 3 0 5726 0 3033 3037 3027 +5777 2 3 0 5727 0 3037 3038 3027 +5778 2 3 0 5728 0 3039 3027 3038 +5779 2 3 0 5729 0 3039 3028 3027 +5780 2 3 0 5730 0 3039 3040 3028 +5781 2 3 0 5731 0 3040 3029 3028 +5782 2 3 0 5732 0 3041 3031 3035 +5783 2 3 0 5733 0 3032 3031 3041 +5784 2 3 0 5734 0 3042 3032 3041 +5785 2 3 0 5735 0 3043 3032 3042 +5786 2 3 0 5736 0 3032 3043 3033 +5787 2 3 0 5737 0 3043 3037 3033 +5788 2 3 0 5738 0 3034 3036 3044 +5789 2 3 0 5739 0 3044 3035 3034 +5790 2 3 0 5740 0 3045 3035 3044 +5791 2 3 0 5741 0 3035 3045 3041 +5792 2 3 0 5742 0 3046 3044 3036 +5793 2 3 0 5743 0 3047 3037 3043 +5794 2 3 0 5744 0 3037 3047 3048 +5795 2 3 0 5745 0 3037 3048 3038 +5796 2 3 0 5746 0 3049 3038 3048 +5797 2 3 0 5747 0 3049 3039 3038 +5798 2 3 0 5748 0 3049 3050 3039 +5799 2 3 0 5749 0 3039 3050 3051 +5800 2 3 0 5750 0 3039 3051 3040 +5801 2 3 0 5751 0 3042 3041 3045 +5802 2 3 0 5752 0 3047 3043 3042 +5803 2 3 0 5753 0 3047 3052 3048 +5804 2 3 0 5754 0 3053 3048 3052 +5805 2 3 0 5755 0 3048 3053 3054 +5806 2 3 0 5756 0 3049 3048 3054 +5807 2 3 0 5757 0 3054 3055 3049 +5808 2 3 0 5758 0 3050 3049 3055 +5809 2 3 0 5759 0 3056 3050 3055 +5810 2 3 0 5760 0 3056 3051 3050 +5811 2 3 0 5761 0 3051 3056 3057 +5812 2 3 0 5762 0 3053 3052 3058 +5813 2 3 0 5763 0 3059 3053 3058 +5814 2 3 0 5764 0 3053 3059 3060 +5815 2 3 0 5765 0 3053 3060 3054 +5816 2 3 0 5766 0 3060 3061 3054 +5817 2 3 0 5767 0 3055 3054 3061 +5818 2 3 0 5768 0 3062 3055 3061 +5819 2 3 0 5769 0 3062 3056 3055 +5820 2 3 0 5770 0 3056 3062 3063 +5821 2 3 0 5771 0 3057 3056 3063 +5822 2 3 0 5772 0 3063 3064 3057 +5823 2 3 0 5773 0 3065 3062 3066 +5824 2 3 0 5774 0 3065 3063 3062 +5825 2 3 0 5775 0 3065 3064 3063 +5826 2 3 0 5776 0 3065 3067 3064 +5827 2 3 0 5777 0 3068 3064 3067 +5828 2 3 0 5778 0 3069 3065 3066 +5829 2 3 0 5779 0 3065 3069 3067 +5830 2 3 0 5780 0 3068 3067 3070 +$EndElements diff --git a/regtests/ww3_tp2.17/input_deep/switch_PDLIB b/regtests/ww3_tp2.17/input_deep/switch_PDLIB new file mode 100644 index 0000000000..6bdb1f9072 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/switch_PDLIB @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT1 DB1 TR1 BS0 IS0 IC4 REF1 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_deep/ww3_bounc.inp b/regtests/ww3_tp2.17/input_deep/ww3_bounc.inp new file mode 100755 index 0000000000..1b29c0b881 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/bound.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep/ww3_grib.inp b/regtests/ww3_tp2.17/input_deep/ww3_grib.inp new file mode 100644 index 0000000000..c4b9226183 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_grib.inp @@ -0,0 +1,10 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH-III gridded output input file +$ ---------------------------------------- +20151214 000000 3600 9 +N +WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR UST +$ +20151214 000000 7 11 255 0 0 +$ +$ end of input file diff --git a/regtests/ww3_tp2.17/input_deep/ww3_grid_d.inp b/regtests/ww3_tp2.17/input_deep/ww3_grid_d.inp new file mode 100755 index 0000000000..190c70bb77 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_grid_d.inp @@ -0,0 +1,322 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Inlet' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.10 0.05 32 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 150. 150. 150. 150. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ JGS_NORM_THR = 1.E-20 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, + WHITECAPWIDTH = 0.30 / +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32 / +&MISC CICE0 = 0.500, CICEN = 0.500, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 5, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$Parameters needed for IC4 switch: +&SIC4 IC4METHOD = 9 , IC4CN = 2.9, 4.5/ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +&REF1 REFCOAST=0.10, REFSLOPE=0.20, REFMAP = 0, REFFREQPOW = 3, + REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00, REFRMAX = 0.7 / +&SIN4 BETAMAX = 1.33 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T F +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/inlet.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ + 1 1 F + 75 1 T +$ 1 1 F +$ 292 1 T +$ 154 1 T +$ 239 1 T +$ 2 1 F +$ 59 1 T +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep/ww3_grid_e.inp b/regtests/ww3_tp2.17/input_deep/ww3_grid_e.inp new file mode 100755 index 0000000000..5e9e40f003 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_grid_e.inp @@ -0,0 +1,322 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Inlet' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.10 0.05 32 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 150. 150. 150. 150. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ JGS_NORM_THR = 1.E-20 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, + WHITECAPWIDTH = 0.30 / +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32 / +&MISC CICE0 = 0.500, CICEN = 0.500, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 5, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$Parameters needed for IC4 switch: +&SIC4 IC4METHOD = 9 , IC4CN = 2.9, 4.5/ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +&REF1 REFCOAST=0.10, REFSLOPE=0.20, REFMAP = 0, REFFREQPOW = 3, + REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00, REFRMAX = 0.7 / +&SIN4 BETAMAX = 1.33 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T F +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_deep/DeepInlet425m.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ + 1 1 F + 75 1 T +$ 1 1 F +$ 292 1 T +$ 154 1 T +$ 239 1 T +$ 2 1 F +$ 59 1 T +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep/ww3_ounf.inp b/regtests/ww3_tp2.17/input_deep/ww3_ounf.inp new file mode 100755 index 0000000000..c564893c83 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_ounf.inp @@ -0,0 +1,84 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ +$ 20151214 000000 3600. 9999 + 20151214 130000 3600. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS PDP +$ PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR UST CHA CGE FAW TAW TWA WCC +$ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED +$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 3070 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep/ww3_ounp.inp b/regtests/ww3_tp2.17/input_deep/ww3_ounp.inp new file mode 100755 index 0000000000..a8c1a565bf --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_ounp.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 000000 3600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 1 + 2 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ +$ 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output + 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep/ww3_outp.inp b/regtests/ww3_tp2.17/input_deep/ww3_outp.inp new file mode 100644 index 0000000000..5e90ea1366 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_outp.inp @@ -0,0 +1,112 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 000000 600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ Define points for which output is to be generated. +$ +$ mandatory end of list + -1 +$ +$ Output type ITYPE [0,1,2,3] +$ + 2 +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. +$ +$ 3 1. 0. 33 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ - Unit number for file, also used in file name. +$ + 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. +$ +$ 1 0. 0. 50 T T T T T T 0 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, nubmer of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep/ww3_prnc_current.inp b/regtests/ww3_tp2.17/input_deep/ww3_prnc_current.inp new file mode 100755 index 0000000000..f9de2d4959 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_prnc_current.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'CUR' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ucur vcur +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/current.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep/ww3_prnc_ice.inp b/regtests/ww3_tp2.17/input_deep/ww3_prnc_ice.inp new file mode 100755 index 0000000000..6b7077572c --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_prnc_ice.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'ICE' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ice +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/ice.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep/ww3_prnc_level.inp b/regtests/ww3_tp2.17/input_deep/ww3_prnc_level.inp new file mode 100755 index 0000000000..6ff15c0879 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_prnc_level.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'LEV' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + wlv +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/levelNoNaN.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep/ww3_prnc_wind.inp b/regtests/ww3_tp2.17/input_deep/ww3_prnc_wind.inp new file mode 100755 index 0000000000..c0330bc5b7 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_prnc_wind.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'WND' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + uwnd vwnd +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/wind.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep/ww3_shel.inp b/regtests/ww3_tp2.17/input_deep/ww3_shel.inp new file mode 100755 index 0000000000..9368b1e8d2 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep/ww3_shel.inp @@ -0,0 +1,148 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ Define input to be used with flag for use and flag for definition +$ as a homogeneous field (first three only); seven input lines. +$ + F F Ice parameter 1 + F F Ice parameter 2 + F F Ice parameter 3 + F F Ice parameter 4 + F F Ice parameter 5 + F F Mud parameter 1 + F F Mud parameter 2 + F F Mud parameter 3 + T F Water levels + T F Currents + T F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ +$ Time frame of calculations ----------------------------------------- $ +$ - Starting time in yyyymmdd hhmmss format. +$ - Ending time in yyyymmdd hhmmss format. +$ + 20151214 000000 + 20151215 000000 +$ +$ Define output data ------------------------------------------------- $ +$ +$ Define output server mode. This is used only in the parallel version +$ of the model. To keep the input file consistent, it is always needed. +$ IOSTYP = 1 is generally recommended. IOSTYP > 2 may be more efficient +$ for massively parallel computations. Only IOSTYP = 0 requires a true +$ parallel file system like GPFS. +$ +$ IOSTYP = 0 : No data server processes, direct access output from +$ each process (requirese true parallel file system). +$ 1 : No data server process. All output for each type +$ performed by process that performes computations too. +$ 2 : Last process is reserved for all output, and does no +$ computing. +$ 3 : Multiple dedicated output processes. +$ + 0 +$ +$ Five output types are available (see below). All output types share +$ a similar format for the first input line: +$ - first time in yyyymmdd hhmmss format, output interval (s), and +$ last time in yyyymmdd hhmmss format (all integers). +$ Output is disabled by setting the output interval to 0. +$ +$ Type 1 : Fields of mean wave parameters +$ Standard line and line with flags to activate output fields +$ as defined in section 2.4 of the manual. The second line is +$ not supplied if no output is requested. +$ The raw data file is out_grd.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ +$ + 20151214 130000 3600 20151215 000000 + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$ +$ +$ Type 2 : Point output +$ Standard line and a number of lines identifying the +$ longitude, latitude and name (C*40) of output points. +$ The list is closed by defining a point with the name +$ 'STOPSTRING'. No point info read if no point output is +$ requested (i.e., no 'STOPSTRING' needed). +$ Example for spherical grid. +$ The raw data file is out_pnt.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ NOTE : Spaces may be included in the name, but this is not +$ advised, because it will break the GrADS utility to +$ plots spectra and source terms, and will make it more +$ difficult to use point names in data files. +$ + 20151214 000000 3600 20151215 000000 +$ +$output points for Inlet +$ +-72.31 40.44 a01 +-72.34 40.50 a02 +-72.38 40.55 a03 +-72.40 40.59 a04 +-72.42 40.63 a05 +-72.44 40.67 a06 +-72.46 40.72 a07 +-72.47 40.76 a08 +-72.49 40.81 a09 +-72.51 40.84 a10 +$ + 0.0 0.0 'STOPSTRING' +$ +$ Type 3 : Output along track. +$ Flag for formatted input file. +$ The data files are track_i.ww3 and +$ track_o.ww3, see w3iotr.ftn for ad. doc. +$ + 20060101 000000 0 20040101 000000 +$ +$ Type 4 : Restart files (no additional data required). +$ The data file is restartN.ww3, see +$ w3iors.ftn for additional doc. +$ + 20151214 000000 0 20151215 000000 T + 20151214 000000 3600 20151215 000000 +$ +$ Type 5 : Boundary data (no additional data required). +$ The data file is nestN.ww3, see +$ w3iobp.ftn for additional doc. +$ + 20040601 000000 0 20040103 000000 +$ +$ Type 6 : Separated wave field data (dummy for now). +$ First, last step IX and IY, flag for formatted file +$ + 20060101 000000 0 20040603 000000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ Homogeneous fields can be defined by a list of lines containing an ID +$ string 'LEV' 'CUR' 'WND', date and time information (yyyymmdd +$ hhmmss), value (S.I. units), direction (current and wind, oceanographic +$ convention degrees)) and air-sea temparature difference (degrees C). +$ 'STP' is mandatory stop string. +$ +$ 'WND' 20080101 000000 20. 315. 0.0 +$ + 'the_end' 0 +$ + 'STP' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep_restart/switch_PDLIB b/regtests/ww3_tp2.17/input_deep_restart/switch_PDLIB new file mode 100644 index 0000000000..6bdb1f9072 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/switch_PDLIB @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT1 DB1 TR1 BS0 IS0 IC4 REF1 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_deep_restart/switch_RWPS b/regtests/ww3_tp2.17/input_deep_restart/switch_RWPS new file mode 100644 index 0000000000..0e38ed6579 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/switch_RWPS @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT4 DB1 TR1 BS0 IS0 IC4 REF1 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBS1 b/regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBS1 new file mode 100644 index 0000000000..96de45744e --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBS1 @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT1 DB1 TR1 BS1 IS0 IC4 REF1 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBT1 b/regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBT1 new file mode 100644 index 0000000000..6bdb1f9072 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/switch_RWPSBT1 @@ -0,0 +1 @@ +NOGRB TRKNC DIST MPI SCRIP MLIM PR3 UQ FLX0 PDLIB SCOTCH LN1 ST4 STAB0 NL1 BT1 DB1 TR1 BS0 IS0 IC4 REF1 WNT2 WNX1 RWND CRT1 CRX1 O0 O1 O2 O2a O2b O2c O3 O4 O5 O6 O7 diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_bounc.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_bounc.inp new file mode 100755 index 0000000000..1b29c0b881 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_bounc.inp @@ -0,0 +1,25 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NetCDF boundary input processing $ +$--------------------------------------------------------------------- $ +$ +$ Boundary option: READ or WRITE +$ + WRITE +$ +$ Interpolation method: 1: nearest +$ 2: linear interpolation + 2 +$ Verbose (0, 1, 2) +1 +$ +$ List of spectra files. These NetCDF files use the WAVEWATCH III +$ format as described in the ww3_ounp.inp file. The files are +$ defined relative to the directory in which the program is run. +$ +../input/bound.nc +'STOPSTRING' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_grib.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_grib.inp new file mode 100644 index 0000000000..4a4d86515a --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_grib.inp @@ -0,0 +1,10 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH-III gridded output input file +$ ---------------------------------------- +20151214 120000 3600 9 +N +WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR UST +$ +20151214 120000 7 11 255 0 0 +$ +$ end of input file diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_grid_d.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_grid_d.inp new file mode 100755 index 0000000000..190c70bb77 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_grid_d.inp @@ -0,0 +1,322 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Inlet' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.10 0.05 32 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 150. 150. 150. 150. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ JGS_NORM_THR = 1.E-20 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, + WHITECAPWIDTH = 0.30 / +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32 / +&MISC CICE0 = 0.500, CICEN = 0.500, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 5, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$Parameters needed for IC4 switch: +&SIC4 IC4METHOD = 9 , IC4CN = 2.9, 4.5/ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +&REF1 REFCOAST=0.10, REFSLOPE=0.20, REFMAP = 0, REFFREQPOW = 3, + REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00, REFRMAX = 0.7 / +&SIN4 BETAMAX = 1.33 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T F +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input/inlet.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ + 1 1 F + 75 1 T +$ 1 1 F +$ 292 1 T +$ 154 1 T +$ 239 1 T +$ 2 1 F +$ 59 1 T +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_grid_e.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_grid_e.inp new file mode 100755 index 0000000000..5e9e40f003 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_grid_e.inp @@ -0,0 +1,322 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Grid name (C*30, in quotes) +$ + 'Inlet' +$ +$ Frequency increment factor and first frequency (Hz) ---------------- $ +$ number of frequencies (wavenumbers) and directions, relative offset +$ of first direction in terms of the directional increment [-0.5,0.5]. +$ In versions 1.18 and 2.22 of the model this value was by definiton 0, +$ it is added to mitigate the GSE for a first order scheme. Note that +$ this factor is IGNORED in the print plots in ww3_outp. +$ + 1.10 0.05 32 36 0. +$ +$ Set model flags ---------------------------------------------------- $ +$ - FLDRY Dry run (input/output only, no calculation). +$ - FLCX, FLCY Activate X and Y component of propagation. +$ - FLCTH, FLCK Activate direction and wavenumber shifts. +$ - FLSOU Activate source terms. +$ + F T T T T T +$ +$ Set time steps ----------------------------------------------------- $ +$ - Time step information (this information is always read) +$ maximum global time step, maximum CFL time step for x-y and +$ k-theta, minimum source term time step (all in seconds). +$ +$ + 150. 150. 150. 150. +$ +$ Start of namelist input section ------------------------------------ $ +$ Starting with WAVEWATCH III version 2.00, the tunable parameters +$ for source terms, propagation schemes, and numerics are read using +$ namelists. Any namelist found in the folowing sections up to the +$ end-of-section identifier string (see below) is temporarily written +$ to ww3_grid.scratch, and read from there if necessary. Namelists +$ not needed for the given switch settings will be skipped +$ automatically, and the order of the namelists is immaterial. +$ +&SLN1 CLIN = 80.0, RFPM = 1.00, RFHF = 0.50 / +$ +&SIN4 ALPHA0=0.0095, + BETAMAX=1.33, + SINTHP=2.00, + Z0MAX=0.00, + ZALP=0.006, + ZWND=10.00, + TAUWSHELTER =1.00, + SWELLFPAR = 1, + SWELLF= 0.800, + SWELLF2=-0.018, + SWELLF3 =0.015, + SWELLF4 =100000.0, + SWELLF5 =1.200, + SWELLF6 =0.000, + SWELLF7 =230000.000, + Z0RAT =0.0400 / +$ +$ Implicit with ww3ifr code version +&UNST UGOBCAUTO = F, + UGOBCDEPTH= -10., + EXPFSN = F, + EXPFSPSI = F, + EXPFSFCT = F, + IMPFSN = F, + EXPTOTAL = F, + IMPTOTAL = T, + IMPREFRACTION = T, + IMPFREQSHIFT = T, + IMPSOURCE = T, + SETUP_APPLY_WLV = F, + SOLVERTHR_SETUP=1E-14, + CRIT_DEP_SETUP=0.1, + JGS_USE_JACOBI = T, + JGS_BLOCK_GAUSS_SEIDEL = F, + JGS_TERMINATE_MAXITER = T, + JGS_MAXITER = 1000, + JGS_TERMINATE_NORM = F, + JGS_TERMINATE_DIFFERENCE = T, + JGS_DIFF_THR = 1.E-8, + JGS_PMIN = 3.0, + JGS_LIMITER = F, + JGS_NORM_THR = 1.E-6 / +$ JGS_NORM_THR = 1.E-20 / +$ +$ Bottom friction - - - - - - - - - - - - - - - - - - - - - - - - - - +$ JONSWAP : Namelist SBT1 +$ GAMMA : As it says. +$ &SBT1 GAMMA = 0.15 / +$ +$ Propagation schemes ------------------------------------------------ $ +$ First order : Namelist PRO1 +$ CFLTM : Maximum CFL number for refraction. +$ +$ UQ with diffusion : Namelist PRO2 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ DTIME : Swell age (s) in garden sprinkler +$ correction. If 0., all diffusion +$ switched off. If small non-zero +$ (DEFAULT !!!) only wave growth +$ diffusion. +$ LATMIN : Maximum latitude used in calc. of +$ strength of diffusion for prop. +$ +$ UQ with averaging : Namelist PRO3 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ WDTHCG : Tuning factor propag. direction. +$ WDTHTH : Tuning factor normal direction. +$ +$ UQ with divergence : Namelist PRO4 +$ CFLTM : Maximum CFL number for refraction. +$ FLSOFT : Flag for 'soft' land boundaries. +$ QTFAC : Tuning factor Eq. (3.41). +$ RSFAC : Tuning factor Eq. (3.42). +$ RNFAC : Tuning factor Eq. (3.43). +$ +$ Miscellaneous ------------------------------------------------------ $ +$ Misc. parameters : Namelist MISC +$ CICE0 : Ice concentration cut-off. +$ CICEN : Ice concentration cut-off. +$ XSEED : Xseed in seeding alg. (!/SEED). +$ FLAGTR : Indicating presence and type of +$ subgrid information : +$ 0 : No subgrid information. +$ 1 : Transparancies at cell boun- +$ daries between grid points. +$ 2 : Transp. at cell centers. +$ 3 : Like 1 with cont. ice. +$ 4 : Like 2 with cont. ice. +$ XP, XR, XFILT +$ Xp, Xr and Xf for the dynamic +$ integration scheme. +$ +$ In the 'Out of the box' test setup we run with sub-grid obstacles +$ and with continuous ice treatment. +$ +$ +&SNL1 LAMBDA = 0.250, NLPROP = 0.250E+08, KDCONV = 0.750, KDMIN = 0.500, + SNLCS1 = 5.500, SNLCS2 = 0.833, SNLCS3 = -1.250 / +&SDS4 SDSBCHOICE = 1, SDSC2 = -0.2200E-04, SDSCUM = -0.4034E+00, + SDSC4 = 0.1000E+01, SDSC5 = 0.0000E+00, SDSC6 = 0.3000E+00, + WNMEANP =0.50, FXPM3 =4.00,FXFM3 =9.90, + SDSBINT = 0.3000E+00, SDSBCK = 0.0000E+00, SDSABK = 1.500, SDSPBK = 4.000, + SDSHCK = 1.50, SDSBR = 0.9000E-03, SDSSTRAIN = 0.000, + SDSP = 2.00, SDSISO = 2, SDSCOS =2.0, SDSDTH = 80.0, + SDSBRF1 = 0.50, SDSBRFDF = 0, + SDSBM0 = 1.00, SDSBM1 = 0.00, SDSBM2 = 0.00, SDSBM3 = 0.00, SDSBM4 = 0.00, + WHITECAPWIDTH = 0.30 / +&SBT1 GAMMA = -0.6700E-01 / +&SDB1 BJALFA = 1.000, BJGAM = 0.730, BJFLAG = .TRUE. / +&PRO3 CFLTM = 0.70, WDTHCG = 1.50, WDTHTH = 1.50 / +&OUTS P2SF = 0, I1P2SF = 1, I2P2SF = 15, + US3D = 0, I1US3D = 1, I2US3D = 32, + E3D = 0, I1E3D = 1, I2E3D = 32, + TH1MF = 0, I1TH1M = 1, I2TH1M = 32, + STH1MF= 0, I1STH1M= 1, I2STH1M= 32, + TH2MF = 0, I1TH2M = 1, I2TH2M = 32, + STH2MF= 0, I1STH2M= 1, I2STH2M= 32 / +&MISC CICE0 = 0.500, CICEN = 0.500, LICE = 0.0, PMOVE = 0.500, + XSEED = 1.000, FLAGTR = 0, XP = 0.150, XR = 0.100, XFILT = 0.050 + IHM = 100, HSPM = 0.050, WSM = 1.700, WSC = 0.333, FLC = .TRUE. + NOSW = 5, FMICHE = 1.600, RWNDC = 1.000, + FACBERG = 1.0, GSHIFT = 0.000E+00 / +$Parameters needed for IC4 switch: +&SIC4 IC4METHOD = 9 , IC4CN = 2.9, 4.5/ +$ +$AW021317 &MISC P2SF = 1 ,I1P2SF = 2, I2P2SF = 16 / +&REF1 REFCOAST=0.10, REFSLOPE=0.20, REFMAP = 0, REFFREQPOW = 3, + REFCOSP_STRAIGHT=4, REFFREQ=1., REFSUBGRID = 0.00, REFRMAX = 0.7 / +&SIN4 BETAMAX = 1.33 / +$ +$ Mandatory string to identify end of namelist input section. +$ +END OF NAMELISTS +$ +$ FLAG for grid features +$ 1 Type of grid 'UNST' 'RECT' 'CURV' +$ 2 Flag for geographical coordinates (LLG) +$ 3 Flag for periodic grid +$ +$ Define grid -------------------------------------------------------- $ +$ Four records containing : +$ 1 NX, NY. As the outer grid lines are always defined as land +$ points, the minimum size is 3x3. +$ 2 Grid increments SX, SY (degr.or m) and scaling (division) factor. +$ If NX*SX is 360., latitudinal closure is applied. +$ 3 Coordinates of (1,1) (degr.) and scaling (division) factor. +$ 4 Limiting bottom depth (m) to discriminate between land and sea +$ points, minimum water depth (m) as allowed in model, unit number +$ of file with bottom depths, scale factor for bottom depths (mult.), +$ IDLA, IDFM, format for formatted read, FROM and filename. +$ IDLA : Layout indicator : +$ 1 : Read line-by-line bottom to top. +$ 2 : Like 1, single read statement. +$ 3 : Read line-by-line top to bottom. +$ 4 : Like 3, single read statement. +$ IDFM : format indicator : +$ 1 : Free format. +$ 2 : Fixed format with above format descriptor. +$ 3 : Unformatted. +$ FROM : file type parameter +$ 'UNIT' : open file by unit number only. +$ 'NAME' : open file by name and assign to unit. +$ +$ Example for longitude-latitude grid (switch !/LLG), for Cartesian +$ grid the unit is meters (NOT km). +$ +$ + 'UNST' T F +$ + 4.0 0.30 20 -1. 4 1 '(20f10.2)' 'NAME' '../input_deep/DeepInlet425m.msh' +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed). +$ +$ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +$ +$ If sub-grid information is avalaible as indicated by FLAGTR above, +$ additional input to define this is needed below. In such cases a +$ field of fractional obstructions at or between grid points needs to +$ be supplied. First the location and format of the data is defined +$ by (as above) : +$ - Unit number of file (can be 10, and/or identical to bottem depth +$ unit), scale factor for fractional obstruction, IDLA, IDFM, +$ format for formatted read, FROM and filename +$ +$ 10 0.2 3 1 '(....)' 'NAME' 'obstr.inp' +$ +$ *** NOTE if this unit number is the same as the previous bottom +$ depth unit number, it is assumed that this is the same file +$ without further checks. *** +$ +$ If the above unit number equals 10, the bottom data is read from +$ this file and follows below (no intermediate comment lines allowed, +$ except between the two fields). +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 4 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 5 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 5 5 5 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ 0 0 0 0 0 0 0 0 0 0 0 0 +$ +$ *** NOTE size of fields is always NX * NY *** +$ + 10 3 1 '(....)' 'PART' 'mapsta.inp' +$ Input boundary points ---------------------------------------------- $ +$ An unlimited number of lines identifying points at which input +$ boundary conditions are to be defined. If the actual input data is +$ not defined in the actual wave model run, the initial conditions +$ will be applied as constant boundary conditions. Each line contains: +$ Discrete grid counters (IX,IY) of the active point and a +$ connect flag. If this flag is true, and the present and previous +$ point are on a grid line or diagonal, all intermediate points +$ are also defined as boundary points. +$ + 1 1 F + 75 1 T +$ 1 1 F +$ 292 1 T +$ 154 1 T +$ 239 1 T +$ 2 1 F +$ 59 1 T +$ +$ Close list by defining point (0,0) (mandatory) +$ + 0 0 F +$ +$ +$ +$ Excluded grid points from segment data ( FROM != PART ) +$ First defined as lines, identical to the definition of the input +$ boundary points, and closed the same way. +$ + 0 0 F +$ +$ Second, define a point in a closed body of sea points to remove +$ the entire body os sea points. Also close by point (0,0) +$ + 0 0 +$ +$ Output boundary points --------------------------------------------- $ +$ Output boundary points are defined as a number of straight lines, +$ defined by its starting point (X0,Y0), increments (DX,DY) and number +$ of points. A negative number of points starts a new output file. +$ Note that this data is only generated if requested by the actual +$ program. Example again for spherical grid in degrees. +$ +$ -2.5312 48.5 0.00 0.008738 102 +$ -2.5312 49.3850 0.013554 0.00 51 +$ +$ Close list by defining line with 0 points (mandatory) +$ + 0. 0. 0. 0. 0 +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_ounf.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_ounf.inp new file mode 100755 index 0000000000..5d93e7acf3 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_ounf.inp @@ -0,0 +1,83 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Grid output post-processing $ +$--------------------------------------------------------------------- $ +$ Time, time increment and number of outputs (set to 4 days) +$ + 20151214 130000 3600. 9999 +$ +$ Fields requested --------------------------------------------------- $ +$ +$ Output request flags identifying fields as in ww3_shel.inp. See that +$ file for a full documentation of field output options. Namelist type +$ selection is used here (for alternative F/T flags, see ww3_shel.inp). +$ +$ DPT CUR WND AST WLV ICE IBG D50 IC1 IC5 HS LM T02 T0M1 T01 FP DIR SPR +$ DP HIG EF TH1M STH1M TH2M STH2M WN PHS PTP PLP PDIR PSPR PWS PDP +$ PQP PPE PGW PSW PTM10 PT01 PT02 PEP TWS PNR UST CHA CGE FAW TAW TWA WCC +$ WCF WCH WCM SXY TWO BHD FOC TUS USS P2S USF P2L TWI FIC ABR UBR BED +$ FBB TBB MSS MSC DTD FC CFX CFD CFK U1 U2 +$ + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$--------------------------------------------------------------------- $ +$ netCDF version [3,4] +$ and variable type 4 [2 = SHORT, 3 = it depends , 4 = REAL] +$ swell partitions [0 1 2 3 4 5] +$ variables in same file [T] or not [F] +$ + 4 4 + 0 1 2 + F +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, print plots. +$ IX,IY range and stride, flag for automatic scaling to +$ maximum value (otherwise fixed scaling), +$ vector component flag (dummy for scalar quantities). +$ +$ 1 12 1 1 12 1 F T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, field statistics. +$ IX,IY range. +$ +$ 1 12 1 12 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, transfer files. +$ IX, IY range, IDLA and IDFM as in ww3_grid.inp. +$ The additional option IDLA=5 gives ia longitude, lattitude +$ and parameter value(s) per record (defined points only). +$ +$1 12518 1 1 3 2 +$ +$ For each field and time a new file is generated with the file name +$ ww3.yymmddhh.xxx, where yymmddhh is a conventional time idicator, +$ and xxx is a field identifier. The first record of the file contains +$ a file ID (C*13), the time in yyyymmdd hhmmss format, the lowest, +$ highest and number of longitudes (2R,I), id. latitudes, the file +$ extension name (C*$), a scale factor (R), a unit identifier (C*10), +$ IDLA, IDFM, a format (C*11) and a number identifying undefined or +$ missing values (land, ice, etc.). The field follows as defined by +$ IDFM and IDLA, defined as in the grid proprocessor. IDLA=5 is added +$ and gives a set of records containing the longitude, latitude and +$ parameter value. Note that the actual data is written as an integers. +$ -------------------------------------------------------------------- $ +$ ITYPE = 4, Netcdf Files +$ S3: number of characters in date +$ IX, IY range +$ +ww3. +6 + 1 3070 1 1 3 2 +$ For each field and time a new file is generated with the file name +$ ww3.date_xxx.nc , where date is a conventional time idicator with S3 +$ characters, +$ and xxx is a field identifier. +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_ounp.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_ounp.inp new file mode 100755 index 0000000000..f0809c7532 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_ounp.inp @@ -0,0 +1,118 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III NETCDF Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 120000 3600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ +$ Define points index for which output is to be generated. +$ If no one defined, all points are selected +$ One index number per line, negative number identifies end of list. +$ +$ mandatory end of list + -1 +$ +$--------------------------------------------------------------------- $ +$ file prefix +$ number of characters in date [4(yearly),6(monthly),8(daily),10(hourly)] +$ netCDF version [3,4] +$ points in same file [T] or not [F] +$ and max number of points to be processed in one pass +$ output type ITYPE [0,1,2,3] +$ flag for global attributes WW3 [0] or variable version [1-2-3-4] +$ flag for dimensions order time,station [T] or station,time [F] +$ + ww3. + 6 + 4 + T 1 + 2 + 0 + T +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, netCDF Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Netcdf variable type [2=SHORT, 3=it depends, 4=REAL] +$ +$ 3 1 0 4 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, netCDF Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ 6 : WMO standard output + 2 +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, netCDF Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom, ice and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ +$ 4 0 0 T T T T T T T 0 +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequencies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Sice(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_outp.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_outp.inp new file mode 100644 index 0000000000..0e9986f828 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_outp.inp @@ -0,0 +1,112 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Point output post-processing $ +$--------------------------------------------------------------------- $ +$ First output time (yyyymmdd hhmmss), increment of output (s), +$ and number of output times. +$ + 20151214 120000 600. 9999 +$ +$ Points requested --------------------------------------------------- $ +$ Define points for which output is to be generated. +$ +$ mandatory end of list + -1 +$ +$ Output type ITYPE [0,1,2,3] +$ + 2 +$ -------------------------------------------------------------------- $ +$ ITYPE = 0, inventory of file. +$ No additional input, the above time range is ignored. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 1, Spectra. +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D spectra +$ 3 : Transfer file. +$ 4 : Spectral partitioning. +$ - Scaling factors for 1-D and 2-D spectra Negative factor +$ disables, output, factor = 0. gives normalized spectrum. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flag for unformatted transfer file. +$ +$ 3 1. 0. 33 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, number of frequencies, directions and points. +$ grid name in quotes (for unformatted file C*21,3I,C*30). +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), lat, lon, d, U10 and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) | points | times +$ -+ -+ +$ +$ The formatted file is readable usign free format throughout. +$ This datat set can be used as input for the bulletin generator +$ w3split. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 2, Tables of (mean) parameter +$ - Sub-type OTYPE : 1 : Depth, current, wind +$ 2 : Mean wave pars. +$ 3 : Nondimensional pars. (U*) +$ 4 : Nondimensional pars. (U10) +$ 5 : 'Validation table' +$ - Unit number for file, also used in file name. +$ + 2 33 +$ +$ If output for one point is requested, a time series table is made, +$ otherwise the file contains a separate tables for each output time. +$ +$ -------------------------------------------------------------------- $ +$ ITYPE = 3, Source terms +$ - Sub-type OTYPE : 1 : Print plots. +$ 2 : Table of 1-D S(f). +$ 3 : Table of 1-D inverse time scales +$ (1/T = S/F). +$ 4 : Transfer file +$ - Scaling factors for 1-D and 2-D source terms. Negative +$ factor disables print plots, factor = 0. gives normalized +$ print plots. +$ - Unit number for transfer file, also used in table file +$ name. +$ - Flags for spectrum, input, interactions, dissipation, +$ bottom and total source term. +$ - scale ISCALE for OTYPE=2,3 +$ 0 : Dimensional. +$ 1 : Nondimensional in terms of U10 +$ 2 : Nondimensional in terms of U* +$ 3-5: like 0-2 with f normalized with fp. +$ - Flag for unformatted transfer file. +$ +$ 1 0. 0. 50 T T T T T T 0 F +$ +$ The transfer file contains records with the following contents. +$ +$ - File ID in quotes, nubmer of frequencies, directions and points, +$ flags for spectrum and source terms (C*21, 3I, 6L) +$ - Bin frequenies in Hz for all bins. +$ - Bin directions in radians for all bins (Oceanographic conv.). +$ -+ +$ - Time in yyyymmdd hhmmss format | loop +$ -+ | +$ - Point name (C*40), depth, wind speed and | loop | over +$ direction, current speed and direction | over | +$ - E(f,theta) if requested | points | times +$ - Sin(f,theta) if requested | | +$ - Snl(f,theta) if requested | | +$ - Sds(f,theta) if requested | | +$ - Sbt(f,theta) if requested | | +$ - Stot(f,theta) if requested | | +$ -+ -+ +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_current.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_current.inp new file mode 100755 index 0000000000..f9de2d4959 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_current.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'CUR' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ucur vcur +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/current.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_ice.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_ice.inp new file mode 100755 index 0000000000..6b7077572c --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_ice.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'ICE' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + ice +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/ice.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_level.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_level.inp new file mode 100755 index 0000000000..6ff15c0879 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_level.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'LEV' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + wlv +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input_ice/levelNoNaN.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_wind.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_wind.inp new file mode 100755 index 0000000000..c0330bc5b7 --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_prnc_wind.inp @@ -0,0 +1,51 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III Field preprocessor input file $ +$ -------------------------------------------------------------------- $ +$ Mayor types of field and time flag +$ Field types : ICE Ice concentrations. +$ LEV Water levels. +$ WND Winds. +$ WNS Winds (including air-sea temp. dif.) +$ CUR Currents. +$ DAT Data for assimilation. +$ +$ Format types : AI Transfer field 'as is'. (ITYPE 1) +$ LL Field defined on regular longitude-latitude +$ or Cartesian grid. (ITYPE 2) +$ Format types : AT Transfer field 'as is', performs tidal +$ analysis on the time series (ITYPE 6) +$ When using AT, another line should be added +$ with the choice ot tidal constituents: +$ ALL or FAST or VFAST or a list: e.g. 'M2 S2' +$ +$ - Format type not used for field type 'DAT'. +$ +$ Time flag : If true, time is included in file. +$ Header flag : If true, header is added to file. +$ (necessary for reading, FALSE is used only for +$ incremental generation of a data file.) +$ + 'WND' 'AI' T T +$ +$ Name of dimensions ------------------------------------------------- $ +$ + time +$ +$ Variables to use --------------------------------------------------- $ +$ + uwnd vwnd +$ +$ Additional time input ---------------------------------------------- $ +$ If time flag is .FALSE., give time of field in yyyymmdd hhmmss format. +$ +$ 19680606 053000 +$ +$ Define data files -------------------------------------------------- $ +$ The input line identifies the filename using for the forcing field. +$ + '../input/wind.nc' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ + diff --git a/regtests/ww3_tp2.17/input_deep_restart/ww3_shel.inp b/regtests/ww3_tp2.17/input_deep_restart/ww3_shel.inp new file mode 100755 index 0000000000..caf21c86cd --- /dev/null +++ b/regtests/ww3_tp2.17/input_deep_restart/ww3_shel.inp @@ -0,0 +1,148 @@ +$ -------------------------------------------------------------------- $ +$ WAVEWATCH III shell input file $ +$ -------------------------------------------------------------------- $ +$ Define input to be used with flag for use and flag for definition +$ as a homogeneous field (first three only); seven input lines. +$ + F F Ice parameter 1 + F F Ice parameter 2 + F F Ice parameter 3 + F F Ice parameter 4 + F F Ice parameter 5 + F F Mud parameter 1 + F F Mud parameter 2 + F F Mud parameter 3 + T F Water levels + T F Currents + T F Winds + T F Ice concentrations + F F Atmospheric momentum + F F Air density + F Assimilation data : Mean parameters + F Assimilation data : 1-D spectra + F Assimilation data : 2-D spectra. +$ +$ Time frame of calculations ----------------------------------------- $ +$ - Starting time in yyyymmdd hhmmss format. +$ - Ending time in yyyymmdd hhmmss format. +$ + 20151214 120000 + 20151215 000000 +$ +$ Define output data ------------------------------------------------- $ +$ +$ Define output server mode. This is used only in the parallel version +$ of the model. To keep the input file consistent, it is always needed. +$ IOSTYP = 1 is generally recommended. IOSTYP > 2 may be more efficient +$ for massively parallel computations. Only IOSTYP = 0 requires a true +$ parallel file system like GPFS. +$ +$ IOSTYP = 0 : No data server processes, direct access output from +$ each process (requirese true parallel file system). +$ 1 : No data server process. All output for each type +$ performed by process that performes computations too. +$ 2 : Last process is reserved for all output, and does no +$ computing. +$ 3 : Multiple dedicated output processes. +$ + 0 +$ +$ Five output types are available (see below). All output types share +$ a similar format for the first input line: +$ - first time in yyyymmdd hhmmss format, output interval (s), and +$ last time in yyyymmdd hhmmss format (all integers). +$ Output is disabled by setting the output interval to 0. +$ +$ Type 1 : Fields of mean wave parameters +$ Standard line and line with flags to activate output fields +$ as defined in section 2.4 of the manual. The second line is +$ not supplied if no output is requested. +$ The raw data file is out_grd.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ +$ + 20151214 130000 3600 20151215 000000 + N + WLV WND CUR ICE HS T01 T02 DIR FP DP PHS PTP PDIR +$ +$ +$ Type 2 : Point output +$ Standard line and a number of lines identifying the +$ longitude, latitude and name (C*40) of output points. +$ The list is closed by defining a point with the name +$ 'STOPSTRING'. No point info read if no point output is +$ requested (i.e., no 'STOPSTRING' needed). +$ Example for spherical grid. +$ The raw data file is out_pnt.ww3, +$ see w3iogo.ftn for additional doc. +$ +$ NOTE : Spaces may be included in the name, but this is not +$ advised, because it will break the GrADS utility to +$ plots spectra and source terms, and will make it more +$ difficult to use point names in data files. +$ + 20151214 120000 3600 20151215 000000 +$ +$output points for Inlet +$ +-72.31 40.44 a01 +-72.34 40.50 a02 +-72.38 40.55 a03 +-72.40 40.59 a04 +-72.42 40.63 a05 +-72.44 40.67 a06 +-72.46 40.72 a07 +-72.47 40.76 a08 +-72.49 40.81 a09 +-72.51 40.84 a10 +$ + 0.0 0.0 'STOPSTRING' +$ +$ Type 3 : Output along track. +$ Flag for formatted input file. +$ The data files are track_i.ww3 and +$ track_o.ww3, see w3iotr.ftn for ad. doc. +$ + 20060101 000000 0 20040101 000000 +$ +$ Type 4 : Restart files (no additional data required). +$ The data file is restartN.ww3, see +$ w3iors.ftn for additional doc. +$ + 20151214 120000 0 20151215 000000 T + 20151214 120000 3600 20151215 000000 +$ +$ Type 5 : Boundary data (no additional data required). +$ The data file is nestN.ww3, see +$ w3iobp.ftn for additional doc. +$ + 20040601 000000 0 20040103 000000 +$ +$ Type 6 : Separated wave field data (dummy for now). +$ First, last step IX and IY, flag for formatted file +$ + 20060101 000000 0 20040603 000000 +$ +$ Testing of output through parameter list (C/TPAR) ------------------ $ +$ Time for output and field flags as in above output type 1. +$ +$ 19680606 014500 +$ T T T T T T T T T T T T T T T T +$ +$ Homogeneous field data --------------------------------------------- $ +$ Homogeneous fields can be defined by a list of lines containing an ID +$ string 'LEV' 'CUR' 'WND', date and time information (yyyymmdd +$ hhmmss), value (S.I. units), direction (current and wind, oceanographic +$ convention degrees)) and air-sea temparature difference (degrees C). +$ 'STP' is mandatory stop string. +$ +$ 'WND' 20080101 000000 20. 315. 0.0 +$ + 'the_end' 0 +$ + 'STP' +$ +$ -------------------------------------------------------------------- $ +$ End of input file $ +$ -------------------------------------------------------------------- $ From 3e591453c9d95bb837f87b578e10f79f9c5f0952 Mon Sep 17 00:00:00 2001 From: kestonsmith-noaa <107580916+kestonsmith-noaa@users.noreply.github.com> Date: Fri, 24 Apr 2026 09:32:11 -0400 Subject: [PATCH 136/136] Fix failure of restart reproducability in cases with variable water level and deep bathymetry. In subroutine W3ULEV KDCHK computed from bathymetric depth rather than total water level. (#1591) --- model/src/w3initmd.F90 | 25 ++++++++++++++++++++++++- model/src/w3updtmd.F90 | 14 +++++++++++++- 2 files changed, 37 insertions(+), 2 deletions(-) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 2fc3741e88..7b14170461 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -514,6 +514,9 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, #ifdef W3_DIST CHARACTER(LEN=12) :: FORMAT #endif + REAL :: DEPTHbat,WNbat,CGbat,KDCHCK + REAL :: KDMAX = 4. + CHARACTER(LEN=23) :: DTME21 CHARACTER(LEN=30) :: LFILE, TFILE integer :: memunit @@ -1399,7 +1402,27 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT, FLGRD, FLGR2, FLGD, WRITE (NDST,9051) IS, DEPTH #endif ! - DO IK=0, NK+1 + ! In shallow water, KDCHCK < KDMAX, assign time varying WN and CG as water level changes. + ! In deep water, KDCHCK >= KDMAX, assign time constant WN and CG based on bathymetric depth (-ZB). + ! + ! Calculate the wavenumber for lowest frequency based on bathymetric depth + IF (IS.GT.0) THEN + DEPTHbat = MAX(DMIN,-ZB(IS)) + ELSE + DEPTHbat = DMIN + END IF +#ifdef W3_PDLIB + CALL WAVNU3(SIG(1),DEPTHbat,WNbat,CGbat) +#else + CALL WAVNU1(SIG(1),DEPTHbat,WNbat,CGbat) +#endif + KDCHCK = WNbat * DEPTHbat + IF ( KDCHCK .GE. KDMAX ) THEN + ! Use time constant CG and WN based on bathymetry for this point rather than time varying total depth. + DEPTH=DEPTHbat + ENDIF + + DO IK=0, NK+1 ! ! Calculate wavenumbers and group velocities. #ifdef W3_PDLIB diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index 9d11228371..e65aeede6b 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -2201,6 +2201,7 @@ SUBROUTINE W3ULEV ( A, VA ) OWN(NK), DWN(NK) REAL :: KDMAX = 4., RDKMIN = 0.05 REAL :: WLVeff + REAL :: DEPTHbat, CGbat, WNbat #ifdef W3_T3 REAL :: OUT(NK,NTH) #endif @@ -2345,7 +2346,18 @@ SUBROUTINE W3ULEV ( A, VA ) ! ! 2.a Check if deep water ! - KDCHCK = WN(1,ISEA) * MIN( DWO(ISEA) , DW(ISEA) ) + ! + ! In shallow water, KDCHCK < KDMAX, assign time varying WN and CG as water level changes. + ! In deep water, KDCHCK >= KDMAX, assign time constant WN and CG based on bathymetric depth (-ZB). + ! + ! Calculate the wavenumber for lowest frequency based on bathymetric depth + DEPTHbat=MAX(DMIN,-ZB(ISEA)) +#ifdef W3_PDLIB + CALL WAVNU3(SIG(1),DEPTHbat,WNbat,CGbat) +#else + CALL WAVNU1(SIG(1),DEPTHbat,WNbat,CGbat) +#endif + KDCHCK = WNbat * DEPTHbat IF ( KDCHCK .LT. KDMAX ) THEN ! ! 2.b Update grid and save old grid