diff --git a/model/inp/ww3_shel.inp b/model/inp/ww3_shel.inp index 576e01c5f..a7e933c15 100644 --- a/model/inp/ww3_shel.inp +++ b/model/inp/ww3_shel.inp @@ -178,10 +178,10 @@ $ F T 5 3 CGE CGE Energy flux $ F T 5 4 PHIAW FAW Air-sea energy flux $ F T 5 5 TAUWI[X,Y] TAW Net wave-supported stress $ F T 5 6 TAUWN[X,Y] TWA Negative part of the wave-supported stress -$ F F 5 7 WHITECAP WCC Whitecap coverage -$ F F 5 8 WHITECAP WCF Whitecap thickness -$ F F 5 9 WHITECAP WCH Mean breaking height -$ F F 5 10 WHITECAP WCM Whitecap moment +$ F F 5 7 WCAP_COV WCC Whitecap coverage +$ F F 5 8 WCAP_THK WCF Whitecap thickness +$ F F 5 9 WCAP_BHS WCH Mean breaking height +$ F F 5 10 WCAP_MNT WCM Whitecap moment $ F F 5 11 FWS FWS Wind sea mean period $ ------------------------------------------------- $ 6 Wave-ocean layer diff --git a/model/nml/ww3_shel.nml b/model/nml/ww3_shel.nml index b6ae8cfef..ca200c54b 100644 --- a/model/nml/ww3_shel.nml +++ b/model/nml/ww3_shel.nml @@ -168,10 +168,10 @@ ! F T 5 4 PHIAW FAW Air-sea energy flux ! F T 5 5 TAUWI[X,Y] TAW Net wave-supported stress ! F T 5 6 TAUWN[X,Y] TWA Negative part of the wave-supported stress -! F F 5 7 WHITECAP WCC Whitecap coverage -! F F 5 8 WHITECAP WCF Whitecap thickness -! F F 5 9 WHITECAP WCH Mean breaking height -! F F 5 10 WHITECAP WCM Whitecap moment +! F F 5 7 WCAP_COV WCC Whitecap coverage +! F F 5 8 WCAP_THK WCF Whitecap thickness +! F F 5 9 WCAP_BHS WCH Mean breaking height +! F F 5 10 WCAP_MNT WCM Whitecap moment ! F F 5 11 FWS FWS Wind sea mean period ! ------------------------------------------------- ! 6 Wave-ocean layer diff --git a/model/src/gx_outf.F90 b/model/src/gx_outf.F90 index c8ab00e38..e9069b41f 100644 --- a/model/src/gx_outf.F90 +++ b/model/src/gx_outf.F90 @@ -171,7 +171,7 @@ PROGRAM GXOUTF TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & TAUWNX, TAUWNY, BHD, P2SMS, DTDYN, & - CGE, T02, BEDFORMS, WHITECAP, TAUBBL, PHIBBL,& + CGE, T02, PHIBBL, & CFLXYMAX, CFLTHMAX, CFLKMAX, US3D, STMAXE, & STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD, WBT USE W3ODATMD, ONLY: NDSE, NDST, NDSO, NOGRP, NGRPP, IDOUT, UNDEF,& diff --git a/model/src/gx_outp.F90 b/model/src/gx_outp.F90 index 8dce5f4d0..05f300a1f 100644 --- a/model/src/gx_outp.F90 +++ b/model/src/gx_outp.F90 @@ -794,7 +794,7 @@ SUBROUTINE GXEXPO #endif #ifdef W3_ST4 REAL :: FMEANWS, TAUWX, TAUWY, AMAX, & - TAUWNX, TAUWNY, FMEAN1, WHITECAP(1:4), DLWMEAN + TAUWNX, TAUWNY, FMEAN1, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN #endif #ifdef W3_ST6 REAL :: AMAX, TAUWX, TAUWY, TAUWNX, TAUWNY @@ -1231,7 +1231,8 @@ SUBROUTINE GXEXPO #endif #ifdef W3_ST4 CALL W3SDS4 ( A, WN, CG, & - USTAR, USTD, DEPTH, DAIR, XDS, DIA, IX, IY, LAMBDA, WHITECAP , DLWMEAN) + USTAR, USTD, DEPTH, DAIR, XDS, DIA, IX, IY, LAMBDA, & + WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN) #endif #ifdef W3_ST6 CALL W3SDS6 ( A, CG, WN, XDS, DIA ) @@ -1276,8 +1277,9 @@ SUBROUTINE GXEXPO #endif #ifdef W3_BT4 - CALL W3SBT4 ( A, CG, WN, DEPTH, D50, PSIC, TAUBBL, & - BEDFORM, XBT, DIA, IX, IY ) + CALL W3SBT4 ( A, CG, WN, DEPTH, D50, PSIC, TAUBBL(1), & + TAUBBL(2), BEDFORM(1), BEDFORM(2), BEDFORM(3), & + XBT, DIA, IX, IY ) #endif ! diff --git a/model/src/pdlib_field_vec.F90 b/model/src/pdlib_field_vec.F90 index b386b8786..6166a76bb 100644 --- a/model/src/pdlib_field_vec.F90 +++ b/model/src/pdlib_field_vec.F90 @@ -824,11 +824,13 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) TAUOY, USSX, USSY, MSSX, MSSY, & MSCX, MSCY, PRMS, TPMS, CHARN, & TAUWNX, TAUWNY, BHD, CGE, & - CFLXYMAX, CFLTHMAX, CFLKMAX, WHITECAP, & - BEDFORMS, PHIBBL, TAUBBL, T01, & + CFLXYMAX, CFLTHMAX, CFLKMAX, & + WCAP_COV, WCAP_THK, WCAP_BHS, WCAP_MNT,& + BEDROUGH, BEDRIPX, BEDRIPY, PHIBBL, & + TAUBBLX, TAUBBLY, T01, & P2SMS, US3D, EF, TH1M, STH1M, TH2M, & - STH2M, HSIG, TAUICE, PHICE, PTHP0, PQP,& - PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & + STH2M, HSIG, TAUICEX, TAUICEY, PHICE, & + PTHP0, PQP, PPE, PGW, PSW, PTM1, PT1, PT2, PEP, & QP, MSSD, MSCD, STMAXE, STMAXD, HMAXE, & HCMAXE, HMAXD, HCMAXD, WBT, USSP USE W3GDATMD, ONLY: NK, NSEAL @@ -1130,19 +1132,19 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=WHITECAP(JSEA,1) + Arrexch(IH,JSEA)=WCAP_COV(JSEA) END IF IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=WHITECAP(JSEA,2) + Arrexch(IH,JSEA)=WCAP_THK(JSEA) END IF IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=WHITECAP(JSEA,3) + Arrexch(IH,JSEA)=WCAP_BHS(JSEA) END IF IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=WHITECAP(JSEA,4) + Arrexch(IH,JSEA)=WCAP_MNT(JSEA) END IF IF ( FLGRDALL( 6, 1) ) THEN IH = IH + 1 @@ -1198,9 +1200,9 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 6, 10) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=TAUICE(JSEA,1) + Arrexch(IH,JSEA)=TAUICEX(JSEA) IH = IH + 1 - Arrexch(IH,JSEA)=TAUICE(JSEA,2) + Arrexch(IH,JSEA)=TAUICEY(JSEA) END IF IF ( FLGRDALL( 6, 11) ) THEN IH = IH + 1 @@ -1232,11 +1234,11 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=BEDFORMS(JSEA,1) + Arrexch(IH,JSEA)=BEDROUGH(JSEA) IH = IH + 1 - Arrexch(IH,JSEA)=BEDFORMS(JSEA,2) + Arrexch(IH,JSEA)=BEDRIPX(JSEA) IH = IH + 1 - Arrexch(IH,JSEA)=BEDFORMS(JSEA,3) + Arrexch(IH,JSEA)=BEDRIPY(JSEA) END IF IF ( FLGRDALL( 7, 4) ) THEN IH = IH + 1 @@ -1244,9 +1246,9 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 - Arrexch(IH,JSEA)=TAUBBL(JSEA,1) + Arrexch(IH,JSEA)=TAUBBLX(JSEA) IH = IH + 1 - Arrexch(IH,JSEA)=TAUBBL(JSEA,2) + Arrexch(IH,JSEA)=TAUBBLY(JSEA) END IF IF ( FLGRDALL( 8, 1) ) THEN IH = IH + 1 @@ -1573,19 +1575,19 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 - WHITECAP(1:NSEA,1) = ARRtotal(IH,:) + WCAP_COV(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 - WHITECAP(1:NSEA,2) = ARRtotal(IH,:) + WCAP_THK(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 - WHITECAP(1:NSEA,3) = ARRtotal(IH,:) + WCAP_BHS(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 - WHITECAP(1:NSEA,4) = ARRtotal(IH,:) + WCAP_MNT(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 1) ) THEN IH = IH + 1 @@ -1641,9 +1643,9 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 6, 10) ) THEN IH = IH + 1 - TAUICE(1:NSEA,1) = ARRtotal(IH,:) + TAUICEX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 - TAUICE(1:NSEA,2) = ARRtotal(IH,:) + TAUICEY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 6, 11) ) THEN IH = IH + 1 @@ -1675,11 +1677,11 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 - BEDFORMS(1:NSEA,1) = ARRtotal(IH,:) + BEDROUGH(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 - BEDFORMS(1:NSEA,2) = ARRtotal(IH,:) + BEDRIPX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 - BEDFORMS(1:NSEA,3) = ARRtotal(IH,:) + BEDRIPY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 7, 4) ) THEN IH = IH + 1 @@ -1687,9 +1689,9 @@ SUBROUTINE DO_OUTPUT_EXCHANGES(IMOD) END IF IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 - TAUBBL(1:NSEA,1) = ARRtotal(IH,:) + TAUBBLX(1:NSEA) = ARRtotal(IH,:) IH = IH + 1 - TAUBBL(1:NSEA,2) = ARRtotal(IH,:) + TAUBBLY(1:NSEA) = ARRtotal(IH,:) END IF IF ( FLGRDALL( 8, 1) ) THEN IH = IH + 1 diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 2daee3609..2d34a609a 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -62,6 +62,9 @@ MODULE W3ADATMD !/ 21-Aug-2018 : Add WBT parameter ( version 6.06 ) !/ 22-Mar-2021 : Adds TAUA, WNMEAN, TAUOC parameters ( version 7.13 ) !/ 06-May-2021 : SMC shares variables with PR2/3. ( version 7.13 ) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. C Bunney ! !/ !/ Copyright 2009-2013 National Weather Service (NWS), @@ -156,11 +159,10 @@ MODULE W3ADATMD ! PHIAW R.A. Public Wind to wave energy flux. ! TAUWIX/Y R.A. Public Wind to wave energy flux. ! TAUWNX/Y R.A. Public Wind to wave energy flux. - ! WHITECAP R.A. Public 1 : Whitecap coverage - ! 2 : Whitecap thickness - ! 3 : Mean breaking height - ! 4 : Mean breaking height - ! + ! WCAP_COV R.A. Public Whitecap coverage + ! WCAP_THK R.A. Public Whitecap thickness + ! WCAP_BHS R.A. Public Mean breaking height + ! WCAP_MNT R.A. Public Whitecap moment ! Sxx R.A. Public Radiation stresses. ! TAUOX/Y R.A. Public Wave-ocean momentum flux. ! BHD R.A. Public Wave-induced pressure (J term, Smith JPO 2006) @@ -168,7 +170,7 @@ MODULE W3ADATMD ! TUSX/Y R.A. Public Volume transport associated to Stokes drift. ! USSX/Y R.A. Public Surface Stokes drift. ! TAUOCX/Y R.A. Public Total ocean momentum flux - ! TAUICE R.A. Public Wave-ice momentum flux. + ! TAUICEX/Y R.A. Public Wave-ice momentum flux. ! PHICE R.A. Public Waves to ice energy flux. ! ! US3D R.A. Public 3D Stokes drift. @@ -178,9 +180,11 @@ MODULE W3ADATMD ! ABD R.A. Public Corresponding direction. ! UBA R.A. Public Near-bottom rms wave velocity. ! UBD R.A. Public Corresponding direction. - ! BEDFORMS R.A. Public Bed for parameters + ! BEDROUGH R.A. Public Bedform roughness + ! BEDRIPX R.A. Public Bedform ripple wavelength (x) + ! BEDRIPY R.A. Public Bedform ripple wavelength (y) ! PHIBBL R.A. Public Energy loss in WBBL. - ! TAUBBL R.A. Public Momentum loss in WBBL. + ! TAUBBLX/Y R.A. Public Momentum loss in WBBL. ! ! MSSX/Y R.A. Public Surface mean square slopes in X and Y direction. ! MSCX/Y R.A. Public Phillips constant. @@ -441,11 +445,13 @@ MODULE W3ADATMD ! Output fields group 5) ! REAL, POINTER :: CHARN(:), CGE(:), PHIAW(:), & - TAUWIX(:), TAUWIY(:), TAUWNX(:), & - TAUWNY(:), WHITECAP(:,:), TWS(:) + TAUWIX(:), TAUWIY(:), TAUWNX(:), TAUWNY(:), & + WCAP_COV(:), WCAP_THK(:), WCAP_BHS(:), WCAP_MNT(:), & + TWS(:) REAL, POINTER :: XCHARN(:), XCGE(:), XPHIAW(:), & - XTAUWIX(:), XTAUWIY(:), XTAUWNX(:), & - XTAUWNY(:), XWHITECAP(:,:), XTWS(:) + XTAUWIX(:), XTAUWIY(:), XTAUWNX(:), XTAUWNY(:), & + XWCAP_COV(:), XWCAP_THK(:), XWCAP_BHS(:), XWCAP_MNT(:), & + XTWS(:) ! ! Output fields group 6) ! @@ -454,24 +460,24 @@ MODULE W3ADATMD TUSX(:), TUSY(:), USSX(:), & USSY(:), TAUOCX(:), TAUOCY(:), & PRMS(:), TPMS(:), PHICE(:), & - TAUICE(:,:) + TAUICEX(:), TAUICEY(:) REAL, POINTER :: P2SMS(:,:), US3D(:,:), USSP(:,:) REAL, POINTER :: XSXX(:), XSYY(:), XSXY(:), XTAUOX(:),& XTAUOY(:), XBHD(:), XPHIOC(:), & XTUSX(:), XTUSY(:), XUSSX(:), & XUSSY(:), XTAUOCX(:), XTAUOCY(:), & XPRMS(:), XTPMS(:), XPHICE(:), & - XTAUICE(:,:) + XTAUICEX(:), XTAUICEY(:) REAL, POINTER :: XP2SMS(:,:), XUS3D(:,:), XUSSP(:,:) ! ! Output fields group 7) ! REAL, POINTER :: ABA(:), ABD(:), UBA(:), UBD(:), & - BEDFORMS(:,:), PHIBBL(:), & - TAUBBL(:,:) + BEDROUGH(:), BEDRIPX(:), BEDRIPY(:), PHIBBL(:), & + TAUBBLX(:), TAUBBLY(:) REAL, POINTER :: XABA(:), XABD(:), XUBA(:), XUBD(:), & - XBEDFORMS(:,:), XPHIBBL(:), & - XTAUBBL(:,:) + XBEDROUGH(:), XBEDRIPX(:), XBEDRIPY(:), XPHIBBL(:), & + XTAUBBLX(:), XTAUBBLY(:) ! ! Output fields group 8) ! @@ -601,18 +607,20 @@ MODULE W3ADATMD PTM1(:,:), PT1(:,:), PT2(:,:),PEP(:,:) ! REAL, POINTER :: CHARN(:), CGE(:), PHIAW(:), & - TAUWIX(:), TAUWIY(:), TAUWNX(:), & - TAUWNY(:), WHITECAP(:,:), TWS(:) + TAUWIX(:), TAUWIY(:), TAUWNX(:), TAUWNY(:), & + WCAP_COV(:), WCAP_THK(:), WCAP_BHS(:), WCAP_MNT(:), & + TWS(:) ! REAL, POINTER :: SXX(:), SYY(:), SXY(:), TAUOX(:), & TAUOY(:), BHD(:), PHIOC(:), & TUSX(:), TUSY(:), USSX(:), USSY(:), & TAUOCX(:), TAUOCY(:), PRMS(:), & - TPMS(:), PHICE(:), TAUICE(:,:) + TPMS(:), PHICE(:), TAUICEX(:), TAUICEY(:) REAL, POINTER :: P2SMS(:,:), US3D(:,:), USSP(:,:) ! REAL, POINTER :: ABA(:), ABD(:), UBA(:), UBD(:), & - BEDFORMS(:,:), PHIBBL(:), TAUBBL(:,:) + BEDROUGH(:), BEDRIPX(:), BEDRIPY(:), PHIBBL(:), & + TAUBBLX(:), TAUBBLY(:) ! REAL, POINTER :: MSSX(:), MSSY(:), MSSD(:), & MSCX(:), MSCY(:), MSCD(:), QKK(:), SKEW(:), EMBIA1(:), EMBIA2(:) @@ -1158,7 +1166,7 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ! ! Friction velocity UST and USTDIR in W3WDATMD ! - ALLOCATE ( WADATS(IMOD)%CHARN (NSEALM), & + ALLOCATE ( WADATS(IMOD)%CHARN (NSEALM), & WADATS(IMOD)%TWS (NSEALM), & WADATS(IMOD)%CGE (NSEALM), & WADATS(IMOD)%PHIAW (NSEALM), & @@ -1166,7 +1174,10 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%TAUWIY (NSEALM), & WADATS(IMOD)%TAUWNX (NSEALM), & WADATS(IMOD)%TAUWNY (NSEALM), & - WADATS(IMOD)%WHITECAP(NSEALM,4), & + WADATS(IMOD)%WCAP_COV(NSEALM), & + WADATS(IMOD)%WCAP_THK(NSEALM), & + WADATS(IMOD)%WCAP_BHS(NSEALM), & + WADATS(IMOD)%WCAP_MNT(NSEALM), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! @@ -1178,7 +1189,10 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%TAUWIY = UNDEF WADATS(IMOD)%TAUWNX = UNDEF WADATS(IMOD)%TAUWNY = UNDEF - WADATS(IMOD)%WHITECAP = UNDEF + WADATS(IMOD)%WCAP_COV = UNDEF + WADATS(IMOD)%WCAP_THK = UNDEF + WADATS(IMOD)%WCAP_BHS = UNDEF + WADATS(IMOD)%WCAP_MNT = UNDEF call print_memcheck(memunit, 'memcheck_____:'//' W3DIMA 5') ! @@ -1200,7 +1214,8 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%PRMS (NSEALM) , & WADATS(IMOD)%TPMS (NSEALM) , & WADATS(IMOD)%PHICE (NSEALM) , & - WADATS(IMOD)%TAUICE(NSEALM,2), & + WADATS(IMOD)%TAUICEX(NSEALM), & + WADATS(IMOD)%TAUICEY(NSEALM), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! @@ -1236,7 +1251,8 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%PRMS = UNDEF WADATS(IMOD)%TPMS = UNDEF WADATS(IMOD)%PHICE = UNDEF - WADATS(IMOD)%TAUICE = UNDEF + WADATS(IMOD)%TAUICEX = UNDEF + WADATS(IMOD)%TAUICEY = UNDEF IF ( P2MSF(1).GT.0 ) WADATS(IMOD)%P2SMS = UNDEF IF ( US3DF(1).GT.0 ) WADATS(IMOD)%US3D = UNDEF IF ( USSPF(1).GT.0 ) WADATS(IMOD)%USSP = UNDEF @@ -1247,18 +1263,25 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ! ALLOCATE ( WADATS(IMOD)%ABA(NSEALM) , WADATS(IMOD)%ABD(NSEALM) , & WADATS(IMOD)%UBA(NSEALM) , WADATS(IMOD)%UBD(NSEALM) , & - WADATS(IMOD)%BEDFORMS(NSEALM,3), & + WADATS(IMOD)%BEDROUGH(NSEALM), & + WADATS(IMOD)%BEDRIPX(NSEALM), & + WADATS(IMOD)%BEDRIPY(NSEALM), & WADATS(IMOD)%PHIBBL (NSEALM) , & - WADATS(IMOD)%TAUBBL (NSEALM,2), STAT=ISTAT ) + WADATS(IMOD)%TAUBBLX (NSEALM), & + WADATS(IMOD)%TAUBBLY (NSEALM), & + STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! WADATS(IMOD)%ABA = UNDEF WADATS(IMOD)%ABD = UNDEF WADATS(IMOD)%UBA = UNDEF WADATS(IMOD)%UBD = UNDEF - WADATS(IMOD)%BEDFORMS = UNDEF + WADATS(IMOD)%BEDROUGH = UNDEF + WADATS(IMOD)%BEDRIPX = UNDEF + WADATS(IMOD)%BEDRIPY = UNDEF WADATS(IMOD)%PHIBBL = UNDEF - WADATS(IMOD)%TAUBBL = UNDEF + WADATS(IMOD)%TAUBBLX = UNDEF + WADATS(IMOD)%TAUBBLY = UNDEF call print_memcheck(memunit, 'memcheck_____:'//' W3DIMA 7') ! @@ -2002,10 +2025,22 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) ! IF ( OUTFLAGS( 5, 7) .OR. OUTFLAGS( 5, 8) .OR. & OUTFLAGS( 5, 9) .OR. OUTFLAGS( 5,10)) THEN - ALLOCATE ( WADATS(IMOD)%XWHITECAP(NXXX,4), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_COV(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_THK(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_BHS(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_MNT(NXXX), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ELSE - ALLOCATE ( WADATS(IMOD)%XWHITECAP(1,4), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_COV(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_THK(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_BHS(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XWCAP_MNT(1), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF ! @@ -2025,7 +2060,10 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) WADATS(IMOD)%XTAUWIY = UNDEF WADATS(IMOD)%XTAUWNX = UNDEF WADATS(IMOD)%XTAUWNY = UNDEF - WADATS(IMOD)%XWHITECAP = UNDEF + WADATS(IMOD)%WCAP_COV = UNDEF + WADATS(IMOD)%WCAP_THK = UNDEF + WADATS(IMOD)%WCAP_BHS = UNDEF + WADATS(IMOD)%WCAP_MNT = UNDEF ! IF ( OUTFLAGS( 6, 1) ) THEN ALLOCATE ( WADATS(IMOD)%XSXX(NXXX), STAT=ISTAT ) @@ -2124,10 +2162,14 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) END IF ! IF ( OUTFLAGS( 6,10) ) THEN - ALLOCATE ( WADATS(IMOD)%XTAUICE(NXXX,2), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUICEX(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUICEY(NXXX), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ELSE - ALLOCATE ( WADATS(IMOD)%XTAUICE(1,2), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUICEX(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUICEY(1), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF ! @@ -2175,7 +2217,8 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) WADATS(IMOD)%XUS3D = UNDEF WADATS(IMOD)%XP2SMS = UNDEF WADATS(IMOD)%XPHICE = UNDEF - WADATS(IMOD)%XTAUICE = UNDEF + WADATS(IMOD)%XTAUICEX = UNDEF + WADATS(IMOD)%XTAUICEY = UNDEF WADATS(IMOD)%XUSSP = UNDEF WADATS(IMOD)%XTAUOCX = UNDEF WADATS(IMOD)%XTAUOCY = UNDEF @@ -2205,10 +2248,18 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) END IF ! IF ( OUTFLAGS( 7, 3) ) THEN - ALLOCATE ( WADATS(IMOD)%XBEDFORMS(NXXX,3), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XBEDROUGH(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XBEDRIPX(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XBEDRIPY(NXXX), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ELSE - ALLOCATE ( WADATS(IMOD)%XBEDFORMS(1,3), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XBEDROUGH(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XBEDRIPX(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XBEDRIPY(1), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF ! @@ -2221,10 +2272,14 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) END IF ! IF ( OUTFLAGS( 7, 5) ) THEN - ALLOCATE ( WADATS(IMOD)%XTAUBBL(NXXX,2), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUBBLX(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUBBLY(NXXX), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ELSE - ALLOCATE ( WADATS(IMOD)%XTAUBBL(1,2), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUBBLX(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XTAUBBLY(1), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF ! @@ -2232,9 +2287,12 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) WADATS(IMOD)%XABD = UNDEF WADATS(IMOD)%XUBA = UNDEF WADATS(IMOD)%XUBD = UNDEF - WADATS(IMOD)%XBEDFORMS = UNDEF + WADATS(IMOD)%XBEDROUGH = UNDEF + WADATS(IMOD)%XBEDRIPX = UNDEF + WADATS(IMOD)%XBEDRIPY = UNDEF WADATS(IMOD)%XPHIBBL = UNDEF - WADATS(IMOD)%XTAUBBL = UNDEF + WADATS(IMOD)%XTAUBBLX = UNDEF + WADATS(IMOD)%XTAUBBLY = UNDEF ! IF ( OUTFLAGS( 8, 1) ) THEN ALLOCATE ( WADATS(IMOD)%XMSSX(NXXX), STAT=ISTAT ) @@ -2893,7 +2951,10 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) TAUWIY => WADATS(IMOD)%TAUWIY TAUWNX => WADATS(IMOD)%TAUWNX TAUWNY => WADATS(IMOD)%TAUWNY - WHITECAP => WADATS(IMOD)%WHITECAP + WCAP_COV => WADATS(IMOD)%WCAP_COV + WCAP_THK => WADATS(IMOD)%WCAP_THK + WCAP_BHS => WADATS(IMOD)%WCAP_BHS + WCAP_MNT => WADATS(IMOD)%WCAP_MNT ! SXX => WADATS(IMOD)%SXX SYY => WADATS(IMOD)%SYY @@ -2911,7 +2972,8 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) P2SMS => WADATS(IMOD)%P2SMS US3D => WADATS(IMOD)%US3D PHICE => WADATS(IMOD)%PHICE - TAUICE => WADATS(IMOD)%TAUICE + TAUICEX=> WADATS(IMOD)%TAUICEX + TAUICEY=> WADATS(IMOD)%TAUICEY USSP => WADATS(IMOD)%USSP TAUOCX => WADATS(IMOD)%TAUOCX TAUOCY => WADATS(IMOD)%TAUOCY @@ -2920,9 +2982,12 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) ABD => WADATS(IMOD)%ABD UBA => WADATS(IMOD)%UBA UBD => WADATS(IMOD)%UBD - BEDFORMS=> WADATS(IMOD)%BEDFORMS + BEDROUGH=> WADATS(IMOD)%BEDROUGH + BEDRIPX=> WADATS(IMOD)%BEDRIPX + BEDRIPY=> WADATS(IMOD)%BEDRIPY PHIBBL => WADATS(IMOD)%PHIBBL - TAUBBL => WADATS(IMOD)%TAUBBL + TAUBBLX=> WADATS(IMOD)%TAUBBLX + TAUBBLY=> WADATS(IMOD)%TAUBBLY ! MSSX => WADATS(IMOD)%MSSX MSSY => WADATS(IMOD)%MSSY @@ -3236,7 +3301,10 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) TAUWIY => WADATS(IMOD)%XTAUWIY TAUWNX => WADATS(IMOD)%XTAUWNX TAUWNY => WADATS(IMOD)%XTAUWNY - WHITECAP => WADATS(IMOD)%XWHITECAP + WCAP_COV => WADATS(IMOD)%XWCAP_COV + WCAP_THK => WADATS(IMOD)%XWCAP_THK + WCAP_BHS => WADATS(IMOD)%XWCAP_BHS + WCAP_MNT => WADATS(IMOD)%XWCAP_MNT ! SXX => WADATS(IMOD)%XSXX SYY => WADATS(IMOD)%XSYY @@ -3254,7 +3322,8 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) P2SMS => WADATS(IMOD)%XP2SMS US3D => WADATS(IMOD)%XUS3D PHICE => WADATS(IMOD)%XPHICE - TAUICE => WADATS(IMOD)%XTAUICE + TAUICEX=> WADATS(IMOD)%XTAUICEX + TAUICEY=> WADATS(IMOD)%XTAUICEY USSP => WADATS(IMOD)%XUSSP TAUOCX => WADATS(IMOD)%XTAUOCX TAUOCY => WADATS(IMOD)%XTAUOCY @@ -3262,9 +3331,12 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) ABD => WADATS(IMOD)%XABD UBA => WADATS(IMOD)%XUBA UBD => WADATS(IMOD)%XUBD - BEDFORMS=> WADATS(IMOD)%XBEDFORMS + BEDROUGH=> WADATS(IMOD)%XBEDROUGH + BEDRIPX=> WADATS(IMOD)%XBEDRIPX + BEDRIPY=> WADATS(IMOD)%XBEDRIPY PHIBBL => WADATS(IMOD)%XPHIBBL - TAUBBL => WADATS(IMOD)%XTAUBBL + TAUBBLX=> WADATS(IMOD)%XTAUBBLX + TAUBBLY=> WADATS(IMOD)%XTAUBBLY ! MSSX => WADATS(IMOD)%XMSSX MSSY => WADATS(IMOD)%XMSSY diff --git a/model/src/w3igcmmd.F90 b/model/src/w3igcmmd.F90 index 14b942760..8b411c12e 100644 --- a/model/src/w3igcmmd.F90 +++ b/model/src/w3igcmmd.F90 @@ -115,7 +115,7 @@ SUBROUTINE SND_FIELDS_TO_ICE() USE W3OACPMD, ONLY: ID_OASIS_TIME, IL_NB_SND, SND_FLD, CPL_OASIS_SND USE W3GDATMD, ONLY: NSEAL, NSEA USE W3WDATMD, ONLY: ICEF - USE W3ADATMD, ONLY: TAUICE + USE W3ADATMD, ONLY: TAUICEX, TAUICEY USE W3ODATMD, ONLY: UNDEF, NAPROC, IAPROC ! !/ ------------------------------------------------------------------- / @@ -148,13 +148,13 @@ SUBROUTINE SND_FIELDS_TO_ICE() CASE ('WW3_TWIX') TMP(1:NSEAL) = 0.0 - WHERE(TAUICE(1:NSEAL,1) /= UNDEF) TMP(1:NSEAL)=TAUICE(1:NSEAL,1) + WHERE(TAUICEX(1:NSEAL) /= UNDEF) TMP(1:NSEAL)=TAUICEX(1:NSEAL) RLA_OASIS_SND(:,1) = DBLE(TMP(1:NSEAL)) CALL CPL_OASIS_SND(IB_DO, ID_OASIS_TIME, RLA_OASIS_SND, LL_ACTION) CASE ('WW3_TWIY') TMP(1:NSEAL) = 0.0 - WHERE(TAUICE(1:NSEAL,2) /= UNDEF) TMP(1:NSEAL)=TAUICE(1:NSEAL,2) + WHERE(TAUICEY(1:NSEAL) /= UNDEF) TMP(1:NSEAL)=TAUICEY(1:NSEAL) RLA_OASIS_SND(:,1) = DBLE(TMP(1:NSEAL)) CALL CPL_OASIS_SND(IB_DO, ID_OASIS_TIME, RLA_OASIS_SND, LL_ACTION) diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 4badbcb1a..3c7e8f5c4 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -71,6 +71,9 @@ 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 ) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. C Bunney !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -2143,10 +2146,12 @@ SUBROUTINE W3MPIO ( IMOD ) TAUOY, USSX, USSY, MSSX, MSSY, MSSD, & MSCX, MSCY, MSCD, PRMS, TPMS, CHARN, & TWS, TAUWNX, TAUWNY, BHD, CGE, & - CFLXYMAX, CFLTHMAX, CFLKMAX, WHITECAP, & - BEDFORMS, PHIBBL, TAUBBL, T01, & + CFLXYMAX, CFLTHMAX, CFLKMAX, & + WCAP_COV, WCAP_THK, WCAP_BHS, WCAP_MNT, & + BEDROUGH, BEDRIPX, BEDRIPY, PHIBBL, & + TAUBBLX, TAUBBLY, T01, & P2SMS, US3D, EF, TH1M, STH1M, TH2M, & - STH2M, HSIG, PHICE, TAUICE, USSP, & + STH2M, HSIG, PHICE, TAUICEX, TAUICEY, USSP, & STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, & HCMAXD, QP, PTHP0, PQP, PPE, PGW, PSW, & PTM1, PT1, PT2, PEP, WBT, CX, CY, & @@ -2819,7 +2824,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (WHITECAP(1,1),NSEALM , MPI_REAL, IROOT,& + CALL MPI_SEND_INIT (WCAP_COV(1), NSEALM, MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/07', IROOT, IT, IRQGO(IH), IERR @@ -2829,7 +2834,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (WHITECAP(1,2),NSEALM , MPI_REAL, IROOT,& + CALL MPI_SEND_INIT (WCAP_THK(1), NSEALM, MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/08', IROOT, IT, IRQGO(IH), IERR @@ -2839,7 +2844,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (WHITECAP(1,3),NSEALM , MPI_REAL, IROOT,& + CALL MPI_SEND_INIT (WCAP_BHS(1), NSEALM, MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/09', IROOT, IT, IRQGO(IH), IERR @@ -2849,7 +2854,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (WHITECAP(1,4),NSEALM , MPI_REAL, IROOT,& + CALL MPI_SEND_INIT (WCAP_MNT(1), NSEALM, MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/10', IROOT, IT, IRQGO(IH), IERR @@ -3005,14 +3010,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 6,10) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (TAUICE (1,1),NSEALM , MPI_REAL, IROOT, & + CALL MPI_SEND_INIT (TAUICEX(1), NSEALM, MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IROOT, IT, IRQGO(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (TAUICE (1,2),NSEALM , MPI_REAL, IROOT, & + CALL MPI_SEND_INIT (TAUICEY(1), NSEALM, MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IROOT, IT, IRQGO(IH), IERR @@ -3095,21 +3100,21 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (BEDFORMS(1,1),NSEALM , MPI_REAL, & + CALL MPI_SEND_INIT (BEDROUGH(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IROOT, IT, IRQGO(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (BEDFORMS(1,2),NSEALM , MPI_REAL, & + CALL MPI_SEND_INIT (BEDRIPX(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IROOT, IT, IRQGO(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (BEDFORMS(1,3),NSEALM , MPI_REAL, & + CALL MPI_SEND_INIT (BEDRIPY(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IROOT, IT, IRQGO(IH), IERR @@ -3129,14 +3134,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (TAUBBL(1,1),NSEALM , MPI_REAL, & + CALL MPI_SEND_INIT (TAUBBLX(1), NSEALM ,MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IROOT, IT, IRQGO(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (TAUBBL(1,2),NSEALM , MPI_REAL, & + CALL MPI_SEND_INIT (TAUBBLY(1), NSEALM ,MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQGO(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IROOT, IT, IRQGO(IH), IERR @@ -3888,7 +3893,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5, 7) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (WHITECAP(I0,1),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (WCAP_COV(I0),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/07', IFROM, IT, IRQGO2(IH), IERR @@ -3898,7 +3903,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5, 8) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (WHITECAP(I0,2),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (WCAP_THK(I0),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/08', IFROM, IT, IRQGO2(IH), IERR @@ -3908,7 +3913,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5, 9) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (WHITECAP(I0,3),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (WCAP_BHS(I0),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/09', IFROM, IT, IRQGO2(IH), IERR @@ -3918,7 +3923,7 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 5,10) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (WHITECAP(I0,4),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (WCAP_MNT(I0),1,WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 5/10', IFROM, IT, IRQGO2(IH), IERR @@ -4074,14 +4079,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 6,10) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (TAUICE (I0,1),1,WW3_FIELD_VEC, IFROM, IT, & + CALL MPI_RECV_INIT (TAUICEX(I0), 1, WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IFROM, IT, IRQGO2(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (TAUICE (I0,2),1,WW3_FIELD_VEC, IFROM, IT, & + CALL MPI_RECV_INIT (TAUICEY(I0), 1, WW3_FIELD_VEC, IFROM, IT, & MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/10', IFROM, IT, IRQGO2(IH), IERR @@ -4164,21 +4169,21 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 7, 3) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (BEDFORMS(I0,1),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (BEDROUGH(I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IFROM, IT, IRQGO2(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (BEDFORMS(I0,2),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (BEDRIPX(I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IFROM, IT, IRQGO2(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (BEDFORMS(I0,3),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (BEDRIPY(I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/03', IFROM, IT, IRQGO2(IH), IERR @@ -4198,14 +4203,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLGRDALL( 7, 5) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (TAUBBL(I0,1),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (TAUBBLX(I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IFROM, IT, IRQGO2(IH), IERR #endif IH = IH + 1 IT = IT + 1 - CALL MPI_RECV_INIT (TAUBBL(I0,2),1,WW3_FIELD_VEC, IFROM, & + CALL MPI_RECV_INIT (TAUBBLY(I0), 1, WW3_FIELD_VEC, IFROM, & IT, MPI_COMM_WAVE, IRQGO2(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 7/05', IFROM, IT, IRQGO2(IH), IERR @@ -4687,14 +4692,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLOGRR( 6,10) ) THEN IH = IH + 1 IT = IT0 + 26 - CALL MPI_SEND_INIT (TAUICE(1,1), NSEALM, MPI_REAL, & + CALL MPI_SEND_INIT (TAUICEX(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S I1', IROOT, IT, IRQRS(IH), IERR #endif IH = IH + 1 IT = IT0 + 27 - CALL MPI_SEND_INIT (TAUICE(1,2), NSEALM, MPI_REAL, & + CALL MPI_SEND_INIT (TAUICEY(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S I2', IROOT, IT, IRQRS(IH), IERR @@ -4748,14 +4753,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLOGRR( 7, 5) ) THEN IH = IH + 1 IT = IT0 + 33 - CALL MPI_SEND_INIT (TAUBBL(1,1), NSEALM, MPI_REAL, & + CALL MPI_SEND_INIT (TAUBBLX(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S T1', IROOT, IT, IRQRS(IH), IERR #endif IH = IH + 1 IT = IT0 + 34 - CALL MPI_SEND_INIT (TAUBBL(1,2), NSEALM, MPI_REAL, & + CALL MPI_SEND_INIT (TAUBBLY(1), NSEALM, MPI_REAL, & IROOT, IT, MPI_COMM_WAVE, IRQRS(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'S T2', IROOT, IT, IRQRS(IH), IERR @@ -4976,14 +4981,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLOGRR( 6,10) ) THEN IH = IH + 1 IT = IT0 + 26 - CALL MPI_RECV_INIT (TAUICE(I0,1),1,WW3_FIELD_VEC,& + CALL MPI_RECV_INIT (TAUICEX(I0), 1, WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R I1', IFROM, IT, IRQRS(IH), IERR #endif IH = IH + 1 IT = IT0 + 27 - CALL MPI_RECV_INIT (TAUICE(I0,2),1,WW3_FIELD_VEC,& + CALL MPI_RECV_INIT (TAUICEY(I0), 1, WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R I2', IFROM, IT, IRQRS(IH), IERR @@ -5037,14 +5042,14 @@ SUBROUTINE W3MPIO ( IMOD ) IF ( FLOGRR( 7, 5) ) THEN IH = IH + 1 IT = IT0 + 33 - CALL MPI_RECV_INIT (TAUBBL(I0,1),1,WW3_FIELD_VEC,& + CALL MPI_RECV_INIT (TAUBBLX(I0), 1, WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R T1', IFROM, IT, IRQRS(IH), IERR #endif IH = IH + 1 IT = IT0 + 34 - CALL MPI_RECV_INIT (TAUBBL(I0,2),1,WW3_FIELD_VEC,& + CALL MPI_RECV_INIT (TAUBBLY(I0), 1, WW3_FIELD_VEC,& IFROM, IT, MPI_COMM_WAVE, IRQRS(IH), IERR ) #ifdef W3_MPIT WRITE (NDST,9021) IH, 'R T2', IFROM, IT, IRQRS(IH), IERR diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index de660ded4..d1deedcff 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -74,6 +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) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. C Bunney !/ 02-Mar-2024 : Add skweness and EM bias varaible ( version 7.xx ) !/ !/ Copyright 2009-2024 National Weather Service (NWS), @@ -2519,17 +2522,20 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & USE W3ADATMD, ONLY: HS, WLM, T02, T0M1, T01, FP0, THM, THS, THP0,& WBT, WNMEAN USE W3ADATMD, ONLY: DTDYN, FCUT, ABA, ABD, UBA, UBD, SXX, SYY, SXY,& - PHS, PTP, PLP, PDIR, PSI, PWS, PWST, PNR, & - PTHP0, PQP, PPE, PGW, PSW, PTM1, PT1, PT2, & - PEP, USERO, TAUOX, TAUOY, TAUWIX, TAUWIY, & - PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS, & - USSX, USSY, MSSX, MSSY, MSSD, MSCX, MSCY, & - MSCD, QP, TAUWNX, TAUWNY, CHARN, TWS, BHD, & - PHIBBL, TAUBBL, WHITECAP, BEDFORMS, CGE, EF, & - CFLXYMAX, CFLTHMAX, CFLKMAX, P2SMS, US3D, & - TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, TAUICE,& - STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& - USSP, TAUOCX, TAUOCY, QKK, SKEW, EMBIA1, EMBIA2 + PHS, PTP, PLP, PDIR, PSI, PWS, PWST, PNR, & + PTHP0, PQP, PPE, PGW, PSW, PTM1, PT1, PT2, & + PEP, USERO, TAUOX, TAUOY, TAUWIX, TAUWIY, & + PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS, & + USSX, USSY, MSSX, MSSY, MSSD, MSCX, MSCY, & + MSCD, QP, TAUWNX, TAUWNY, CHARN, TWS, BHD, & + PHIBBL, TAUBBLX, TAUBBLY, & + WCAP_COV, WCAP_THK, WCAP_BHS, WCAP_MNT, & + BEDROUGH, BEDRIPX, BEDRIPY, CGE, EF, & + CFLXYMAX, CFLTHMAX, CFLKMAX, P2SMS, US3D, & + TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, & + TAUICEX, TAUICEY, STMAXE, STMAXD, HMAXE, & + HCMAXE, HMAXD, HCMAXD, USSP, TAUOCX, TAUOCY, & + QKK, SKEW, EMBIA1, EMBIA2 !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & @@ -2877,10 +2883,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & TAUWNX(ISEA) = UNDEF TAUWNY(ISEA) = UNDEF END IF - IF ( FLOGRD( 5, 7) ) WHITECAP(ISEA,1) = UNDEF - IF ( FLOGRD( 5, 8) ) WHITECAP(ISEA,2) = UNDEF - IF ( FLOGRD( 5, 9) ) WHITECAP(ISEA,3) = UNDEF - IF ( FLOGRD( 5,10) ) WHITECAP(ISEA,4) = UNDEF + IF ( FLOGRD( 5, 7) ) WCAP_COV(ISEA) = UNDEF + IF ( FLOGRD( 5, 8) ) WCAP_THK(ISEA) = UNDEF + IF ( FLOGRD( 5, 9) ) WCAP_BHS(ISEA) = UNDEF + IF ( FLOGRD( 5,10) ) WCAP_MNT(ISEA) = UNDEF ! IF ( FLOGRD( 6, 1) ) THEN SXX (ISEA) = UNDEF @@ -2907,7 +2913,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & END IF IF ( FLOGRD( 6, 8) ) US3D(ISEA,:) = UNDEF IF ( FLOGRD( 6, 9) ) P2SMS(ISEA,:) = UNDEF - IF ( FLOGRD( 6, 10) ) TAUICE(ISEA,:) = UNDEF + IF ( FLOGRD( 6, 10) ) THEN + TAUICEX(ISEA) = UNDEF + TAUICEY(ISEA) = UNDEF + END IF IF ( FLOGRD( 6, 11) ) PHICE(ISEA) = UNDEF IF ( FLOGRD( 6, 12) ) USSP(ISEA,:) = UNDEF IF ( FLOGRD( 6, 13) ) THEN @@ -2923,9 +2932,16 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & UBA (ISEA) = UNDEF UBD (ISEA) = UNDEF END IF - IF ( FLOGRD( 7, 3) ) BEDFORMS(ISEA,:) = UNDEF + IF ( FLOGRD( 7, 3) ) THEN + BEDROUGH(ISEA) = UNDEF + BEDRIPY(ISEA) = UNDEF + BEDRIPY(ISEA) = UNDEF + END IF IF ( FLOGRD( 7, 4) ) PHIBBL(ISEA) = UNDEF - IF ( FLOGRD( 7, 5) ) TAUBBL(ISEA,:) = UNDEF + IF ( FLOGRD( 7, 5) ) THEN + TAUBBLX(ISEA) = UNDEF + TAUBBLY(ISEA) = UNDEF + END IF ! IF ( FLOGRD( 8, 1) ) THEN MSSX (ISEA) = UNDEF @@ -2962,10 +2978,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & TAUWNX(ISEA) = UNDEF TAUWNY(ISEA) = UNDEF END IF - IF ( FLOGRD( 5, 7) ) WHITECAP(ISEA,1) = UNDEF - IF ( FLOGRD( 5, 8) ) WHITECAP(ISEA,2) = UNDEF - IF ( FLOGRD( 5, 9) ) WHITECAP(ISEA,3) = UNDEF - IF ( FLOGRD( 5,10) ) WHITECAP(ISEA,4) = UNDEF + IF ( FLOGRD( 5, 7) ) WCAP_COV(ISEA) = UNDEF + IF ( FLOGRD( 5, 8) ) WCAP_THK(ISEA) = UNDEF + IF ( FLOGRD( 5, 9) ) WCAP_BHS(ISEA) = UNDEF + IF ( FLOGRD( 5,10) ) WCAP_MNT(ISEA) = UNDEF ! IF ( FLOGRD( 6, 2) )THEN TAUOX (ISEA) = UNDEF @@ -2973,9 +2989,16 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & END IF IF ( FLOGRD( 6, 4) ) PHIOC (ISEA) = UNDEF ! - IF ( FLOGRD( 7, 3) ) BEDFORMS(ISEA,:) = UNDEF + IF ( FLOGRD( 7, 3) ) THEN + BEDROUGH(ISEA) = UNDEF + BEDRIPX(ISEA) = UNDEF + BEDRIPY(ISEA) = UNDEF + END IF IF ( FLOGRD( 7, 4) ) PHIBBL(ISEA) = UNDEF - IF ( FLOGRD( 7, 5) ) TAUBBL(ISEA,:) = UNDEF + IF ( FLOGRD( 7, 5) ) THEN + TAUBBLX(ISEA) = UNDEF + TAUBBLY(ISEA) = UNDEF + END IF ! END IF ! @@ -3391,24 +3414,24 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & WRITE ( NDSOA,* ) 'TAUWNY:', TAUWNY(1:NSEA) #endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN - WRITE ( NDSOG ) WHITECAP(1:NSEA,1) + WRITE ( NDSOG ) WCAP_COV(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'WHITECAP(1):', WHITECAP(1:NSEA,1) + WRITE ( NDSOA,* ) 'WCAP_COV:', WCAP_COV(1:NSEA) #endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN - WRITE ( NDSOG ) WHITECAP(1:NSEA,2) + WRITE ( NDSOG ) WCAP_THK(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'WHITECAP(2):', WHITECAP(1:NSEA,2) + WRITE ( NDSOA,* ) 'WCAP_THK:', WCAP_THK(1:NSEA) #endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN - WRITE ( NDSOG ) WHITECAP(1:NSEA,3) + WRITE ( NDSOG ) WCAP_BHS(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'WHITECAP(3):', WHITECAP(1:NSEA,3) + WRITE ( NDSOA,* ) 'WCAP_BHS:', WCAP_BHS(1:NSEA) #endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN - WRITE ( NDSOG ) WHITECAP(1:NSEA,4) + WRITE ( NDSOG ) WCAP_MNT(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'WHITECAP(4):', WHITECAP(1:NSEA,4) + WRITE ( NDSOA,* ) 'WCAP_MNT:', WCAP_MNT(1:NSEA) #endif ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) TWS(1:NSEA) @@ -3492,13 +3515,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & 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) + WRITE ( NDSOG ) TAUICEX(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'TAUICE(1):', TAUICE(1:NSEA,1) + WRITE ( NDSOA,* ) 'TAUICEX:', TAUICEX(1:NSEA) #endif - WRITE ( NDSOG ) TAUICE(1:NSEA,2) + WRITE ( NDSOG ) TAUICEY(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'TAUICE(2):', TAUICE(1:NSEA,2) + WRITE ( NDSOA,* ) 'TAUICEY:', TAUICEY(1:NSEA) #endif ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) PHICE(1:NSEA) @@ -3567,17 +3590,17 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & ! 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) + WRITE ( NDSOG ) BEDROUGH(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'BEDFORMS(1):', BEDFORMS(1:NSEA,1) + WRITE ( NDSOA,* ) 'BEDROUGH:', BEDROUGH(1:NSEA) #endif - WRITE ( NDSOG ) BEDFORMS(1:NSEA,2) + WRITE ( NDSOG ) BEDRIPX(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'BEDFORMS(2):', BEDFORMS(1:NSEA,2) + WRITE ( NDSOA,* ) 'BEDRIPX:', BEDRIPX(1:NSEA) #endif - WRITE ( NDSOG ) BEDFORMS(1:NSEA,3) + WRITE ( NDSOG ) BEDRIPY(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'BEDFORMS(3):', BEDFORMS(1:NSEA,3) + WRITE ( NDSOA,* ) 'BEDRIPY:', BEDRIPY(1:NSEA) #endif ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN WRITE ( NDSOG ) PHIBBL(1:NSEA) @@ -3585,13 +3608,13 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & WRITE ( NDSOA,* ) 'PHIBBL:', PHIBBL(1:NSEA) #endif ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 5 ) THEN - WRITE ( NDSOG ) TAUBBL(1:NSEA,1) + WRITE ( NDSOG ) TAUBBLX(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'TAUBBL(1):', TAUBBL(1:NSEA,1) + WRITE ( NDSOA,* ) 'TAUBBLX:', TAUBBLX(1:NSEA) #endif - WRITE ( NDSOG ) TAUBBL(1:NSEA,2) + WRITE ( NDSOG ) TAUBBLY(1:NSEA) #ifdef W3_ASCII - WRITE ( NDSOA,* ) 'TAUBBL(2):', TAUBBL(1:NSEA,2) + WRITE ( NDSOA,* ) 'TAUBBLY:', TAUBBLY(1:NSEA) #endif ! ! Section 8) @@ -3881,16 +3904,16 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & 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) + WCAP_COV(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,2) + WCAP_THK(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,3) + WCAP_BHS(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - WHITECAP(1:NSEA,4) + WCAP_MNT(1:NSEA) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & TWS(1:NSEA) @@ -3937,9 +3960,9 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & 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) + TAUICEX(1:NSEA) READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUICE(1:NSEA,2) + TAUICEY(1:NSEA) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & PHICE(1:NSEA) @@ -3965,19 +3988,19 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD & READ (NDSOG,END=801,ERR=802,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) + BEDROUGH(1:NSEA) READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - BEDFORMS(1:NSEA,2) + BEDRIPX(1:NSEA) READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - BEDFORMS(1:NSEA,3) + BEDRIPY(1:NSEA) ELSE IF ( IFI .EQ. 7 .AND. IFJ .EQ. 4 ) THEN READ (NDSOG,END=801,ERR=802,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) + TAUBBLX(1:NSEA) READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & - TAUBBL(1:NSEA,2) + TAUBBLY(1:NSEA) ! ! Section 8) ! diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 5253a66ab..3db2e8a14 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -295,8 +295,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3ADATMD, ONLY: W3SETA, W3XETA, NSEALM USE W3ADATMD, ONLY: CX, CY, HS, WLM, T0M1, T01, FP0, THM, CHARN,& TAUWIX, TAUWIY, TWS, TAUOX, TAUOY, BHD, & - PHIOC, TUSX, TUSY, USSX, USSY, TAUICE, & - UBA, UBD, PHIBBL, TAUBBL, TAUOCX, TAUOCY, & + PHIOC, TUSX, TUSY, USSX, USSY, TAUICEX, TAUICEY, & + UBA, UBD, PHIBBL, TAUBBLX, TAUBBLY, TAUOCX, TAUOCY, & WNMEAN !/ USE W3GDATMD, ONLY: NX, NY, NSEA, NSEAL, NSPEC, MAPSTA, MAPST2, & @@ -989,8 +989,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITE(NDSR,ERR=803,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,ERR=803,IOSTAT=IERR) TAUICEX(1:NSEA) + WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUICEY(1:NSEA) ENDIF IF ( FLOGRR(6,13) ) THEN WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOCX(1:NSEA) @@ -1003,8 +1003,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) IF ( FLOGRR(7,4) ) & WRITE(NDSR,ERR=803,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,ERR=803,IOSTAT=IERR) TAUBBLX(1:NSEA) + WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUBBLY(1:NSEA) ENDIF ! #ifdef W3_MPI @@ -1248,8 +1248,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN - TAUICE(I,1) = TMP(J) - TAUICE(I,2) = TMP2(J) + TAUICEX(I) = TMP(J) + TAUICEY(I) = TMP2(J) ENDIF ENDDO ENDIF @@ -1288,8 +1288,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) DO I=1, NSEALM J = IAPROC + (I-1)*NAPROC IF (J .LE. NSEA) THEN - TAUBBL(I,1) = TMP(J) - TAUBBL(I,2) = TMP2(J) + TAUBBLX(I) = TMP(J) + TAUBBLY(I) = TMP2(J) ENDIF ENDDO ENDIF @@ -1342,11 +1342,13 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USSY = 0. TAUOCX = 0. TAUOCY = 0. - TAUICE = 0. + TAUICEX = 0. + TAUICEY = 0. UBA = 0. UBD = 0. PHIBBL = 0. - TAUBBL = 0. + TAUBBLX = 0. + TAUBBLY = 0. ENDIF #ifdef W3_T WRITE (NDST,9008) diff --git a/model/src/w3ogcmmd.F90 b/model/src/w3ogcmmd.F90 index 64b10bad4..ec79a6f72 100644 --- a/model/src/w3ogcmmd.F90 +++ b/model/src/w3ogcmmd.F90 @@ -112,7 +112,7 @@ SUBROUTINE SND_FIELDS_TO_OCEAN() USE W3GDATMD, ONLY: NSEAL, MAPSTA, MAPSF USE W3ADATMD, ONLY: HS, T0M1, T01, THM, BHD, TAUOX, TAUOY, PHIOC,& UBA, UBD, TAUWIX, TAUWIY, TUSX, TUSY, USSX, & - USSY, WLM, PHIBBL,TAUBBL, CHARN, TAUOCX, & + USSY, WLM, PHIBBL, TAUBBLX, TAUBBLY, CHARN, TAUOCX, & TAUOCY, WNMEAN USE W3ODATMD, ONLY: NAPROC, IAPROC, UNDEF USE CONSTANTS, ONLY: PI, DERA @@ -286,7 +286,7 @@ SUBROUTINE SND_FIELDS_TO_OCEAN() ! --------------------------------------------------------------------- IF (SND_FLD(IB_DO)%CL_FIELD_NAME == 'WW3_TBBX') THEN TMP(1:NSEAL) = 0.0 - WHERE(TAUBBL(1:NSEAL,1) /= UNDEF) TMP(1:NSEAL)=TAUBBL(1:NSEAL,1) + WHERE(TAUBBLX(1:NSEAL) /= UNDEF) TMP(1:NSEAL)=TAUBBLX(1:NSEAL) RLA_OASIS_SND(:,1) = DBLE(TMP(1:NSEAL)) CALL CPL_OASIS_SND(IB_DO, ID_OASIS_TIME, RLA_OASIS_SND, LL_ACTION) ENDIF @@ -295,7 +295,7 @@ SUBROUTINE SND_FIELDS_TO_OCEAN() ! --------------------------------------------------------------------- IF (SND_FLD(IB_DO)%CL_FIELD_NAME == 'WW3_TBBY') THEN TMP(1:NSEAL) = 0.0 - WHERE(TAUBBL(1:NSEAL,2) /= UNDEF) TMP(1:NSEAL)=TAUBBL(1:NSEAL,2) + WHERE(TAUBBLY(1:NSEAL) /= UNDEF) TMP(1:NSEAL)=TAUBBLY(1:NSEAL) RLA_OASIS_SND(:,1) = DBLE(TMP(1:NSEAL)) CALL CPL_OASIS_SND(IB_DO, ID_OASIS_TIME, RLA_OASIS_SND, LL_ACTION) ENDIF diff --git a/model/src/w3sbt4md.F90 b/model/src/w3sbt4md.F90 index 1d0e3a8d7..ae2eec1ef 100644 --- a/model/src/w3sbt4md.F90 +++ b/model/src/w3sbt4md.F90 @@ -36,6 +36,7 @@ MODULE W3SBT4MD !/ inclusion in WAVEWATCH III. !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) !/ 14-Mar-2012 : Preparing distribution version. ( version 4.05 ) + !/ 03-Nov-2023 : Split TAUBBL into two separate vars ( version 7.13 ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -320,24 +321,26 @@ END SUBROUTINE TABU_ERF !> 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. + !> @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[XY] Components of stress leaking to the bottom. + !> @param[inout] BEDROUGH Bed roughness + !> @param[inout] BEDRIP[XY] Bed ripple 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 ) + SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBLX, TAUBBLY, & + BEDROUGH, BEDRIPX, BEDRIPY, S, D, IX, IY ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -350,6 +353,7 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) !/ 23-Jun-2011 : Origination. ( version 4.04 ) !/ 04-Jul-2011 : Adding momentum flux TAUBBL ( version 4.05 ) !/ 15-Mar-2012 : Adding subgrid treatment for depth ( version 4.05 ) + !/ 03-Nov-2023 : Split TAUBBL into TUABBL[X,Y] ( version 7.14 ) !/ ! 1. Purpose : ! @@ -371,7 +375,7 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) ! D50 Real I Median grain size. ! PSIC Real I Critical Shields parameter ! BEFORMS Real I/O Ripple parameters (roughness and wavelength). - ! TAUBBL Real O Components of stress leaking to the bottom. + ! TAUBBL[XY] Real O Components of stress leaking to the bottom. ! S R.A. O Source term (1-D version). ! D R.A. O Diagonal term of derivative. *) ! IX,IY Int. I Spatial grid indices @@ -437,8 +441,8 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC), D50 REAL, INTENT(IN) :: PSIC INTEGER, INTENT(IN) :: IX, IY - REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC), TAUBBL(2) - REAL, INTENT(INOUT) :: BEDFORM(3) + REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC), TAUBBLX, TAUBBLY + REAL, INTENT(INOUT) :: BEDROUGH, BEDRIPX, BEDRIPY REAL :: CBETA(NK) REAL :: UORB2,UORB,AORB, EBX, EBY, AX, AY, LX, LY REAL :: CONST2, TEMP2 @@ -481,7 +485,8 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) ! 2. Subgrid loop ! DSUM(:)=0. - TAUBBL(:)=0. + TAUBBLX=0. + TAUBBLY=0. ! DO ISUB=1,3 ! @@ -564,16 +569,16 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) ! Sheet flow roughness, see Wilson (1989) KSUBS=AORB*0.0655*(UORB2/((SED_SG-1)*GRAV*AORB))**1.4 KSUBN = KSUBR + KSUBS - BEDFORM(2)=LX - BEDFORM(3)=LY + BEDRIPX=LX + BEDRIPY=LY ELSE ! relict roughness, see Ardhuin et al. (2003) KSUBN=MAX(BACKGROUND,AORB*SBTCX(4)) - BEDFORM(2)=-LX - BEDFORM(3)=-LY + BEDRIPX=-LX + BEDRIPY=-LY END IF - BEDFORM(1)=KSUBN + BEDROUGH=KSUBN ELSE ! @@ -595,15 +600,15 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) 0.0655*(UORB2/((SED_SG-1)*GRAV*AORB))**1.4) ! IF (PROBA2.GT.0.5) THEN - BEDFORM(2)=LX - BEDFORM(3)=LY + BEDRIPX=LX + BEDRIPY=LY ELSE - BEDFORM(2)=-LX - BEDFORM(3)=-LY + BEDRIPX=-LX + BEDRIPY=-LY END IF ! END IF - BEDFORM(1)=KSUBN + BEDROUGH=KSUBN ! ! 2.c second use of FWTABLE to get FW from the full roughness @@ -624,8 +629,8 @@ SUBROUTINE W3SBT4 (A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY ) IS=ITH+(IK-1)*NTH D(IS)=DSUM(IK) TEMP2=CONST2*D(IS)*A(IS) - TAUBBL(1) = TAUBBL(1) - TEMP2*ECOS(IS) - TAUBBL(2) = TAUBBL(2) - TEMP2*ESIN(IS) + TAUBBLX = TAUBBLX - TEMP2 * ECOS(IS) + TAUBBLY = TAUBBLY - TEMP2 * ESIN(IS) S(IS)=D(IS)*A(IS) END DO END DO diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index dcf1e5808..ef531e130 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -40,6 +40,9 @@ MODULE W3SRC4MD !/ 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 ) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. C Bunney !/ ! 1. Purpose : ! @@ -2021,7 +2024,9 @@ END SUBROUTINE CALC_USTAR !> @param[in] IX Grid Index. !> @param[in] IY Grid Index. !> @param[out] BRLAMBDA Phillips' Lambdas. - !> @param[out] WHITECAP + !> @param[out] WCAP_COV Whitecap coverage. + !> @param[out] WCAP_THK Whitecap thickness. + !> @param[out] WCAP_MNT Whitecap moment. !> @param[in] DLWMEAN !> !> @author F. Ardhuin @@ -2030,7 +2035,7 @@ END SUBROUTINE CALC_USTAR !> @date 13-Aug-2021 !> SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & - DDIAG, IX, IY, BRLAMBDA, WHITECAP, DLWMEAN ) + DDIAG, IX, IY, BRLAMBDA, WCAP_COV, WCAP_THK, WCAP_MNT, DLWMEAN ) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -2141,7 +2146,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & REAL, INTENT(IN) :: A(NSPEC), K(NK), CG(NK), & DEPTH, DAIR, USTAR, USDIR, DLWMEAN REAL, INTENT(OUT) :: SRHS(NSPEC), DDIAG(NSPEC), BRLAMBDA(NSPEC) - REAL, INTENT(OUT) :: WHITECAP(1:4) + REAL, INTENT(OUT) :: WCAP_COV, WCAP_THK, WCAP_MNT !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -2578,7 +2583,9 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & RETURN END IF ! - WHITECAP(1:4) = 0. + WCAP_COV = 0. + WCAP_THK = 0. + WCAP_MNT = 0. ! ! precomputes integration of Lambda over direction ! times wavelength times a (a=5 in Reul&Chapron JGR 2003) times dk @@ -2607,8 +2614,8 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! Computes the Total WhiteCap Coverage (a=5. ; Reul and Chapron, 2003) ! DO IK=IK1,MIN(FLOOR(AAIRCMIN),NK) - WHITECAP(1) = WHITECAP(1) + COEF4(IK) * (1-WHITECAP(1)) - WHITECAP(4) = WHITECAP(4) + COEF5(IK) + WCAP_COV = WCAP_COV + COEF4(IK) * (1-WCAP_COV) + WCAP_MNT = WCAP_MNT + COEF5(IK) END DO END IF !/ @@ -2638,7 +2645,7 @@ SUBROUTINE W3SDS4 (A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, & ! ! Computes foam-layer thickness (Reul and Chapron, 2003) ! - WHITECAP(2) = WHITECAP(2) + COEF4(IK) * MFT + WCAP_THK = WCAP_THK + COEF4(IK) * MFT END DO END IF ! diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index e90ba88eb..50fceae4a 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -28,7 +28,7 @@ MODULE W3SRCEMD !/ | H. L. Tolman | !/ | F. Ardhuin | !/ | FORTRAN 90 | - !/ | Last update : 22-Mar-2021 | + !/ | Last update : 03-Nov-2023 | !/ +-----------------------------------+ !/ !/ For updates see subroutine. @@ -67,8 +67,45 @@ MODULE W3SRCEMD !/ ------------------------------------------------------------------- / !/ REAL, PARAMETER, PRIVATE:: OFFSET = 1. + + ! GPU Refactor - user settable tile size for controlling chunking of + ! seapoint loop in W3SRCE. To minimize memory usage and reduce cache misses + ! when running solely on the CPU (including MPI), set to 1. + ! For running on a GPU, set to a number large enough to populate all your + ! available GPU threads (e.g. on a nVidia V100 this would be 5000 - 10000). + ! This can be set via the runtime environment variable WW3_SRC_TILE_SIZE + ! and defaults to 1. + INTEGER :: CHUNKSIZE = 1 !/ CONTAINS + + !> + !> @brief Initialise some variables at startup + !> + !> At the moment, just reads WW3_SRC_TILE_SIZE environment variable + !> if it exists to control the tile sized used for the source term + !> module. Defaults to tile size = 1. + !> + !> @author C. Bunney + !> @date 12-Oct-2023 + SUBROUTINE W3SRCE_INIT() + USE W3ODATMD, ONLY: NDSE, NDSO + + IMPLICIT NONE + CHARACTER(LEN=16) :: VAL + INTEGER :: STAT + CALL get_environment_variable("WW3_SRC_TILE_SIZE", VALUE=VAL, STATUS=STAT) + IF(STAT .EQ. 0) THEN + READ(VAL,*,IOSTAT=STAT) CHUNKSIZE + IF(STAT .NE. 0) THEN + WRITE(NDSE,*) "Error ",STAT, " parsing value for WW3_SRC_TILE_SIZE: ", TRIM(VAL) + WRITE(NDSE,*) "Will default to size of 1" + ELSE + WRITE(NDSO,*) "Source term tile size set to: ", CHUNKSIZE + ENDIF + ENDIF + END SUBROUTINE W3SRCE_INIT + !/ ------------------------------------------------------------------- / !> @@ -115,16 +152,12 @@ MODULE W3SRCEMD !> !> @param[in] srce_call !> @param[in] IT - !> @param[in] ISEA - !> @param[in] JSEA - !> @param[in] IX Discrete grid point counters. - !> @param[in] IY Discrete grid point counters. !> @param[in] IMOD Model number. - !> @param[in] SPECOLD + !> @param[in] SPECOLD (REMOVED) !> @param[inout] SPEC Spectrum (action) in 1-D form. - !> @param[out] VSIO - !> @param[out] VDIO - !> @param[out] SHAVEIO + !> @param[out] VSIO (Optional) + !> @param[out] VDIO (Optional) + !> @param[out] SHAVEIO (Optional) !> @param[inout] ALPHA Nondimensional 1-D spectrum corresponding !> to above full spectra (Phillip's const.). !> @param[inout] WN1 Discrete wavenumbers. @@ -146,9 +179,6 @@ MODULE W3SRCEMD !> @param[in] ICEDMAX Sea ice maximum floe diameter !> @param[in] REFLEC Reflection coefficients. !> @param[in] REFLED Reflection direction. - !> @param[in] DELX Grid cell size in X direction. - !> @param[in] DELY Grid cell size in Y direction. - !> @param[in] DELA Grid cell area. !> @param[in] TRNX Grid transparency in X. !> @param[in] TRNY Grid transparency in Y. !> @param[in] BERG Iceberg damping coefficient. @@ -156,8 +186,8 @@ MODULE W3SRCEMD !> @param[out] DTDYN Average dynamic time step. !> @param[out] FCUT Cut-off frequency for tail. !> @param[in] DTG Global time step. - !> @param[inout] TAUWX - !> @param[inout] TAUWY + !> @param[inout] TAUWX(JSEA) + !> @param[inout] TAUWY(JSEA) !> @param[inout] TAUOX !> @param[inout] TAUWIX !> @param[inout] TAUWIY @@ -167,13 +197,20 @@ MODULE W3SRCEMD !> @param[inout] CHARN !> @param[inout] TWS !> @param[inout] PHIOC - !> @param[inout] WHITECAP Whitecap statistics. + !> @param[inout] WCAP_COV Whitecap coverage + !> @param[inout] WCAP_THK Whitecap foam thickness + !> @param[inout] WCAP_BHS Whitecap breaking sig wave height + !> @param[inout] WCAP_MNT Whitecap moment !> @param[in] D50 Sand grain size. !> @param[in] PSIC Critical shields. - !> @param[inout] BEDFORM Bedform parameters. + !> @param[inout] BEDROUGH Bedform roughness + !> @param[inout] BEDRIPX Bedform ripple wavelength (x) + !> @param[inout] BEDRIPY Bedform ripple wavelength (y) !> @param[inout] PHIBBL Energy flux to BBL. - !> @param[inout] TAUBBL Momentum flux to BBL. - !> @param[inout] TAUICE Momentum flux to sea ice. + !> @param[inout] TAUBBLX X-momentum flux to BBL. + !> @param[inout] TAUBBLY Y-momentum flux to BBL. + !> @param[inout] TAUICEX X-momentum flux to sea ice. + !> @param[inout] TAUICEY Y-momentum flux to sea ice. !> @param[inout] PHICE Energy flux to sea ice. !> @param[inout] TAUOCX Total ocean momentum component. !> @param[inout] TAUOCY Total ocean momentum component. @@ -187,21 +224,30 @@ MODULE W3SRCEMD !> @author M. Dutour Sikiric !> @date 22-Mar-2021 !> - SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & - SPECOLD, SPEC, VSIO, VDIO, SHAVEIO, & + SUBROUTINE W3SRCE ( srce_call, IT, IMOD, & +!! SPECOLD, SPEC, VSIO, VDIO, SHAVEIO, & ! SPECOLD not used (removed) VSIO,VDIO,SHAVIO made optional + SPEC, & ALPHA, WN1, CG1, CLATSL, & D_INP, U10ABS, U10DIR, & #ifdef W3_FLX5 TAUA, TAUADIR, & #endif AS, USTAR, USTDIR, & - CX, CY, ICE, ICEH, ICEF, ICEDMAX, & - REFLEC, REFLED, DELX, DELY, DELA, TRNX, & - TRNY, BERG, FPI, DTDYN, FCUT, DTG, TAUWX, & + CX, CY, ICE, ICEH, ICEF, ICEDMAX, & +#ifdef W3_REF1 + REFLEC, REFLED, TRNX, TRNY, BERG, & +#endif + FPI, DTDYN, FCUT, DTG, TAUWX, & TAUWY, TAUOX, TAUOY, TAUWIX, TAUWIY, TAUWNX,& - TAUWNY, PHIAW, CHARN, TWS, PHIOC, WHITECAP, & - D50, PSIC, BEDFORM , PHIBBL, TAUBBL, TAUICE,& - PHICE, TAUOCX, TAUOCY, WNMEAN, DAIR, COEF) + TAUWNY, PHIAW, CHARN, TWS, PHIOC, & + WCAP_COV, WCAP_THK, WCAP_BHS, WCAP_MNT, & +#ifdef W3_BT4 + D50, PSIC, BEDROUGH, BEDRIPX, BEDRIPY, & +#endif + PHIBBL, TAUBBLX, TAUBBLY, & + TAUICEX, TAUICEY, & + PHICE, TAUOCX, TAUOCY, WNMEAN, DAIR, COEF, & + VSIO, VDIO, SHAVEIO) ! These now optionals !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -265,6 +311,12 @@ 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 ) + !/ 10-Oct-2023 : Major refactor - W3SRCE now processes + !/ all seapoints rather than single + !/ seapoint. C. Bunney; UKMO ( version 7.14 ) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. C Bunney !/ !/ Copyright 2009-2013 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -273,7 +325,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & !/ ! 1. Purpose : ! - ! Calculate and integrate source terms for a single grid point. + ! Calculate and integrate source terms for all grid points. ! ! 2. Method : ! @@ -344,22 +396,24 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! REFLEC R.A. I reflection coefficients ( !/BS1 ) ! REFLED I.A. I reflection direction ( !/BS1 ) ! TRNX-Y Real I Grid transparency in X and Y ( !/BS1 ) - ! DELX Real. I grid cell size in X direction ( !/BS1 ) - ! DELY Real. I grid cell size in Y direction ( !/BS1 ) - ! DELA Real. I grid cell area ( !/BS1 ) ! FPI Real I/O Peak-input frequency. ( !/ST2 ) - ! WHITECAP R.A. O Whitecap statisics ( !/ST4 ) + ! WCAP_COV R.A. I/O Whitecap coverage ( !/ST4 ) + ! WCAP_THK R.A. I/O Whitecap foam thickness ( !/ST4 ) + ! WCAP_BHS R.A. I/O Whitecap breaking sig. wv. ht. ( !/ST4 ) + ! WCAP_MNT R.A. I/O Whitecap moment ! DTDYN Real O Average dynamic time step. ! FCUT Real O Cut-off frequency for tail. ! DTG Real I Global time step. ! D50 Real I Sand grain size ( !/BT4 ) - ! BEDFORM R.A. I/O Bedform parameters ( !/BT4 ) + ! BEDROUGH R.A. I/O Bedform roughness ( !/BT4 ) + ! BEDRIPX R.A. I/O Bedform ripple wavelength (x) ( !/BT4 ) + ! BEDRIPY R.A. I/O Bedform ripple wavelength (y) ( !/BT4 ) ! PSIC Real I Critical Shields ( !/BT4 ) ! PHIBBL Real O Energy flux to BBL ( !/BTx ) - ! TAUBBL R.A. O Momentum flux to BBL ( !/BTx ) - ! TAUICE R.A. O Momentum flux to sea ice ( !/ICx ) - ! PHICE Real O Energy flux to sea ice ( !/ICx ) - ! TAUOCX-YReal O Total ocean momentum components + ! TAUBBL[XY]R.A. O Momentum flux to BBL ( !/BTx ) + ! TAUICE[XY]R.A. I/O Momentum flux to sea ice ( !/ICx ) + ! PHICE Real I/O Energy flux to sea ice ( !/ICx ) + ! TAUOC[XY]Real O Total ocean momentum components ! WNMEAN Real O Mean wave number ! DAIR Real I Air density ! ---------------------------------------------------------------- @@ -642,90 +696,160 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, ONLY : B_JAC, ASPAR_JAC, ASPAR_DIAG_ALL - USE yowNodepool, ONLY: PDLIB_I_DIAG, PDLIB_SI + USE yowNodepool, ONLY: PDLIB_I_DIAG, PDLIB_SI, NP 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: IMEM, LSLOC #endif + + !GPU Refactor - extra imports + USE W3GDATMD, ONLY: NSEA, NSEAL, MAPSTA, MAPSF, FLAGST, NX, NY + USE W3PARALL, ONLY: INIT_GET_ISEA + USE W3ADATMD, ONLY: NSEALM + USE CONSTANTS, ONLY: UNDEF + !/ IMPLICIT NONE !/ !/ ------------------------------------------------------------------- / !/ Parameter list !/ - INTEGER, INTENT(IN) :: srce_call, IT, ISEA, JSEA, IX, IY, IMOD - REAL, intent(in) :: SPECOLD(NSPEC), CLATSL - REAL, INTENT(OUT) :: VSIO(NSPEC), VDIO(NSPEC) - LOGICAL, INTENT(OUT) :: SHAVEIO - REAL, INTENT(IN) :: D_INP, U10ABS, & - U10DIR, AS, CX, CY, DTG, D50,PSIC, & - ICE, ICEH + !!REAL, intent(in) :: SPECOLD(NSPEC) ! Refactor: Not used. + + ! GPU Refactor: Scalar inputs + INTEGER, INTENT(IN) :: & + srce_call, & + IT, & + IMOD + REAL, INTENT(IN) :: DTG + + ! GPU Refactor: Input arrays with dimension NSEA: + REAL, INTENT(IN) :: & + D_INP(1:NSEA), & + CLATSL(1:NSEA), & + AS(1:NSEA), & + CX(1:NSEA), & + CY(1:NSEA), & + DAIR(1:NSEA), & + ICE(1:NSEA), & + ICEH(1:NSEA), & + COEF(1:NSEA), & + ICEDMAX(1:NSEA) + + REAL, INTENT(INOUT) :: & + WN1(0:NK+1,NSEA), & ! Note: 0:NK+1 to avoid temporary array + CG1(0:NK+1,NSEA), & ! Note: 0:NK+1 to avoid temporary array + U10ABS(1:NSEA), & + U10DIR(1:NSEA), & + USTAR(1:NSEA), & + USTDIR(1:NSEA), & + FPI(1:NSEA), & + ICEF(1:NSEA) + + ! GPU Refactor: Input arrays with dimension NSEAL(M): + ! TODO: Slice all these to 1:NSEAL in calling routine? + REAL, INTENT(INOUT) :: & + SPEC(NSPEC,NSEALM), & + ALPHA(1:NK,1:NSEAL), & + WNMEAN(1:NSEAL), & + TAUWX(1:NSEAL), & + TAUWY(1:NSEAL), & + CHARN(1:NSEAL), & + PHIBBL(1:NSEAL), & + PHIAW(1:NSEAL), & + PHIOC(1:NSEAL), & + PHICE(1:NSEAL), & + TAUWIX(1:NSEAL), & + TAUWIY(1:NSEAL), & + TAUWNX(1:NSEAL), & + TAUWNY(1:NSEAL), & + TAUOX(1:NSEAL), & + TAUOY(1:NSEAL), & + TAUOCX(1:NSEAL), & + TAUOCY(1:NSEAL), & + TAUBBLX(1:NSEAL), & + TAUBBLY(1:NSEAL), & + TWS(1:NSEAL), & + TAUICEX(1:NSEAL), & + TAUICEY(1:NSEAL), & + WCAP_COV(1:NSEAL), & ! -| + WCAP_THK(1:NSEAL), & ! | GPU Refactor: Split WHITECAPING into 4 separate + WCAP_BHS(1:NSEAL), & ! | arrays (WCAP_*) to avoid temporaries when slicing + WCAP_MNT(1:NSEAL) ! -| + + REAL, INTENT(OUT) :: & + DTDYN(1:NSEAL), & + FCUT(1:NSEAL) + +! GPU Refactor - inputs depending on compile switch: +#ifdef W3_REF1 + INTEGER, INTENT(IN) :: & + REFLED(6,1:NSEA) + + REAL, INTENT(IN) :: & + REFLEC(4,1:NSEA), & + BERG(1:NSEA) + + REAL, INTENT(IN) :: & + TRNX(NY,NX), & + TRNY(NY,NX) +#endif #ifdef W3_FLX5 - REAL, INTENT(IN) :: TAUA, TAUADIR -#endif - INTEGER, INTENT(IN) :: REFLED(6) - REAL, INTENT(IN) :: REFLEC(4), DELX, DELY, DELA, & - TRNX, TRNY, BERG, ICEDMAX, DAIR - REAL, INTENT(INOUT) :: WN1(NK), CG1(NK), & - SPEC(NSPEC), ALPHA(NK), USTAR, & - USTDIR, FPI, TAUOX, TAUOY, & - TAUWX, TAUWY, PHIAW, PHIOC, PHICE, & - CHARN, TWS, BEDFORM(3), PHIBBL, & - TAUBBL(2), TAUICE(2), WHITECAP(4), & - TAUWIX, TAUWIY, TAUWNX, TAUWNY, & - ICEF, TAUOCX, TAUOCY, WNMEAN - REAL, INTENT(OUT) :: DTDYN, FCUT - REAL, INTENT(IN) :: COEF - !/ + REAL, INTENT(IN) :: & + TAUA(1:NSEA), & + TAUADIR(1:NSEA) +#endif +#ifdef W3_BT4 + REAL, INTENT(IN) :: & + D50(1:NSEA), & + PSIC(1:NSEA) + REAL, INTENT(INOUT) :: & + BEDROUGH(1:NSEAL), & + BEDRIPX(1:NSEAL), & + BEDRIPY(1:NSEAL) +#endif + + ! GPU Refactor: optional inputs + REAL, INTENT(OUT), OPTIONAL :: & + VSIO(NSPEC,NSEAL), & + VDIO(NSPEC,NSEAL) + LOGICAL, INTENT(OUT), OPTIONAL :: SHAVEIO(NSEAL) + !/ ------------------------------------------------------------------- / !/ Local parameters !/ - INTEGER :: IK, ITH, IS, IS0, NSTEPS, NKH, NKH1, & + INTEGER :: IK, ITH, IS, IS0, NSTEPS, & IKS1, IS1, NSPECH, IDT, IERR, ISP - REAL :: DTTOT, FHIGH, DT, AFILT, DAMAX, AFAC, & - HDT, ZWND, FP, DEPTH, TAUSCX, TAUSCY, FHIGI + REAL :: AFILT, DAMAX, AFAC, & + HDT, ZWND, TAUSCX, TAUSCY ! Scaling factor for SIN, SDS, SNL REAL :: ICESCALELN, ICESCALEIN, ICESCALENL, ICESCALEDS - REAL :: EMEAN, FMEAN, AMAX, CD, Z0, SCAT, & - SMOOTH_ICEDISP REAL :: WN_R(NK), CG_ICE(NK), ALPHA_LIU(NK), ICECOEF2, R(NK) DOUBLE PRECISION :: ATT, ISO - REAL :: EBAND, DIFF, EFINISH, HSTOT, PHINL, & - FMEAN1, FMEANWS, & - FACTOR, FACTOR2, DRAT, TAUWAX, TAUWAY, & + REAL :: EBAND, DIFF, EFINISH, HSTOT, & +! PHINL, & ! GPU Refactor: Computed but not actually used anywhere - removed + FACTOR, FACTOR2, & MWXFINISH, MWYFINISH, A1BAND, B1BAND, & COSI(2) - 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), & - VSBT(NSPEC), VDBT(NSPEC) - REAL :: VS(NSPEC), VD(NSPEC), EB(NK) - + REAL :: SPEC2(NSPEC), FRLOCAL, JAC2 + REAL :: DAM2(NSPEC) + !REAL :: EB(NK) ! GPU Refactor: removed - not used. LOGICAL :: SHAVE - LOGICAL :: LBREAK - LOGICAL, SAVE :: FIRST = .TRUE. + LOGICAL :: LBREAK ! TODO - returned from W3SDB1 but never used. Make dummy? + !LOGICAL, SAVE :: FIRST = .TRUE. ! GPU Refactor: removed - not used. 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 + REAL, SAVE :: TAUNUX, TAUNUY ! TODO - returned from W3_FLD[12], but never used... LOGICAL, SAVE :: FLTEST = .FALSE., FLAGNN = .TRUE. - -#ifdef W3_OMPG - !$omp threadprivate( TAUNUX, TAUNUY) - !$omp threadprivate( FLTEST, FLAGNN ) - !$omp threadprivate( FIRST ) -#endif - !/ !/ ------------------------------------------------------------------- / !/ Local parameters dependent on compile switch !/ +#ifdef W3_PDLIB + REAL :: DeltaSRC(NSPEC) +#endif + #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif @@ -733,10 +857,10 @@ 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 + REAL :: FOUT(NK,NTH), SOUT(NK,NTH), DOUT(NK,NTH) #endif #ifdef W3_NL5 - INTEGER :: QI5TSTART(2) REAL :: QR5KURT INTEGER, PARAMETER :: NL5_SELECT = 1 REAL, PARAMETER :: NL5_OFFSET = 0. ! explicit dyn. @@ -762,22 +886,6 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & REAL :: VSIC(NSPEC), VDIC(NSPEC) #endif -#ifdef W3_DB1 - REAL :: VSDB(NSPEC), VDDB(NSPEC) -#endif - -#ifdef W3_TR1 - REAL :: VSTR(NSPEC), VDTR(NSPEC) -#endif - -#ifdef W3_BS1 - REAL :: VSBS(NSPEC), VDBS(NSPEC) -#endif - -#ifdef W3_REF1 - REAL :: VREF(NSPEC) -#endif - #if defined(W3_IS1) || defined(W3_IS2) REAL :: VSIR(NSPEC), VDIR(NSPEC) #endif @@ -785,13 +893,10 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_IS2 REAL :: VDIR2(NSPEC) DOUBLE PRECISION :: SCATSPEC(NTH) + REAL :: SCAT, SMOOTH_ICEDISP #endif -#ifdef W3_UOST - REAL :: VSUO(NSPEC), VDUO(NSPEC) -#endif - -#ifdef W3_ST1 +#if defined (W3_ST1) || defined(W3_ST3) || defined(W3_ST4) REAL :: FH1, FH2 #endif @@ -799,33 +904,147 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & REAL :: FHTRAN, DFH, FACDIA, FACPAR #endif -#ifdef W3_ST3 - REAL :: FMEANS, FH1, FH2 +#ifdef W3_PDLIB + REAL :: PreVS, DVS, SIDT, FAKS, MAXDAC #endif -#ifdef W3_ST4 - REAL :: FMEANS, FH1, FH2, FAGE, DLWMEAN - REAL :: BRLAMBDA(NSPEC) +#ifdef W3_NNT + CHARACTER(LEN=17), SAVE :: FNAME = 'test_data_nnn.ww3' #endif -#if defined(W3_ST3) || defined(W3_ST4) - LOGICAL :: LLWS(NSPEC) -#endif + !/ + !/ ------------------------------------------------------------------- / + !/ --- GPU REFACTOR --- ! + !/ New local parameters or existing variables that have had CHUNKSIZE + !/ dimension added to allow for tiling. + !/ + ! Exising locals with new CHUNKSIZE dimension + REAL :: AMAX(CHUNKSIZE), & + EMEAN(CHUNKSIZE), & + FMEAN(CHUNKSIZE), & + FMEAN1(CHUNKSIZE), & + FMEANWS(CHUNKSIZE), & + CD(CHUNKSIZE), & + Z0(CHUNKSIZE), & + FHIGH(CHUNKSIZE), & + !!FHIGI(CHUNKSIZE) ! Not used & + TAUWAX(CHUNKSIZE), & + TAUWAY(CHUNKSIZE), & + DEPTH(CHUNKSIZE), & + DT(CHUNKSIZE), & + DRAT(CHUNKSIZE) + + INTEGER :: & + NKH(CHUNKSIZE), NKH1(CHUNKSIZE) + + REAL :: DTTOT(CHUNKSIZE) + REAL :: DAM (NSPEC,CHUNKSIZE), & + WN2 (NSPEC,CHUNKSIZE), & + SPECINIT(NSPEC,CHUNKSIZE) + + REAL :: VS(NSPEC, CHUNKSIZE), VD(NSPEC, CHUNKSIZE) + + REAL :: VSLN(NSPEC, CHUNKSIZE), & + VSIN(NSPEC, CHUNKSIZE), VDIN(NSPEC, CHUNKSIZE), & + VSDS(NSPEC, CHUNKSIZE), VDDS(NSPEC, CHUNKSIZE), & + VSNL(NSPEC, CHUNKSIZE), VDNL(NSPEC, CHUNKSIZE), & + VSBT(NSPEC, CHUNKSIZE), VDBT(NSPEC, CHUNKSIZE) +#ifdef W3_TR1 + REAL :: VSTR(NSPEC, CHUNKSIZE), VDTR(NSPEC, CHUNKSIZE) +#endif #ifdef W3_ST6 - REAL :: VSWL(NSPEC), VDWL(NSPEC) + REAL :: VSWL(NSPEC, CHUNKSIZE), VDWL(NSPEC, CHUNKSIZE) +#endif +#ifdef W3_DB1 + REAL :: VSDB(NSPEC, CHUNKSIZE), VDDB(NSPEC, CHUNKSIZE) +#endif +#ifdef W3_BS1 + REAL :: VSBS(NSPEC, CHUNKSIZE), VDBS(NSPEC, CHUNKSIZE) +#endif +#ifdef W3_UOST + REAL :: VSUO(NSPEC, CHUNKSIZE), VDUO(NSPEC, CHUNKSIZE) +#endif +#ifdef W3_REF1 + REAL :: VREF(NSPEC, CHUNKSIZE) ! TODO: Can we share this with other switches? I.e + ! VSTMP and VDTMP. +#endif +#if W3_ST3 + REAL :: FMEANS(CHUNKSIZE) +#endif +#if defined(W3_ST3) || defined(W3_ST4) + LOGICAL :: LLWS(NSPEC,CHUNKSIZE) #endif +#ifdef W3_ST4 + REAL :: DLWMEAN(CHUNKSIZE), & + FAGE(CHUNKSIZE) + REAL :: BRLAMBDA(NSPEC, CHUNKSIZE) +#endif +#if defined(W3_ST0) || defined(W3_ST1) || defined(W3_ST2) || \ + defined(W3_ST6) || defined(W3_FLX2) || defined(W3_FLX3) + REAL :: FP(CHUNKSIZE) +#endif +#ifdef W3_NL5 + INTEGER :: QI5TSTART(2,CHUNKSIZE) +#endif + + ! New locals for chunking + INTEGER :: CHUNK0, CHUNKN, NSEAC, I, ISEA, JSEA, CSEA + INTEGER :: IX(CHUNKSIZE), IY(CHUNKSIZE) + + ! Refactor: New CHUNK sized arrays for storing contiguous data from + ! full seapoint array (NSEA) on local seapoint array (NSEAL) + ! TODO - HOIST THESE TO MODULE SCOPE (Heap allocation)? + ! TODO - Not really needed for SHRD runs, where ISEA == JSEA...can we used pointers instead? + REAL :: CG1_CHUNK(1:NK, CHUNKSIZE), & + WN1_CHUNK(1:NK, CHUNKSIZE), & + U10_CHUNK(CHUNKSIZE), & + U10D_CHUNK(CHUNKSIZE), & + UST_CHUNK(CHUNKSIZE), & + USTD_CHUNK(CHUNKSIZE), & + DAIR_CHUNK(CHUNKSIZE), & + ICE_CHUNK(CHUNKSIZE), & + ICEH_CHUNK(CHUNKSIZE), & + ICEF_CHUNK(CHUNKSIZE), & + ICEDMAX_CHUNK(CHUNKSIZE), & + COEF_CHUNK(CHUNKSIZE) +#if defined(W3_ST3) || defined(W3_ST4) + REAL :: AS_CHUNK(CHUNKSIZE) +#endif +#if defined(W3_BS1) || defined(W3_REF1) + REAL :: CX_CHUNK(CHUNKSIZE), CY_CHUNK(CHUNKSIZE) +#endif +#ifdef W3_REF1 + REAL :: TRNX_CHUNK(CHUNKSIZE), & + TRNY_CHUNK(CHUNKSIZE), & + REFLEC_CHUNK(4,CHUNKSIZE), & + BERG_CHUNK(CHUNKSIZE) + INTEGER :: REFLED_CHUNK(6,CHUNKSIZE) +#endif +#ifdef W3_FLX5 + REAL :: TAUA_CHUNK(CHUNKSIZE), TAUADIR_CHUNK(CHUNKSIZE) +#endif +#if W3_BT4 + REAL :: D50_CHUNK(CHUNKSIZE), & + PSIC_CHUNK(CHUNKSIZE) +#endif #ifdef W3_PDLIB - REAL :: PreVS, DVS, SIDT, FAKS, MAXDAC + REAL :: CLATSL_CHUNK(CHUNKSIZE) #endif -#ifdef W3_NNT - CHARACTER(LEN=17), SAVE :: FNAME = 'test_data_nnn.ww3' -#endif + + ! For masking points that have completed integration or are not seapoints. + LOGICAL, ALLOCATABLE :: SRC_MASK(:) + LOGICAL :: COMPLETE + + ! --- END GPU REFACTOR --- ! + ! !/ -- End of variable delclarations - ! + !/ ------------------------------------------------------------------- / + !/ + #ifdef W3_S CALL STRACE (IENT, 'W3SRCE') #endif @@ -833,7 +1052,10 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_T FLTEST = .TRUE. #endif - ! + + ! GPU Refactor - allocate locals + ALLOCATE(SRC_MASK(CHUNKSIZE)) + IKS1 = 1 #ifdef W3_IG1 ! Does not integrate source terms for IG band if IGPARS(12) = 0. @@ -841,1422 +1063,1850 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif IS1=(IKS1-1)*NTH+1 - !! Initialise source term arrays: - VD = 0. - VS = 0. - VDIO = 0. - VSIO = 0. - VSBT = 0. - VDBT = 0. + ! GPU refactor: initialise some (non chunked) fields: + ! (Moved outside chunk loop) + ! These are all variables dimensioned (NSEAL) + IF(PRESENT(VDIO)) VDIO = 0. + IF(PRESENT(VSIO)) VSIO = 0. + DTDYN = 0. + PHIAW = 0. + TAUWIX = 0. + TAUWIY = 0. + TAUWNX = 0. + TAUWNY = 0. + TAUOCX = 0. + TAUOCY = 0. + TAUBBLX = 0. + TAUBBLY = 0. + PHIBBL = 0. + !TAUICEX = 0. ! GPU REFACTOR: Don't zero whole array here (for B4B purposes after refactor; zeroed later) + !TAUICEY = 0. ! GPU REFACTOR: Don't zero whole array here (for B4B purposes after refactor; zeroed later) + !PHICE = 0. ! GPU REFACTOR: Don't zero whole array here (for B4B purposes after refactor; zeroed later) + WNMEAN = 0. + !CHARN = 0. ! GPU REFACTOR: Don't zero whole array here (for B4B purposes after refactor; zeroed later) + TWS = 0. + + ! Refactor notes: Zero ice chunks if ICE field never read in. + ! INFLAGS2(4) is true if ice concentration read in for this simulation + IF(.NOT. INFLAGS2(4)) THEN + ICE_CHUNK(:) = 0.0 ! Ice never read in + END IF + +#ifdef W3_ST4 + WCAP_COV(:) = 0. + WCAP_THK(:) = 0. + WCAP_BHS(:) = 0. + WCAP_MNT(:) = 0. +#endif + + ! --------------------------------------------------------------------- + ! Start of loop over tiles: + ! --------------------------------------------------------------------- + CHUNKN = 0 + DO + ! Get start and end indices of tile: + CHUNK0 = CHUNKN + 1 + +#ifdef W3_PDLIB + ! In W3SRCE, the loop is 1:NP for the src_inp_pre loop, rather than 1:NSEAL + ! Should it be the same for srce_imp_post? + IF(srce_call .EQ. srce_imp_pre) THEN + IF(CHUNK0 .GT. NP) EXIT + ENDIF +#endif + IF(CHUNK0 .GT. NSEAL) EXIT + CHUNKN = MIN(NSEAL,CHUNK0 + CHUNKSIZE - 1) + NSEAC = CHUNKN - CHUNK0 + 1 + + !! GPU Refactor: Now in section 1 + ! DEPTH = MAX ( DMIN , D_INP ) + ! DRAT = DAIR / DWAT + + !! GPU Refactor: Moved to section 4: + !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))) + + !! Initialise source term arrays: + VS = 0. + VD = 0. + VSBT = 0. + VDBT = 0. #if defined(W3_LN0) || defined(W3_LN1) || defined(W3_SEED) - VSLN = 0. + VSLN = 0. #endif #if defined(W3_ST0) || defined(W3_ST3) || defined(W3_ST4) - VSIN = 0. - VDIN = 0. + VSIN(:,:) = 0. + VDIN(:,:) = 0. #endif #if defined(W3_NL0) || defined(W3_NL1) - VSNL = 0. - VDNL = 0. + VSNL = 0. + VDNL = 0. #endif #ifdef W3_TR1 - VSTR = 0. - VDTR = 0. + VSTR = 0. + VDTR = 0. #endif #if defined(W3_ST0) || defined(W3_ST4) - VSDS = 0. - VDDS = 0. + VSDS = 0. + VDDS = 0. #endif #ifdef W3_DB1 - VSDB = 0. - VDDB = 0. + VSDB = 0. + VDDB = 0. #endif #if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) - VSIC = 0. - VDIC = 0. + VSIC = 0. + VDIC = 0. #endif #ifdef W3_UOST - VSUO = 0. - VDUO = 0. + VSUO = 0. + VDUO = 0. #endif #if defined(W3_IS1) || defined(W3_IS2) - VSIR = 0. - VDIR = 0. + VSIR = 0. + VDIR = 0. #endif #ifdef W3_IS2 - VDIR2 = 0. + VDIR2 = 0. #endif - + ! #ifdef W3_ST6 - VSWL = 0. - VDWL = 0. + VSWL = 0. + VDWL = 0. #endif + ! Set ZWND depeding on source term package #if defined(W3_ST0) || defined(W3_ST1) || defined(W3_ST6) - ZWND = 10. + ZWND = 10. #endif #if defined(W3_ST2) - ZWND = ZWIND + ZWND = ZWIND #endif #if defined(W3_ST4) - ZWND = ZZWND + ZWND = ZZWND #endif - ! - ! 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 + ! TODO - move this (depth not calculated yet) + !WRITE (NDST,9000) + !WRITE (NDST,9001) DEPTH, U10ABS, U10D_CHUNK(CSEA)*RADE +#endif + ! + ! 1. Preparations --------------------------------------------------- * + +#if MANM +!$ACC KERNELS + !TODO: GPU notes: This will need DATA section to work + ! efficiently with explicit transfers +#endif + ! GPU Refactor - gather full domain variables (defined with size + ! NSEA) to local domain variables (define with size NSEAL) + ! + ! Not technically required when running SHRD mode + ! TODO: Look into workaround for this, use pointers instead? + ! TODO - rewrite to loop over I for GPU, to avoid loop dependency. + + I = 1 + DO JSEA=CHUNK0,CHUNKN + CALL INIT_GET_ISEA(ISEA, JSEA) !!! TODO: Potentially slow! Precalculate? + + IX(I) = MAPSF(ISEA,1) + IY(I) = MAPSF(ISEA,2) + + CG1_CHUNK(:,I) = CG1(1:NK,ISEA) + WN1_CHUNK(:,I) = WN1(1:NK,ISEA) + U10_CHUNK(I) = U10ABS(ISEA) + U10D_CHUNK(I) = U10DIR(ISEA) + UST_CHUNK(I) = USTAR(ISEA) + USTD_CHUNK(I) = USTDIR(ISEA) + DAIR_CHUNK(I) = DAIR(ISEA) + COEF_CHUNK(I) = COEF(ISEA) !! TODO: Only non-1 value if STAB2 set + +#if defined(W3_ST3) || defined(W3_ST4) + AS_CHUNK(I) = AS(ISEA) +#endif +#ifdef W3_FLX5 + TAUA_CHUNK(I) = TAUA(ISEA) + TAUADIR_CHUNK(I) = TAUADIR(ISEA) +#endif +#if defined(W3_BS1) || defined(W3_REF1) + CX_CHUNK(I) = CX(ISEA) + CY_CHUNK(I) = CY(ISEA) +#endif +#ifdef W3_REF1 + TRNX_CHUNK(I) = TRNX(IY(I),IX(I)) + TRNY_CHUNK(I) = TRNY(IY(I),IX(I)) + REFLEC_CHUNK(:,I) = REFLEC(:,ISEA) + REFLED_CHUNK(:,I) = REFLED(:,ISEA) + BERG_CHUNK(I) = BERG(ISEA) +#endif +#ifdef W3_BT4 + D50_CHUNK(I) = D50(ISEA) + PSIC_CHUNK(I) = PSIC(ISEA) +#endif +#ifdef W3_PDLIB + CLATSL_CHUNK(I) = CLATSL(ISEA) +#endif + DRAT(I) = DAIR(ISEA) / DWAT + DEPTH(I) = MAX(DMIN , D_INP(ISEA)) +#ifdef W3_MLIM + ! Do we want D_INP_CHUNK here for Miche Limiter? + ! Maybe just calculated ISEA in place in this case? + ! (That's what I've done - see MLIM section below) +#endif + ! Only bother copying ice if ice field read in (INFLAGS(4) is TRUE): + IF(INFLAGS2(4)) THEN + ICE_CHUNK(I) = ICE(ISEA) + ICEH_CHUNK(I) = ICEH(ISEA) + ICEF_CHUNK(I) = ICEF(ISEA) +#ifdef W3_IS2 + ICEDMAX_CHUNK(I) = ICEDMAX(ISEA) #endif + ENDIF + ! + ! 1.a Set maximum change and wavenumber arrays. + ! + DO IK=1, NK + DAM(1+(IK-1)*NTH,I) = FACP / ( SIG(IK) * WN1(IK,ISEA)**3 ) + WN2(1+(IK-1)*NTH,I) = WN1(IK,ISEA) + END DO + ! + DO IK=1, NK + IS0 = (IK-1)*NTH + DO ITH=2, NTH + DAM(ITH+IS0,I) = DAM(1+IS0,I) + WN2(ITH+IS0,I) = WN2(1+IS0,I) + END DO + END DO - ! 1.a Set maximum change and wavenumber arrays. - ! - !XP = 0.15 - !FACP = XP / PI * 0.62E-3 * TPI**4 / GRAV**2 - ! - DO IK=1, NK - DAM(1+(IK-1)*NTH) = FACP / ( SIG(IK) * WN1(IK)**3 ) - WN2(1+(IK-1)*NTH) = WN1(IK) - END DO - ! - DO IK=1, NK - IS0 = (IK-1)*NTH - DO ITH=2, NTH - DAM(ITH+IS0) = DAM(1+IS0) - WN2(ITH+IS0) = WN2(1+IS0) - END DO - END DO - ! - ! 1.b Prepare dynamic time stepping - ! - DTDYN = 0. - DTTOT = 0. - NSTEPS = 0 - PHIAW = 0. - CHARN = 0. - TWS = 0. - PHINL = 0. - PHIBBL = 0. - TAUWIX = 0. - TAUWIY = 0. - TAUWNX = 0. - TAUWNY = 0. - TAUWAX = 0. - TAUWAY = 0. - TAUSCX = 0. - TAUSCY = 0. - TAUBBL = 0. - TAUICE = 0. - PHICE = 0. - TAUOCX = 0. - TAUOCY = 0. - WNMEAN = 0. + ! Set mask for computation of source terms based on MAPSTA + ! and FLAGST. This originally is done in w3wavemd as a + ! conditional statement around the W3SRCE call + SRC_MASK(I) = .NOT. (MAPSTA(IY(I),IX(I)) .EQ. 1 .AND. FLAGST(ISEA)) - ! - ! TIME is updated in W3WAVEMD prior to the call of W3SCRE, we should - ! move 'TIME' one time step backward (QL) + I = I + 1 + ENDDO ! Gather to local grid loop +#if MANM +!$ACC END KERNELS +#endif + ! + ! 1.b Prepare dynamic time stepping + ! + ! Refactor: Zero "chunksize" dimensioned variables + DTTOT = 0. + NSTEPS = 0 + !PHINL = 0. ! Calculated value never used...ditch? + TAUWAX = 0. + TAUWAY = 0. ! Only for ST3, ST4, ST6 + TAUSCX = 0. ! Only for W3_BS1 + TAUSCY = 0. + ! + ! TIME is updated in W3WAVEMD prior to the call of W3SCRE, we should + ! move 'TIME' one time step backward (QL) #ifdef W3_NL5 - QI5TSTART = TIME - CALL TICK21 (QI5TSTART, -1.0 * DTG) + !QI5TSTART = TIME + !CALL TICK21 (QI5TSTART, -1.0 * DTG) + QI5TSTART(:,1) = TIME + CALL TICK21 (QI5TSTART(:,1), -1.0 * DTG) + IF(NSEAC .GT. 1) THEN + DO CSEA=2,NSEAC + ! GPU Refactor - to avoid calling TICK21 unneccesarily in a loop: + QI5TSTART(1:2,CSEA) = QI5TSTART(1:2,1) + END DO + END IF #endif - ! + ! #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) 'W3SRCE start sum(SPEC)=', sum(SPEC) - WRITE(740+IAPROC,*) 'W3SRCE start sum(SPECOLD)=', sum(SPECOLD) - WRITE(740+IAPROC,*) 'W3SRCE start sum(SPECINIT)=', sum(SPECINIT) - WRITE(740+IAPROC,*) 'W3SRCE start sum(VSIO)=', sum(VSIO) - WRITE(740+IAPROC,*) 'W3SRCE start sum(VDIO)=', sum(VDIO) - WRITE(740+IAPROC,*) 'W3SRCE start USTAR=', USTAR - END IF + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) 'W3SRCE start sum(SPEC)=', sum(SPEC) + !WRITE(740+IAPROC,*) 'W3SRCE start sum(SPECOLD)=', sum(SPECOLD) + WRITE(740+IAPROC,*) 'W3SRCE start sum(SPECINIT)=', sum(SPECINIT) + WRITE(740+IAPROC,*) 'W3SRCE start sum(VSIO)=', sum(VSIO) + WRITE(740+IAPROC,*) 'W3SRCE start sum(VDIO)=', sum(VDIO) + WRITE(740+IAPROC,*) 'W3SRCE start USTAR=', UST_CHUNK(CSEA) + END IF #endif #ifdef W3_ST4 - DLWMEAN= 0. - BRLAMBDA(:)=0. - WHITECAP(:)=0. + DLWMEAN(:) = 0. + BRLAMBDA(:,:) = 0. + !WHITECAP(:,:) = 0. Don't zero here - is in seapoint loop #endif - ! - ! 1.c Set mean parameters - ! + ! + ! 1.c Set mean parameters + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + + ! CB Refactor - zero CHARN element wise, rather than whole array (for b4b reproducibility) + CHARN(JSEA) = 0. + #ifdef W3_ST0 - CALL W3SPR0 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) - FP = 0.85 * FMEAN + CALL W3SPR0 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA)) + FP(CSEA) = 0.85 * FMEAN(CSEA) #endif #ifdef W3_ST1 - CALL W3SPR1 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) - FP = 0.85 * FMEAN + CALL W3SPR1 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA)) + FP(CSEA)= 0.85 * FMEAN(CSEA) #endif #ifdef W3_ST2 - CALL W3SPR2 (SPEC, CG1, WN1, DEPTH, FPI, U10ABS, USTAR, & - EMEAN, FMEAN, WNMEAN, AMAX, ALPHA, FP ) + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + CALL W3SPR2 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), DEPTH(CSEA), FPI(ISEA), U10_CHUNK(CSEA), UST_CHUNK(CSEA), & + EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA), ALPHA(:,JSEA), FP(CSEA) ) #endif #ifdef W3_ST3 - TAUWX=0. - TAUWY=0. - IF ( IT .eq. 0 ) THEN - LLWS(:) = .TRUE. - USTAR=0. - USTDIR=0. - CALL W3SPR3 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEANS, WNMEAN, & - AMAX, U10ABS, U10DIR, USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS) - ELSE - CALL W3SPR3 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEANS, WNMEAN, & - AMAX, U10ABS, U10DIR, USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS) - CALL W3SIN3 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & - U10DIR, Z0, CD, TAUWX, TAUWY, TAUWAX, TAUWAY, & - ICE, VSIN, VDIN, LLWS, IX, IY ) - END IF - CALL W3SPR3 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEANS, WNMEAN, & - AMAX, U10ABS, U10DIR, USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS) - TWS = 1./FMEANWS + TAUWX(JSEA)=0. + TAUWY(JSEA)=0. + IF ( IT .eq. 0 ) THEN + LLWS(:,CSEA) = .TRUE. + UST_CHUNK(CSEA)=0. + USTD_CHUNK(CSEA)=0. + CALL W3SPR3 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), FMEANS(CSEA), WNMEAN(JSEA), & + AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), LLWS(:,CSEA), FMEANWS(CSEA)) + ELSE + CALL W3SPR3 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), FMEANS(CSEA), WNMEAN(JSEA), & + AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), LLWS(:,CSEA), FMEANWS(CSEA)) + CALL W3SIN3 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), U10_CHUNK(CSEA), UST_CHUNK(CSEA), DRAT(CSEA), AS_CHUNK(CSEA), & + U10D_CHUNK(CSEA), Z0(CSEA), CD(CSEA), TAUWX(JSEA), TAUWY(JSEA), TAUWAX(CSEA), TAUWAY(CSEA), & + ICE_CHUNK(CSEA), VSIN(:,CSEA), VDIN(:,CSEA), LLWS(:,CSEA), IX(CSEA), IY(CSEA) ) + END IF + CALL W3SPR3 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), FMEANS(CSEA), WNMEAN(JSEA), & + AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), LLWS(:,CSEA), FMEANWS(CSEA)) + TWS(JSEA) = 1./FMEANWS(CSEA) #endif #ifdef W3_ST4 - 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 - CALL W3SPR4 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEAN1, WNMEAN, & - AMAX, U10ABS, U10DIR, & + IF (SINTAILPAR(4).GT.0.5) THEN ! this is designed to keep the bug as an option + TAUWX(JSEA)=0. + TAUWY(JSEA)=0. + END IF + IF ( IT .EQ. 0 ) THEN + LLWS(:,CSEA) = .TRUE. + TAUWX(JSEA)=0. + TAUWY(JSEA)=0. + UST_CHUNK(CSEA)=0. + USTD_CHUNK(CSEA)=0. + ELSE + CALL W3SPR4 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), FMEAN1(CSEA), WNMEAN(JSEA), & + AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & #ifdef W3_FLX5 - TAUA, TAUADIR, DAIR, & + TAUA_CHUNK(CSEA), TAUADIR_CHUNK(CSEA), DAIR_CHUNK(CSEA), & #endif - USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), LLWS(:,CSEA), FMEANWS(CSEA), DLWMEAN(CSEA)) #endif #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 - WRITE(740+IAPROC,*) '1: out value FMEAN1=', FMEAN1, ' WNMEAN=', WNMEAN - WRITE(740+IAPROC,*) '1: out value CD=', CD, ' Z0=', Z0 - WRITE(740+IAPROC,*) '1: out value ALPHA=', CHARN, ' FMEANWS=', FMEANWS - END IF + IF (IX(CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '1: out value USTAR=', UST_CHUNK(CSEA), ' USTDIR=', USTD_CHUNK(CSEA) + WRITE(740+IAPROC,*) '1: out value EMEAN(JSEA)=', EMEAN(CSEA), ' FMEAN(JSEA)=', FMEAN(JSEA) + WRITE(740+IAPROC,*) '1: out value FMEAN1(JSEA)=', FMEAN1(CSEA), ' WNMEAN(JSEA)=', WNMEAN(JSEA) + WRITE(740+IAPROC,*) '1: out value CD=', CD(CSEA), ' Z0=', Z0(CSEA) + WRITE(740+IAPROC,*) '1: out value ALPHA=', CHARN(JSEA), ' FMEANWS=', FMEANWS(CSEA) + END IF #endif #ifdef W3_ST4 - 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 + IF (SINTAILPAR(4).GT.0.5) THEN + CALL W3SIN4 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), U10_CHUNK(CSEA), UST_CHUNK(CSEA), DRAT(CSEA), AS_CHUNK(CSEA), & + U10D_CHUNK(CSEA), Z0(CSEA), CD(CSEA), TAUWX(JSEA), TAUWY(JSEA), TAUWAX(CSEA), TAUWAY(CSEA), & + VSIN(:,CSEA), VDIN(:,CSEA), LLWS(:,CSEA), IX(CSEA), IY(CSEA), BRLAMBDA(:,CSEA) ) + END IF + END IF ! IT==0 #endif #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 - WRITE(740+IAPROC,*) '1: DRAT=', DRAT - WRITE(740+IAPROC,*) '1: TAUWX=', TAUWX, ' TAUWY=', TAUWY - WRITE(740+IAPROC,*) '1: TAUWAX=', TAUWAX, ' TAUWAY=', TAUWAY - WRITE(740+IAPROC,*) '1: min(CG1)=', minval(CG1), ' max(CG1)=', maxval(CG1) - WRITE(740+IAPROC,*) '1: W3SIN4(min/max/sum)VSIN=', minval(VSIN), maxval(VSIN), sum(VSIN) - WRITE(740+IAPROC,*) '1: W3SIN4(min/max/sum)VDIN=', minval(VDIN), maxval(VDIN), sum(VDIN) - END IF + IF (IX(CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '1: U10DIR=', U10D_CHUNK(CSEA), ' Z0=', Z0(CSEA), ' CHARN=', CHARN(JSEA) + WRITE(740+IAPROC,*) '1: USTAR=', UST_CHUNK(CSEA), ' U10ABS=', U10_CHUNK(CSEA), ' AS=', AS_CHUNK(CSEA) + WRITE(740+IAPROC,*) '1: DRAT=', DRAT(CSEA) + WRITE(740+IAPROC,*) '1: TAUWX=', TAUWX(JSEA), ' TAUWY=', TAUWY(JSEA) + WRITE(740+IAPROC,*) '1: TAUWAX=', TAUWAX, ' TAUWAY=', TAUWAY + WRITE(740+IAPROC,*) '1: min(CG1)=', minval(CG1_CHUNK(:,CSEA)), ' max(CG1)=', maxval(CG1_CHUNK(:,CSEA)) + WRITE(740+IAPROC,*) '1: W3SIN4(min/max/sum)VSIN=', minval(VSIN(:,CSEA)), maxval(VSIN(:,CSEA)), sum(VSIN(:,CSEA)) + WRITE(740+IAPROC,*) '1: W3SIN4(min/max/sum)VDIN=', minval(VDIN(:,CSEA)), maxval(VDIN(:,CSEA)), sum(VDIN(:,CSEA)) + END IF #endif #ifdef W3_ST4 - CALL W3SPR4 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEAN1, WNMEAN, & - AMAX, U10ABS, U10DIR, & + CALL W3SPR4 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), & + EMEAN(CSEA), FMEAN(CSEA), FMEAN1(CSEA), WNMEAN(JSEA), & + AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & #ifdef W3_FLX5 - TAUA, TAUADIR, DAIR, & + TAUA_CHUNK(CSEA), TAUADIR_CHUNK(CSEA), DAIR_CHUNK(CSEA), & #endif - USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) - TWS = 1./FMEANWS + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), & + LLWS(:,CSEA), FMEANWS(CSEA), DLWMEAN(CSEA)) + + TWS(JSEA) = 1./FMEANWS(CSEA) #endif #ifdef W3_ST6 - CALL W3SPR6 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX, FP) + CALL W3SPR6 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA), FP(CSEA)) #endif - ! - ! 1.c2 Stores the initial data - ! - SPECINIT = SPEC - ! - ! 1.d Stresses - ! + + END DO ! CSEA + ! + ! 1.c2 Stores the initial data + ! + SPECINIT(:,:NSEAC) = SPEC(:,CHUNK0:CHUNKN) + ! + ! 1.d Stresses + ! + DO CSEA = 1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 #ifdef W3_FLX1 - CALL W3FLX1 ( ZWND, U10ABS, U10DIR, USTAR, USTDIR, Z0, CD ) + CALL W3FLX1 ( ZWND, U10_CHUNK(CSEA), U10D_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA) ) #endif #ifdef W3_FLX2 - CALL W3FLX2 ( ZWND, DEPTH, FP, U10ABS, U10DIR, & - USTAR, USTDIR, Z0, CD ) + CALL W3FLX2 ( ZWND, DEPTH(CSEA), FP(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA) ) #endif #ifdef W3_FLX3 - CALL W3FLX3 ( ZWND, DEPTH, FP, U10ABS, U10DIR, & - USTAR, USTDIR, Z0, CD ) + CALL W3FLX3 ( ZWND, DEPTH(CSEA), FP(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA) ) #endif #ifdef W3_FLX4 - CALL W3FLX4 ( ZWND, U10ABS, U10DIR, USTAR, USTDIR, Z0, CD ) + CALL W3FLX4 ( ZWND, U10_CHUNK(CSEA), U10D_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA) ) #endif #ifdef W3_FLX5 - CALL W3FLX5 ( ZWND, U10ABS, U10DIR, TAUA, TAUADIR, DAIR, & - USTAR, USTDIR, Z0, CD, CHARN ) + CALL W3FLX5 ( ZWND, U10_CHUNK(CSEA), U10D_CHUNK(CSEA), TAUA_CHUNK(CSEA), TAUADIR_CHUNK(CSEA), DAIR_CHUNK(CSEA), & + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA), CHARN(JSEA) ) #endif - ! - ! 1.e Prepare cut-off beyond which the tail is imposed with a power law - ! + END DO !CSEA + + ! + ! 1.e Prepare cut-off beyond which the tail is imposed with a power law + ! #ifdef W3_ST0 - FHIGH = SIG(NK) + FHIGH(1:NSEAC) = SIG(NK) #endif #ifdef W3_ST1 - FH1 = FXFM * FMEAN - FH2 = FXPM / USTAR - FHIGH = MAX ( FH1 , FH2 ) - IF (FLTEST) WRITE (NDST,9004) FH1*TPIINV, FH2*TPIINV, FHIGH*TPIINV + ! TODO: This is mostly same for ST1, ST3, ST4, ST6 + DO CSEA=1,NSEAC + FH1 = FXFM * FMEAN(CSEA) + FH2 = FXPM / UST_CHUNK(CSEA) + FHIGH(CSEA) = MAX ( FH1 , FH2 ) + IF (FLTEST) WRITE (NDST,9004) FH1*TPIINV, FH2*TPIINV, FHIGH(CSEA)*TPIINV + END DO #endif #ifdef W3_ST2 - FHIGH = XFC * FPI + DO CSEA=1,NSEAC + JSEA = CHUNK0 + CSEA - 1 + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + FHIGH(CSEA) = XFC * FPI(ISEA) + ENDDO + !!FHIGH(1:NSEAC) = XFC * FPI(CSEA) ! Have to do this explicitly above as FPI is NSEA and I/O #endif #ifdef W3_ST3 - FHIGH = MAX(FFXFM * MAX(FMEAN,FMEANWS),FFXPM / USTAR) + FHIGH(1:NSEAC) = MAX(FFXFM * MAX(FMEAN(1:NSEAC),FMEANWS(1:NSEAC)), & + FFXPM / UST_CHUNK(1:NSEAC)) #endif #ifdef W3_ST4 - ! Introduces a Long & Resio (JGR2007) type dependance on wave age - ! !/ST4 FAGE = FFXFA*TANH(0.3*U10ABS*FMEANWS*TPI/GRAV) - FAGE = 0. - FHIGH = MAX( (FFXFM + FAGE ) * MAX(FMEAN1,FMEANWS), FFXPM / USTAR) - FHIGI = FFXFA * FMEAN1 + ! Introduces a Long & Resio (JGR2007) type dependance on wave age + ! !/ST4 FAGE = FFXFA*TANH(0.3*U10ABS*FMEANWS*TPI/GRAV) + FAGE(1:NSEAC) = 0. + FHIGH(1:NSEAC) = MAX( (FFXFM + FAGE(1:NSEAC) ) * & + MAX(FMEAN1(1:NSEAC),FMEANWS(1:NSEAC)), FFXPM / UST_CHUNK(1:NSEAC)) + !!FHIGI(1:NSEAC) = FFXFA * FMEAN1(1:NSEAC) ! Not used #endif #ifdef W3_ST6 - IF (FXFM .LE. 0) THEN - FHIGH = SIG(NK) - ELSE - FHIGH = MAX (FXFM * FMEAN, FXPM / USTAR) - ENDIF + IF (FXFM .LE. 0) THEN + FHIGH(1:NSEAC) = SIG(NK) + ELSE + FHIGH(1:NSEAC) = MAX(FXFM * FMEAN(1:NSEAC), FXPM / UST_CHUNK(1:NSEAC)) + ENDIF #endif - ! - ! 1.f Prepare output file for !/NNT option - ! + ! + ! 1.f Prepare output file for !/NNT option + ! TODO: AT MOMENT THIS WILL ONLY WORK WITH CHUNKSIZE=1 #ifdef W3_NNT - IF ( IT .EQ. 0 ) THEN - 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 - OPEN (NDSD2,FILE=FNMPRE(:J)//'time.ww3', & - FORM='FORMATTED',ERR=800,IOSTAT=IERR) - END IF + IF ( IT .EQ. 0 ) THEN + 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 + OPEN (NDSD2,FILE=FNMPRE(:J)//'time.ww3', & + FORM='FORMATTED',ERR=800,IOSTAT=IERR) + END IF #endif - ! - ! ... Branch point dynamic integration - - - - - - - - - - - - - - - - - ! - DO ! - NSTEPS = NSTEPS + 1 + ! ... Branch point dynamic integration - - - - - - - - - - - - - - - - ! + DO + ! + NSTEPS = NSTEPS + 1 + ! #ifdef W3_T - WRITE (NDST,9020) NSTEPS, DTTOT + WRITE (NDST,9020) NSTEPS, DTTOT #endif - ! - ! 2. Calculate source terms ----------------------------------------- * - ! - ! 2.a Input. - ! + ! + ! 2. Calculate source terms ----------------------------------------- * + ! + ! 2.a Input. + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 #ifdef W3_LN1 - CALL W3SLN1 ( WN1, FHIGH, USTAR, U10DIR , VSLN ) + CALL W3SLN1 (WN1_CHUNK(:,CSEA), FHIGH(CSEA), UST_CHUNK(CSEA), U10D_CHUNK(CSEA), & + VSLN(:,CSEA) ) #endif - ! + ENDDO ! CSEA loop - W3LNx + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 #ifdef W3_ST1 - CALL W3SIN1 ( SPEC, WN2, USTAR, U10DIR , VSIN, VDIN ) + CALL W3SIN1 (SPEC(:,JSEA), WN2(:,CSEA), UST_CHUNK(CSEA), U10D_CHUNK(CSEA), VSIN(:,CSEA), VDIN(:,CSEA) ) #endif #ifdef W3_ST2 - CALL W3SIN2 ( SPEC, CG1, WN2, U10ABS, U10DIR, CD, Z0, & - FPI, VSIN, VDIN ) + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + CALL W3SIN2 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), CD(CSEA), Z0(CSEA), & + FPI(ISEA), VSIN(:,CSEA), VDIN(:,CSEA) ) #endif #ifdef W3_ST3 - CALL W3SIN3 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & - U10DIR, Z0, CD, TAUWX, TAUWY, TAUWAX, TAUWAY, & - ICE, VSIN, VDIN, LLWS, IX, IY ) + CALL W3SIN3 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), U10_CHUNK(CSEA), & + UST_CHUNK(CSEA), DRAT(CSEA), AS_CHUNK(CSEA), U10D_CHUNK(CSEA), & + Z0(CSEA), CD(CSEA), TAUWX(JSEA), TAUWY(JSEA), TAUWAX(CSEA), TAUWAY(CSEA), & + ICE_CHUNK(CSEA), VSIN(:,CSEA), VDIN(:,CSEA), LLWS(:,CSEA), IX(CSEA), IY(CSEA) ) #endif #ifdef W3_ST4 - CALL W3SIN4 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & - U10DIR, Z0, CD, TAUWX, TAUWY, TAUWAX, TAUWAY, & - VSIN, VDIN, LLWS, IX, IY, BRLAMBDA ) + ! TESTING! + VSIN(:,CSEA)=0 ! Not needed? + VDIN(:,CSEA)=0 + BRLAMBDA(:,CSEA)=0 ! TODO: Shouldn't be needed + ! END TESTING ! + CALL W3SIN4 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), & + U10_CHUNK(CSEA), UST_CHUNK(CSEA), DRAT(CSEA), AS_CHUNK(CSEA), & + U10D_CHUNK(CSEA), Z0(CSEA), CD(CSEA), TAUWX(JSEA), TAUWY(JSEA), & + TAUWAX(CSEA), TAUWAY(CSEA), & + VSIN(:,CSEA), VDIN(:,CSEA), LLWS(:,CSEA), IX(CSEA), IY(CSEA), BRLAMBDA(:,CSEA) ) #endif #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 + IF (IX(CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '2 : W3SIN4(min/max/sum)VSIN=', minval(VSIN(:,CSEA)), maxval(VSIN(:,CSEA)), sum(VSIN(:,CSEA)) + WRITE(740+IAPROC,*) '2 : W3SIN4(min/max/sum)VDIN=', minval(VDIN(:,CSEA)), maxval(VDIN(:,CSEA)), sum(VDIN(:,CSEA)) + END IF #endif #ifdef W3_ST6 - CALL W3SIN6 ( SPEC, CG1, WN2, U10ABS, USTAR, USTDIR, CD, DAIR, & - TAUWX, TAUWY, TAUWAX, TAUWAY, VSIN, VDIN ) + CALL W3SIN6 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), U10_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), CD(CSEA), DAIR_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), TAUWAX(CSEA), TAUWAY(CSEA), VSIN(:,CSEA), VDIN(:,CSEA) ) #endif - ! - ! 2.b Nonlinear interactions. - ! + END DO ! CSEA; W3SINx + ! + ! 2.b Nonlinear interactions. + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 #ifdef W3_NL1 - IF (IQTPE.GT.0) THEN - CALL W3SNL1 ( SPEC, CG1, WNMEAN*DEPTH, VSNL, VDNL ) - ELSE - CALL W3SNLGQM ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) - END IF + IF (IQTPE.GT.0) THEN + CALL W3SNL1 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), & + WNMEAN(JSEA)*DEPTH(CSEA), VSNL(:,CSEA), VDNL(:,CSEA) ) + ELSE + CALL W3SNLGQM ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), & + DEPTH(CSEA), VSNL(:,CSEA), VDNL(:,CSEA) ) + END IF #endif #ifdef W3_NL2 - CALL W3SNL2 ( SPEC, CG1, DEPTH, VSNL, VDNL ) + CALL W3SNL2 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), DEPTH(CSEA), VSNL(:,CSEA), VDNL(:,CSEA) ) #endif #ifdef W3_NL3 - CALL W3SNL3 ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) + CALL W3SNL3 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), DEPTH(CSEA), VSNL(:,CSEA), VDNL(:,CSEA) ) #endif #ifdef W3_NL4 - CALL W3SNL4 ( SPEC, CG1, WN1, DEPTH, VSNL, VDNL ) + CALL W3SNL4 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), DEPTH(CSEA), VSNL(:,CSEA), VDNL(:,CSEA) ) #endif #ifdef W3_NL5 - CALL W3SNL5 ( SPEC, CG1, WN1, FMEAN, QI5TSTART, & - U10ABS, U10DIR, JSEA, VSNL, VDNL, QR5KURT) + CALL W3SNL5 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), FMEAN(CSEA), QI5TSTART(:,CSEA), & + U10_CHUNK(CSEA), U10D_CHUNK(CSEA), JSEA, VSNL(:,CSEA), VDNL(:,CSEA), QR5KURT) #endif - ! + END DO ! CSEA; W3SNLx + ! #ifdef W3_PDLIB - IF (.NOT. FSSOURCE .or. LSLOC) THEN + IF (.NOT. FSSOURCE .or. LSLOC) THEN #endif #ifdef W3_TR1 - CALL W3STR1 ( SPEC, SPECOLD, CG1, WN1, DEPTH, IX, VSTR, VDTR ) + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + ! Refactor: IX and SPECOLD not used in W3STR1 - removed. + !CALL W3STR1 ( SPEC(:,JSEA), SPECOLD, CG1_CHUNK(:,CSEA), & + CALL W3STR1 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), & + WN1_CHUNK(:,CSEA), DEPTH(CSEA), VSTR(:,CSEA), VDTR(:,CSEA) ) + END DO ! CSEA; W3STR1 #endif #ifdef W3_PDLIB - ENDIF + ENDIF #endif - ! - ! 2.c Dissipation... except for ST4 - ! 2.c1 as in source term package - ! + ! + ! 2.c Dissipation... except for ST4 + ! 2.c1 as in source term package + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_ST1 - CALL W3SDS1 ( SPEC, WN2, EMEAN, FMEAN, WNMEAN, VSDS, VDDS ) + CALL W3SDS1 ( SPEC(:,JSEA), WN2(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), VSDS(:,CSEA), VDDS(:,CSEA) ) #endif #ifdef W3_ST2 - CALL W3SDS2 ( SPEC, CG1, WN1, FPI, USTAR, ALPHA,VSDS, VDDS ) + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + CALL W3SDS2 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), FPI(ISEA), UST_CHUNK(CSEA), ALPHA(:,JSEA), VSDS(:,CSEA), VDDS(:,CSEA) ) #endif #ifdef W3_ST3 - CALL W3SDS3 ( SPEC, WN1, CG1, EMEAN, FMEANS, WNMEAN, & - USTAR, USTDIR, DEPTH, VSDS, VDDS, IX, IY ) +! IX/IY not used... + CALL W3SDS3 ( SPEC(:,JSEA), WN1_CHUNK(:,CSEA), CG1_CHUNK(:,CSEA), EMEAN(CSEA), FMEANS(CSEA), WNMEAN(JSEA), & + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), DEPTH(CSEA), VSDS(:,CSEA), VDDS(:,CSEA), IX(CSEA), IY(CSEA) ) #endif #ifdef W3_ST4 - CALL W3SDS4 ( SPEC, WN1, CG1, USTAR, USTDIR, DEPTH, DAIR, VSDS, & - VDDS, IX, IY, BRLAMBDA, WHITECAP, DLWMEAN ) +! IX/IY not used... + CALL W3SDS4 ( SPEC(:,JSEA), WN1_CHUNK(:,CSEA), CG1_CHUNK(:,CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), DEPTH(CSEA), DAIR_CHUNK(CSEA), VSDS(:,CSEA), & + VDDS(:,CSEA), IX(CSEA), IY(CSEA), BRLAMBDA(:,CSEA), WCAP_COV(JSEA), WCAP_THK(JSEA), WCAP_MNT(JSEA), DLWMEAN(CSEA) ) #endif #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 + IF (IX(CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '2 : W3SDS4(min/max/sum)VSDS=', minval(VSDS(:,CSEA)), maxval(VSDS(:,CSEA)), sum(VSDS(:,CSEA)) + WRITE(740+IAPROC,*) '2 : W3SDS4(min/max/sum)VDDS=', minval(VDDS(:,CSEA)), maxval(VDDS(:,CSEA)), sum(VDDS(:,CSEA)) + END IF #endif #ifdef W3_ST6 - CALL W3SDS6 ( SPEC, CG1, WN1, VSDS, VDDS ) + CALL W3SDS6 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), VSDS(:,CSEA), VDDS(:,CSEA) ) #endif - ! + END DO ! CSEA; W3SDSx + ! #ifdef W3_PDLIB - IF (.NOT. FSSOURCE .or. LSLOC) THEN + IF (.NOT. FSSOURCE .or. LSLOC) THEN #endif #ifdef W3_DB1 - CALL W3SDB1 ( IX, SPEC, DEPTH, EMEAN, FMEAN, WNMEAN, CG1, & - LBREAK, VSDB, VDDB ) + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + + ! Note: LBREAK not used in W3SRCE - can be dummy scalar + ! IX only used for DEBUG + CALL W3SDB1 ( IX(CSEA), SPEC(:,JSEA), DEPTH(CSEA), EMEAN(CSEA), FMEAN(CSEA), & + WNMEAN(JSEA), CG1_CHUNK(:,CSEA), LBREAK, VSDB(:,CSEA), VDDB(:,CSEA) ) + END DO ! CSEA; W3SDBx #endif #ifdef W3_PDLIB - ENDIF + ENDIF #endif - ! - ! 2.c2 optional dissipation parameterisations - ! + ! + ! 2.c2 optional dissipation parameterisations + ! #ifdef W3_ST6 - IF (SWL6S6) THEN - CALL W3SWL6 ( SPEC, CG1, WN1, VSWL, VDWL ) - END IF + IF (SWL6S6) THEN + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + CALL W3SWL6 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), VSWL(:,CSEA), VDWL(:,CSEA) ) + ENDDO ! CSEA; W3SWL6 + END IF #endif - ! - ! 2.d Bottom interactions. - ! + ! + ! 2.d Bottom interactions. + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 #ifdef W3_BT1 - CALL W3SBT1 ( SPEC, CG1, WN1, DEPTH, VSBT, VDBT ) + CALL W3SBT1 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), & + DEPTH(CSEA), VSBT(:,CSEA), VDBT(:,CSEA) ) #endif #ifdef W3_BT4 - CALL W3SBT4 ( SPEC, CG1, WN1, DEPTH, D50, PSIC, TAUBBL, & - BEDFORM, VSBT, VDBT, IX, IY ) +! IX,IY not used + CALL W3SBT4 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), & + DEPTH(CSEA), D50_CHUNK(CSEA), PSIC_CHUNK(CSEA), TAUBBLX(JSEA), TAUBBLY(JSEA), & + BEDROUGH(JSEA), BEDRIPX(JSEA), BEDRIPY(JSEA), VSBT(:,CSEA), VDBT(:,CSEA), IX(CSEA), IY(CSEA) ) #endif #ifdef W3_BT8 - CALL W3SBT8 ( SPEC, DEPTH, VSBT, VDBT, IX, IY ) + CALL W3SBT8 ( SPEC(:,JSEA), DEPTH(CSEA), VSBT(:,CSEA), VDBT(:,CSEA), IX(CSEA), IY(CSEA) ) #endif #ifdef W3_BT9 - CALL W3SBT9 ( SPEC, DEPTH, VSBT, VDBT, IX, IY ) + CALL W3SBT9 ( SPEC(:,JSEA), DEPTH(CSEA), VSBT(:,CSEA), VDBT(:,CSEA), IX(CSEA), IY(CSEA) ) #endif - ! + END DO ! CSEA; W3SBTx +! #ifdef W3_BS1 - CALL W3SBS1 ( SPEC, CG1, WN1, DEPTH, CX, CY, & - TAUSCX, TAUSCY, VSBS, VDBS ) + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + + CALL W3SBS1 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), & + DEPTH(CSEA), CX_CHUNK(CSEA), CY_CHUNK(CSEA), TAUSCX, TAUSCY, VSBS(:,CSEA), VDBS(:,CSEA) ) ! TODO - TAUSC[XY] not used. + END DO ! CSEA; W3SBSx #endif - ! - ! 2.e Unresolved Obstacles Source Term - ! + ! + ! 2.e Unresolved Obstacles Source Term + ! #ifdef W3_UOST - ! UNRESOLVED OBSTACLES - CALL UOST_SRCTRMCOMPUTE(IX, IY, SPEC, CG1, DT, & - U10ABS, U10DIR, VSUO, VDUO) + ! UNRESOLVED OBSTACLES + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + CALL UOST_SRCTRMCOMPUTE(IX(CSEA), IY(CSEA), SPEC(:,JSEA), CG1_CHUNK(:,CSEA), DT(CSEA), & + U10_CHUNK(CSEA), U10D_CHUNK(CSEA), VSUO(:,CSEA), VDUO(:,CSEA)) + END DO ! CSEA; UOST #endif - ! - ! 2.g Dump training data if necessary - ! + ! + ! 2.g Dump training data if necessary + ! #ifdef W3_NNT - 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, & - DTTOT, FLAGNN, DEPTH, U10ABS, U10DIR - ! - IF ( FLAGNN ) THEN - DO IK=1, NK - FACNN = TPI * SIG(IK) / CG1(IK) - DO ITH=1, NTH - IS = ITH + (IK-1)*NTH - FOUT(IK,ITH) = SPEC(IS) * FACNN - SOUT(IK,ITH) = VSNL(IS) * FACNN - 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 - END IF + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + + 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(CSEA), IY(CSEA), TIME, NSTEPS, & + DTTOT, FLAGNN, DEPTH(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA) + ! + IF ( FLAGNN ) THEN + DO JSEA=CHUNK0,CHUNKN + DO IK=1, NK + FACNN = TPI * SIG(IK) / CG1_CHUNK(IK,CSEA) + DO ITH=1, NTH + IS = ITH + (IK-1)*NTH + FOUT(IK,ITH) = SPEC(IS, JSEA) * FACNN + SOUT(IK,ITH) = VSNL(IS, JSEA) * FACNN + DOUT(IK,ITH) = VDNL(IS, JSEA) + 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 + END DO ! ISEA + END IF + END DO ! CSEA; training data #endif - ! - ! 3. Set frequency cut-off ------------------------------------------ * - ! + ! + ! 3. Set frequency cut-off ------------------------------------------ * + ! + ! GPU Refactor - loop over seapoints in chunk: + DO CSEA = 1,NSEAC + ! GPU Refactor - don't integrate if timestep for this spectum + ! is complete, or point is not active. + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_ST2 - FHIGH = XFC * FPI - IF ( FLTEST ) WRITE (NDST,9005) FHIGH*TPIINV + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + FHIGH(CSEA) = XFC * FPI(ISEA) + IF ( FLTEST ) WRITE (NDST,9005) FHIGH*TPIINV #endif - NKH = MIN ( NK , INT(FACTI2+FACTI1*LOG(MAX(1.E-7,FHIGH))) ) - NKH1 = MIN ( NK , NKH+1 ) - NSPECH = NKH1*NTH + NKH(CSEA) = MIN (NK, INT(FACTI2+FACTI1*LOG(MAX(1.E-7,FHIGH(CSEA)))) ) + NKH1(CSEA) = MIN (NK, NKH(CSEA)+1 ) + NSPECH = NKH1(CSEA)*NTH #ifdef W3_T - WRITE (NDST,9021) NKH, NKH1, NSPECH + WRITE (NDST,9021) NKH(CSEA), NKH1(CSEA), NSPECH #endif - ! - ! 4. Summation of source terms and diagonal term and time step ------ * - ! - DT = MIN ( DTG-DTTOT , DTMAX ) - AFILT = MAX ( DAM(NSPEC) , XFLT*AMAX ) - ! - ! For input and dissipation calculate the fraction of the ice-free - ! surface. In the presence of ice, the effective water surface - ! is reduce to a fraction of the cell size free from ice, and so is - ! input : - ! SIN = (1-ICE)**ISCALEIN*SIN and SDS=(1-ICE)**ISCALEDS*SDS ------------------ * - ! INFLAGS2(4) is true if ice concentration was ever read during - ! this simulation - IF ( INFLAGS2(4) ) THEN - VSNL(1:NSPECH) = ICESCALENL * VSNL(1:NSPECH) - VDNL(1:NSPECH) = ICESCALENL * VDNL(1:NSPECH) - VSLN(1:NSPECH) = ICESCALELN * VSLN(1:NSPECH) - VSIN(1:NSPECH) = ICESCALEIN * VSIN(1:NSPECH) - VDIN(1:NSPECH) = ICESCALEIN * VDIN(1:NSPECH) - VSDS(1:NSPECH) = ICESCALEDS * VSDS(1:NSPECH) - VDDS(1:NSPECH) = ICESCALEDS * VDDS(1:NSPECH) - END IF + ! + ! 4. Summation of source terms and diagonal term and time step ------ * + ! + DT(CSEA) = MIN ( DTG-DTTOT(CSEA) , DTMAX ) + AFILT = MAX ( DAM(NSPEC,CSEA) , XFLT*AMAX(CSEA) ) + ! + ! For input and dissipation calculate the fraction of the ice-free + ! surface. In the presence of ice, the effective water surface + ! is reduce to a fraction of the cell size free from ice, and so is + ! input : + ! SIN = (1-ICE)**ISCALEIN*SIN and SDS=(1-ICE)**ISCALEDS*SDS ------------------ * + ! INFLAGS2(4) is true if ice concentration was ever read during + ! this simulation + IF ( INFLAGS2(4) ) THEN + + ! GPU Refactor: ICESCALExx calculations moved from start of routine. + ICESCALELN = MAX(0.,MIN(1.,1.-ICE_CHUNK(CSEA)*ICESCALES(1))) + ICESCALEIN = MAX(0.,MIN(1.,1.-ICE_CHUNK(CSEA)*ICESCALES(2))) + ICESCALENL = MAX(0.,MIN(1.,1.-ICE_CHUNK(CSEA)*ICESCALES(3))) + ICESCALEDS = MAX(0.,MIN(1.,1.-ICE_CHUNK(CSEA)*ICESCALES(4))) + + VSNL(1:NSPECH,CSEA) = ICESCALENL * VSNL(1:NSPECH,CSEA) + VDNL(1:NSPECH,CSEA) = ICESCALENL * VDNL(1:NSPECH,CSEA) + VSLN(1:NSPECH,CSEA) = ICESCALELN * VSLN(1:NSPECH,CSEA) + VSIN(1:NSPECH,CSEA) = ICESCALEIN * VSIN(1:NSPECH,CSEA) + VDIN(1:NSPECH,CSEA) = ICESCALEIN * VDIN(1:NSPECH,CSEA) + VSDS(1:NSPECH,CSEA) = ICESCALEDS * VSDS(1:NSPECH,CSEA) + VDDS(1:NSPECH,CSEA) = ICESCALEDS * VDDS(1:NSPECH,CSEA) + END IF #ifdef W3_PDLIB - IF (B_JGS_LIMITER_FUNC == 2) THEN - DO IK=1, NK - JAC = CG1(IK)/CLATSL - JAC2 = 1./TPI/SIG(IK) - FRLOCAL = SIG(IK)*TPIINV + IF (B_JGS_LIMITER_FUNC == 2) THEN + DO IK=1, NK + JAC = CG1_CHUNK(IK,CSEA)/CLATSL_CHUNK(CSEA) + JAC2 = 1./TPI/SIG(IK) + FRLOCAL = SIG(IK)*TPIINV #ifdef W3_ST6 - DAM2(1+(IK-1)*NTH) = 5E-7 * GRAV/FRLOCAL**4 * USTAR * FMEAN * DTMIN * JAC * JAC2 + DAM2(1+(IK-1)*NTH) = 5E-7 * GRAV/FRLOCAL**4 * UST_CHUNK(CSEA) * FMEAN(CSEA) * DTMIN * JAC * JAC2 #else - DAM2(1+(IK-1)*NTH) = 5E-7 * GRAV/FRLOCAL**4 * USTAR * MAX(FMEANWS,FMEAN) * DTMIN * JAC * JAC2 + DAM2(1+(IK-1)*NTH) = 5E-7 * GRAV/FRLOCAL**4 * UST_CHUNK(CSEA) * MAX(FMEANWS(CSEA),FMEAN(CSEA)) * DTMIN * JAC * JAC2 #endif - !FROM WWM: 5E-7 * GRAV/FR(IS)**4 * USTAR * MAX(FMEANWS(IP),FMEAN(IP)) * DT4S/PI2/SPSIG(IS) - END DO - DO IK=1, NK - IS0 = (IK-1)*NTH - DO ITH=2, NTH - DAM2(ITH+IS0) = DAM2(1+IS0) - END DO - END DO - ENDIF + !FROM WWM: 5E-7 * GRAV/FR(IS)**4 * UST_CHUNK(CSEA) * MAX(FMEANWS(IP),FMEAN(IP)) * DT4S/PI2/SPSIG(IS) + END DO + DO IK=1, NK + IS0 = (IK-1)*NTH + DO ITH=2, NTH + DAM2(ITH+IS0) = DAM2(1+IS0) + END DO + END DO + ENDIF #endif - ! - DO IS=IS1, NSPECH - VS(IS) = VSLN(IS) + VSIN(IS) + VSNL(IS) & - + VSDS(IS) + VSBT(IS) + ! + DO IS=IS1, NSPECH + VS(IS,CSEA) = VSLN(IS,CSEA) + VSIN(IS,CSEA) + VSNL(IS,CSEA) & + + VSDS(IS,CSEA) + VSBT(IS,CSEA) #ifdef W3_ST6 - VS(IS) = VS(IS) + VSWL(IS) + VS(IS,CSEA) = VS(IS,CSEA) + VSWL(IS,CSEA) #endif #if defined(W3_TR1) && !defined(W3_PDLIB) - VS(IS) = VS(IS) + VSTR(IS) + VS(IS,CSEA) = VS(IS,CSEA) + VSTR(IS,CSEA) #endif #ifdef W3_BS1 - VS(IS) = VS(IS) + VSBS(IS) + VS(IS,CSEA) = VS(IS,CSEA) + VSBS(IS,CSEA) #endif #ifdef W3_UOST - VS(IS) = VS(IS) + VSUO(IS) + VS(IS,CSEA) = VS(IS,CSEA) + VSUO(IS,CSEA) #endif - VD(IS) = VDIN(IS) + VDNL(IS) & - + VDDS(IS) + VDBT(IS) + VD(IS,CSEA) = VDIN(IS,CSEA) + VDNL(IS,CSEA) & + + VDDS(IS,CSEA) + VDBT(IS,CSEA) #ifdef W3_ST6 - VD(IS) = VD(IS) + VDWL(IS) + VD(IS,CSEA) = VD(IS,CSEA) + VDWL(IS,CSEA) #endif #if defined(W3_TR1) && !defined(W3_PDLIB) - VD(IS) = VD(IS) + VDTR(IS) + VD(IS,CSEA) = VD(IS,CSEA) + VDTR(IS,CSEA) #endif #ifdef W3_BS1 - VD(IS) = VD(IS) + VDBS(IS) + VD(IS,CSEA) = VD(IS,CSEA) + VDBS(IS,CSEA) #endif #ifdef W3_UOST - VD(IS) = VD(IS) + VDUO(IS) + VD(IS,CSEA) = VD(IS,CSEA) + VDUO(IS,CSEA) #endif - DAMAX = MIN ( DAM(IS) , MAX ( XREL*SPECINIT(IS) , AFILT ) ) - AFAC = 1. / MAX( 1.E-10 , ABS(VS(IS)/DAMAX) ) + DAMAX = MIN ( DAM(IS,CSEA) , MAX ( XREL*SPECINIT(IS,CSEA) , AFILT ) ) + AFAC = 1. / MAX( 1.E-10 , ABS(VS(IS,CSEA)/DAMAX) ) #ifdef W3_NL5 - IF (NL5_SELECT .EQ. 1) THEN - DT = MIN ( DT , AFAC / ( MAX ( 1.E-10, & - 1. + NL5_OFFSET*AFAC*MIN(0.,VD(IS)) ) ) ) - ELSE + IF (NL5_SELECT .EQ. 1) THEN + DT(CSEA) = MIN ( DT(CSEA) , AFAC / ( MAX ( 1.E-10, & + 1. + NL5_OFFSET*AFAC*MIN(0.,VD(IS,CSEA)) ) ) ) + ELSE #endif - DT = MIN ( DT , AFAC / ( MAX ( 1.E-10, & - 1. + OFFSET*AFAC*MIN(0.,VD(IS)) ) ) ) + DT(CSEA) = MIN ( DT(CSEA) , AFAC / ( MAX ( 1.E-10, & + 1. + OFFSET*AFAC*MIN(0.,VD(IS,CSEA)) ) ) ) #ifdef W3_NL5 - ENDIF + ENDIF #endif - END DO ! end of loop on IS + END DO ! end of loop on IS - ! - DT = MAX ( 0.5, DT ) ! The hardcoded min. dt is a problem for certain cases e.g. laborotary scale problems. - ! - DTDYN = DTDYN + DT + ! + DT(CSEA) = MAX ( 0.5, DT(CSEA) ) ! The hardcoded min. dt is a problem for certain cases e.g. laborotary scale problems. + ! + DTDYN(JSEA) = DTDYN(JSEA) + DT(CSEA) #ifdef W3_T - DTRAW = DT + DTRAW = DT(CSEA) #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 ... - 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! - ! + IDT = 1 + INT ( 0.99*(DTG-DTTOT(CSEA))/DT(CSEA) ) ! number of iterations + DT(CSEA) = (DTG-DTTOT(CSEA))/REAL(IDT) ! actualy time step + SHAVE = DT(CSEA).LT.DTMIN .AND. DT(CSEA).LT.DTG-DTTOT(CSEA) ! limiter check ... + IF(PRESENT(SHAVEIO)) SHAVEIO(JSEA) = SHAVE + DT(CSEA) = MAX ( DT(CSEA) , MIN (DTMIN,DTG-DTTOT(CSEA)) ) ! 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 + DT(CSEA) = INT(DT(CSEA)) * 1.0 #endif - IF (srce_call .eq. srce_imp_post) DT = DTG ! for implicit part + IF (srce_call .eq. srce_imp_post) DT(CSEA) = DTG ! for implicit part #ifdef W3_NL5 - IF (NL5_SELECT .EQ. 1) THEN - HDT = NL5_OFFSET * DT - ELSE + IF (NL5_SELECT .EQ. 1) THEN + HDT = NL5_OFFSET * DT(CSEA) + ELSE #endif - HDT = OFFSET * DT + HDT = OFFSET * DT(CSEA) #ifdef W3_NL5 - ENDIF + ENDIF #endif - DTTOT = DTTOT + DT + DTTOT(CSEA) = DTTOT(CSEA) + DT(CSEA) #ifdef W3_DEBUGSRC - IF (IX == DEBUG_NODE) WRITE(*,'(A20,2I10,5F20.10,L20)') 'TIMINGS 2', IDT, NSTEPS, DT, DTMIN, DTDYN, HDT, DTTOT, SHAVE - IF (IX == DEBUG_NODE) THEN - WRITE(740+IAPROC,*) '1: min/max/sum(VS)=', minval(VS), maxval(VS), sum(VS) - WRITE(740+IAPROC,*) '1: min/max/sum(VD)=', minval(VD), maxval(VD), sum(VD) - WRITE(740+IAPROC,*) 'min/max/sum(VSIN)=', minval(VSIN), maxval(VSIN), sum(VSIN) - WRITE(740+IAPROC,*) 'min/max/sum(VDIN)=', minval(VDIN), maxval(VDIN), sum(VDIN) - WRITE(740+IAPROC,*) 'min/max/sum(VSLN)=', minval(VSLN), maxval(VSLN), sum(VSLN) - WRITE(740+IAPROC,*) 'min/max/sum(VSNL)=', minval(VSNL), maxval(VSNL), sum(VSNL) - WRITE(740+IAPROC,*) 'min/max/sum(VDNL)=', minval(VDNL), maxval(VDNL), sum(VDNL) - WRITE(740+IAPROC,*) 'min/max/sum(VSDS)=', minval(VSDS), maxval(VSDS), sum(VSDS) - WRITE(740+IAPROC,*) 'min/max/sum(VDDS)=', minval(VDDS), maxval(VDDS), sum(VDDS) + IF (IX(CSEA) == DEBUG_NODE) WRITE(*,'(A20,2I10,5F20.10,L20)') 'TIMINGS 2', IDT, NSTEPS, DT(CSEA), DTMIN, DTDYN(JSEA), HDT, DTTOT(CSEA), SHAVE + IF (IX(CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '1: min/max/sum(VS)=', minval(VS(:,CSEA)), maxval(VS(:,CSEA)), sum(VS(:,CSEA)) + WRITE(740+IAPROC,*) '1: min/max/sum(VD)=', minval(VD(:,CSEA)), maxval(VD(:,CSEA)), sum(VD(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VSIN)=', minval(VSIN(:,CSEA)), maxval(VSIN(:,CSEA)), sum(VSIN(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VDIN)=', minval(VDIN(:,CSEA)), maxval(VDIN(:,CSEA)), sum(VDIN(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VSLN)=', minval(VSLN(:,CSEA)), maxval(VSLN(:,CSEA)), sum(VSLN(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VSNL)=', minval(VSNL(:,CSEA)), maxval(VSNL(:,CSEA)), sum(VSNL(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VDNL)=', minval(VDNL(:,CSEA)), maxval(VDNL(:,CSEA)), sum(VDNL(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VSDS)=', minval(VSDS(:,CSEA)), maxval(VSDS(:,CSEA)), sum(VSDS(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VDDS)=', minval(VDDS(:,CSEA)), maxval(VDDS(:,CSEA)), sum(VDDS(:,CSEA)) #ifdef W3_ST6 - WRITE(740+IAPROC,*) 'min/max/sum(VSWL)=', minval(VSWL), maxval(VSWL), sum(VSWL) - WRITE(740+IAPROC,*) 'min/max/sum(VDWL)=', minval(VDWL), maxval(VDWL), sum(VDWL) + WRITE(740+IAPROC,*) 'min/max/sum(VSWL)=', minval(VSWL(:,CSEA)), maxval(VSWL(:,CSEA)), sum(VSWL(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VDWL)=', minval(VDWL(:,CSEA)), maxval(VDWL(:,CSEA)), sum(VDWL(:,CSEA)) #endif #ifdef W3_DB1 - WRITE(740+IAPROC,*) 'min/max/sum(VSDB)=', minval(VSDB), maxval(VSDB), sum(VSDB) - WRITE(740+IAPROC,*) 'min/max/sum(VDDB)=', minval(VDDB), maxval(VDDB), sum(VDDB) + WRITE(740+IAPROC,*) 'min/max/sum(VSDB)=', minval(VSDB), maxval(VSDB), sum(VSDB) + WRITE(740+IAPROC,*) 'min/max/sum(VDDB)=', minval(VDDB), maxval(VDDB), sum(VDDB) #endif #ifdef W3_TR1 - WRITE(740+IAPROC,*) 'min/max/sum(VSTR)=', minval(VSTR), maxval(VSTR), sum(VSTR) - WRITE(740+IAPROC,*) 'min/max/sum(VDTR)=', minval(VDTR), maxval(VDTR), sum(VDTR) + WRITE(740+IAPROC,*) 'min/max/sum(VSTR)=', minval(VSTR), maxval(VSTR), sum(VSTR) + WRITE(740+IAPROC,*) 'min/max/sum(VDTR)=', minval(VDTR), maxval(VDTR), sum(VDTR) #endif #ifdef W3_BS1 - WRITE(740+IAPROC,*) 'min/max/sum(VSBS)=', minval(VSBS), maxval(VSBS), sum(VSBS) - WRITE(740+IAPROC,*) 'min/max/sum(VDBS)=', minval(VDBS), maxval(VDBS), sum(VDBS) + WRITE(740+IAPROC,*) 'min/max/sum(VSBS)=', minval(VSBS(:,CSEA)), maxval(VSBS(:,CSEA)), sum(VSBS(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VDBS)=', minval(VDBS(:,CSEA)), maxval(VDBS(:,CSEA)), sum(VDBS(:,CSEA)) #endif - WRITE(740+IAPROC,*) 'min/max/sum(VSBT)=', minval(VSBT), maxval(VSBT), sum(VSBT) - WRITE(740+IAPROC,*) 'min/max/sum(VDBT)=', minval(VDBT), maxval(VDBT), sum(VDBT) - END IF + WRITE(740+IAPROC,*) 'min/max/sum(VSBT)=', minval(VSBT(:,CSEA)), maxval(VSBT(:,CSEA)), sum(VSBT(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(VDBT)=', minval(VDBT(:,CSEA)), maxval(VDBT(:,CSEA)), sum(VDBT(:,CSEA)) + END IF #endif #ifdef W3_PDLIB - IF (srce_call .eq. srce_imp_pre) THEN - IF (LSLOC) THEN - IF (IMEM == 1) THEN - SIDT = PDLIB_SI(JSEA) * DTG - DO IK = 1, NK - JAC = CLATSL/CG1(IK) - DO ITH = 1, NTH - ISP = ITH + (IK-1)*NTH - VD(ISP) = MIN(0., VD(ISP)) - IF (B_JGS_LIMITER_FUNC == 2) THEN - MAXDAC = MAX(DAM(ISP),DAM2(ISP)) - ELSE - MAXDAC = DAM(ISP) - ENDIF - FAKS = DTG / MAX ( 1. , (1.-DTG*VD(ISP))) - DVS = VS(ISP) * FAKS - IF (.NOT. B_JGS_LIMITER) THEN - DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) - ENDIF - PreVS = DVS / FAKS - eVS = PreVS / CG1(IK) * CLATSL - eVD = MIN(0.,VD(ISP)) - 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 + IF (srce_call .eq. srce_imp_pre) THEN + IF (LSLOC) THEN + IF (IMEM == 1) THEN + SIDT = PDLIB_SI(JSEA) * DTG + DO IK = 1, NK + JAC = CLATSL_CHUNK(CSEA)/CG1_CHUNK(IK,CSEA) + DO ITH = 1, NTH + ISP = ITH + (IK-1)*NTH + VD(ISP,CSEA) = MIN(0., VD(ISP,CSEA)) + IF (B_JGS_LIMITER_FUNC == 2) THEN + MAXDAC = MAX(DAM(ISP,CSEA),DAM2(ISP)) + ELSE + MAXDAC = DAM(ISP,CSEA) + ENDIF + FAKS = DTG / MAX ( 1. , (1.-DTG*VD(ISP,CSEA))) + DVS = VS(ISP,CSEA) * FAKS + IF (.NOT. B_JGS_LIMITER) THEN + DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) + ENDIF + PreVS = DVS / FAKS + eVS = PreVS / CG1_CHUNK(IK,CSEA) * CLATSL_CHUNK(CSEA) + eVD = MIN(0.,VD(ISP,CSEA)) + B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * (eVS - eVD*SPEC(ISP,JSEA)*JAC) + ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) = ASPAR_JAC(ISP,PDLIB_I_DIAG(JSEA)) - SIDT * eVD #ifdef W3_DB1 - eVS = VSDB(ISP) * JAC - eVD = MIN(0.,VDDB(ISP)) - IF (eVS .gt. 0.) THEN - evS = 2*evS - evD = -evD - ELSE - 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 + eVS = VSDB(ISP,CSEA) * JAC + eVD = MIN(0.,VDDB(ISP,CSEA)) + IF (eVS .gt. 0.) THEN + evS = 2*evS + evD = -evD + ELSE + 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 #ifdef W3_TR1 - eVS = VSTR(ISP) * JAC - eVD = VDTR(ISP) - IF (eVS .gt. 0.) THEN - evS = 2*evS - evD = -evD - ELSE - 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 - END DO - END DO - - ELSEIF (IMEM == 2) THEN - - SIDT = PDLIB_SI(JSEA) * DTG - DO IK=1,NK - JAC = CLATSL/CG1(IK) - DO ITH=1,NTH - ISP=ITH + (IK-1)*NTH - VD(ISP) = MIN(0., VD(ISP)) - IF (B_JGS_LIMITER_FUNC == 2) THEN - MAXDAC = MAX(DAM(ISP),DAM2(ISP)) - ELSE - MAXDAC = DAM(ISP) - ENDIF - FAKS = DTG / MAX ( 1. , (1.-DTG*VD(ISP))) - DVS = VS(ISP) * FAKS - IF (.NOT. B_JGS_LIMITER) THEN - DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) - ENDIF - PreVS = DVS / FAKS - eVS = PreVS / CG1(IK) * CLATSL - eVD = VD(ISP) + eVS = VSTR(ISP,CSEA) * JAC + eVD = VDTR(ISP,CSEA) + IF (eVS .gt. 0.) THEN + evS = 2*evS + evD = -evD + ELSE + 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 + END DO + END DO + + ELSEIF (IMEM == 2) THEN + + SIDT = PDLIB_SI(JSEA) * DTG + DO IK=1,NK + JAC = CLATSL_CHUNK(CSEA)/CG1_CHUNK(IK,CSEA) + DO ITH=1,NTH + ISP=ITH + (IK-1)*NTH + VD(ISP,CSEA) = MIN(0., VD(ISP,CSEA)) + IF (B_JGS_LIMITER_FUNC == 2) THEN + MAXDAC = MAX(DAM(ISP,CSEA),DAM2(ISP)) + ELSE + MAXDAC = DAM(ISP,CSEA) + ENDIF + FAKS = DTG / MAX ( 1. , (1.-DTG*VD(ISP,CSEA))) + DVS = VS(ISP,CSEA) * FAKS + IF (.NOT. B_JGS_LIMITER) THEN + DVS = SIGN(MIN(MAXDAC,ABS(DVS)),DVS) + ENDIF + PreVS = DVS / FAKS + eVS = PreVS / CG1_CHUNK(IK,CSEA) * CLATSL_CHUNK(CSEA) + eVD = VD(ISP,CSEA) #ifdef W3_DB1 - eVS = eVS + DBLE(VSDB(ISP)) * JAC - eVD = evD + MIN(0.,DBLE(VDDB(ISP))) - B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * (eVS - eVD*VA(ISP,JSEA)) - ASPAR_DIAG_ALL(ISP,JSEA) = ASPAR_DIAG_ALL(ISP,JSEA) - SIDT * eVD -#endif + eVS = eVS + DBLE(VSDB(ISP,CSEA)) * JAC + eVD = evD + MIN(0.,DBLE(VDDB(ISP,CSEA))) + B_JAC(ISP,JSEA) = B_JAC(ISP,JSEA) + SIDT * (eVS - eVD*VA(ISP,JSEA)) + ASPAR_DIAG_ALL(ISP,JSEA) = ASPAR_DIAG_ALL(ISP,JSEA) - SIDT * eVD +#endif + END DO + END DO + ENDIF + ENDIF + + PrintDeltaSmDA=.FALSE. + IF (PrintDeltaSmDA .eqv. .TRUE.) THEN + DO IS=1,NSPEC + DeltaSRC(IS) = VSIN(IS,CSEA) - SPEC(IS,JSEA) * VDIN(IS,CSEA) END DO - END DO - ENDIF - ENDIF - - PrintDeltaSmDA=.FALSE. - IF (PrintDeltaSmDA .eqv. .TRUE.) THEN - DO IS=1,NSPEC - DeltaSRC(IS) = VSIN(IS) - SPEC(IS)*VDIN(IS) - END DO - WRITE(740+IAPROC,*) 'min/max/sum(VSIN)=', minval(VSIN), maxval(VSIN), sum(VSIN) - WRITE(740+IAPROC,*) 'min/max/sum(DeltaIN)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) - ! - DO IS=1,NSPEC - DeltaSRC(IS) = VSNL(IS) - SPEC(IS)*VDNL(IS) - END DO - WRITE(740+IAPROC,*) 'min/max/sum(VSNL)=', minval(VSNL), maxval(VSNL), sum(VSNL) - WRITE(740+IAPROC,*) 'min/max/sum(DeltaNL)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) - ! - DO IS=1,NSPEC - DeltaSRC(IS) = VSDS(IS) - SPEC(IS)*VDDS(IS) - END DO - WRITE(740+IAPROC,*) 'min/max/sum(VSDS)=', minval(VSDS), maxval(VSDS), sum(VSDS) - WRITE(740+IAPROC,*) 'min/max/sum(DeltaDS)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) - ! - ! DO IS=1,NSPEC - ! DeltaSRC(IS) = VSIC(IS) - SPEC(IS)*VDIC(IS) - ! END DO - WRITE(740+IAPROC,*) 'min/max/sum(DeltaDS)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) - END IF + WRITE(740+IAPROC,*) 'min/max/sum(VSIN)=', minval(VSIN(:,CSEA)), maxval(VSIN(:,CSEA)), sum(VSIN(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(DeltaIN)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) + ! + DO IS=1,NSPEC + DeltaSRC(IS) = VSNL(IS,CSEA) - SPEC(IS,JSEA) * VDNL(IS,CSEA) + END DO + WRITE(740+IAPROC,*) 'min/max/sum(VSNL)=', minval(VSNL(:,CSEA)), maxval(VSNL(:,CSEA)), sum(VSNL(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(DeltaNL)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) + ! + DO IS=1,NSPEC + DeltaSRC(IS) = VSDS(IS,CSEA) - SPEC(IS,JSEA) * VDDS(IS,CSEA) + END DO + WRITE(740+IAPROC,*) 'min/max/sum(VSDS)=', minval(VSDS(:,CSEA)), maxval(VSDS(:,CSEA)), sum(VSDS(:,CSEA)) + WRITE(740+IAPROC,*) 'min/max/sum(DeltaDS)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) + ! + ! DO IS=1,NSPEC + ! DeltaSRC(IS) = VSIC(IS) - SPEC(IS, JSEA)*VDIC(IS) + ! END DO + WRITE(740+IAPROC,*) 'min/max/sum(DeltaDS)=', minval(DeltaSRC), maxval(DeltaSRC), sum(DeltaSRC) + END IF - IF (.not. LSLOC) THEN - IF (optionCall .eq. 1) THEN - CALL SIGN_VSD_PATANKAR_WW3(SPEC,VS,VD) - ELSE IF (optionCall .eq. 2) THEN - CALL SIGN_VSD_SEMI_IMPLICIT_WW3(SPEC,VS,VD) - ELSE IF (optionCall .eq. 3) THEN - CALL SIGN_VSD_SEMI_IMPLICIT_WW3(SPEC,VS,VD) - ENDIF - VSIO = VS - VDIO = VD - ENDIF + IF (.not. LSLOC) THEN + ! REFACTOR - TODO: INLINE THESE - they are very small subroutines (one liners almost) + IF (optionCall .eq. 1) THEN + CALL SIGN_VSD_PATANKAR_WW3(SPEC(:,JSEA),VS(:,CSEA),VD(:,CSEA)) + ELSE IF (optionCall .eq. 2) THEN + CALL SIGN_VSD_SEMI_IMPLICIT_WW3(SPEC(:,JSEA),VS(:,CSEA),VD(:,CSEA)) + ELSE IF (optionCall .eq. 3) THEN + CALL SIGN_VSD_SEMI_IMPLICIT_WW3(SPEC(:,JSEA),VS(:,CSEA),VD(:,CSEA)) + ENDIF + IF (.not. LSLOC) THEN ! Refactor notes: This test was originally in W3SRCE + IF(PRESENT(VSIO)) VSIO(:,JSEA) = VS(:,CSEA) + IF(PRESENT(VDIO)) VDIO(:,JSEA) = VD(:,CSEA) + END IF + ENDIF #ifdef W3_DEBUGSRC - IF (IX == DEBUG_NODE) THEN - WRITE(740+IAPROC,*) ' srce_imp_pre : SHAVE = ', SHAVE - WRITE(740+IAPROC,*) ' srce_imp_pre : DT=', DT, ' HDT=', HDT, 'DTG=', DTG - WRITE(740+IAPROC,*) ' srce_imp_pre : sum(SPEC)=', sum(SPEC) - WRITE(740+IAPROC,*) ' srce_imp_pre : sum(VSTOT)=', sum(VS) - WRITE(740+IAPROC,*) ' srce_imp_pre : sum(VDTOT)=', sum(MIN(0. , VD)) - END IF - - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSIN) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDIN) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSDS) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDDS) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSNL) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDNL) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSLN) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSBT) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VS) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VD) -#endif - RETURN ! return everything is done for the implicit ... + IF (IX(CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) ' srce_imp_pre : SHAVE = ', SHAVE + WRITE(740+IAPROC,*) ' srce_imp_pre : DT=', DT(CSEA), ' HDT=', HDT, 'DTG=', DTG + WRITE(740+IAPROC,*) ' srce_imp_pre : sum(SPEC)=', sum(SPEC, JSEA) + WRITE(740+IAPROC,*) ' srce_imp_pre : sum(VSTOT)=', sum(VS(:,CSEA)) + WRITE(740+IAPROC,*) ' srce_imp_pre : sum(VDTOT)=', sum(MIN(0. ,VD(:,CSEA))) + END IF - END IF ! srce_imp_pre + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSIN(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDIN(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSDS(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDDS(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSNL(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDNL(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSLN(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSBT(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VS(:,CSEA)) + IF (IX(CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VD(:,CSEA)) +#endif + !!RETURN ! return everything is done for the implicit ... + + ! GPU Refactor - don't return here. CYCLE instead as we need to process rest + ! of seapoints in tile. A check on "srce_imp_pre" is now made after integration + ! loop is complete. + CYCLE + + END IF ! srce_imp_pre ! --end W3_PDLIB #endif - ! + ! #ifdef W3_T - WRITE (NDST,9040) DTRAW, DT, SHAVE + WRITE (NDST,9040) DTRAW, DT(CSEA), SHAVE #endif - ! - ! 5. Increment spectrum --------------------------------------------- * - ! - IF (srce_call .eq. srce_direct) THEN - IF ( SHAVE ) THEN - DO IS=IS1, NSPECH - eInc1 = VS(IS) * DT / MAX ( 1. , (1.-HDT*VD(IS))) - eInc2 = SIGN ( MIN (DAM(IS),ABS(eInc1)) , eInc1 ) - SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc2 ) - END DO - ELSE ! - DO IS=IS1, NSPECH - eInc1 = VS(IS) * DT / MAX ( 1. , (1.-HDT*VD(IS))) - SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc1 ) - END DO - END IF - ! + ! 5. Increment spectrum --------------------------------------------- * + ! + IF (srce_call .eq. srce_direct) THEN + IF ( SHAVE ) THEN + DO IS=IS1, NSPECH + eInc1 = VS(IS,CSEA) * DT(CSEA) / MAX ( 1. , (1.-HDT*VD(IS,CSEA))) + eInc2 = SIGN ( MIN (DAM(IS,CSEA),ABS(eInc1)) , eInc1 ) + SPEC(IS,JSEA) = MAX ( 0. , SPEC(IS,JSEA)+eInc2 ) + END DO + ELSE + ! + DO IS=IS1, NSPECH + eInc1 = VS(IS,CSEA) * DT(CSEA) / MAX ( 1. , (1.-HDT*VD(IS,CSEA))) + SPEC(IS,JSEA) = MAX ( 0. , SPEC(IS,JSEA)+eInc1 ) + END DO + END IF + ! #ifdef W3_DB1 - DO IS=IS1, NSPECH - eInc1 = VSDB(IS) * DT / MAX ( 1. , (1.-HDT*VDDB(IS))) - SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc1 ) - END DO + DO IS=IS1, NSPECH + eInc1 = VSDB(IS,CSEA) * DT(CSEA) / MAX ( 1. , (1.-HDT*VDDB(IS,CSEA))) + SPEC(IS,JSEA) = MAX ( 0. , SPEC(IS,JSEA)+eInc1 ) + END DO #endif #ifdef W3_TR1 - DO IS=IS1, NSPECH - eInc1 = VDTR(IS) * DT / MAX ( 1. , (1.-HDT*VDTR(IS))) - SPEC(IS) = MAX ( 0. , SPEC(IS)+eInc1 ) - END DO + DO IS=IS1, NSPECH + eInc1 = VDTR(IS,CSEA) * DT(CSEA) / MAX ( 1. , (1.-HDT*VDTR(IS,CSEA))) + SPEC(IS,JSEA) = MAX ( 0. , SPEC(IS,JSEA)+eInc1 ) + END DO #endif #ifdef W3_DEBUGSRC - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSIN) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDIN) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSDS) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDDS) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSNL) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDNL) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSLN) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSBT) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VS) - IF (IX == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VD) - IF (IX == DEBUG_NODE) THEN - WRITE(740+IAPROC,*) ' srce_direct : SHAVE = ', SHAVE - WRITE(740+IAPROC,*) ' srce_direct : DT=', DT, ' HDT=', HDT, 'DTG=', DTG - WRITE(740+IAPROC,*) ' srce_direct : sum(SPEC)=', sum(SPEC) - WRITE(740+IAPROC,*) ' srce_direct : sum(VSTOT)=', sum(VS) - WRITE(740+IAPROC,*) ' srce_direct : sum(VDTOT)=', sum(MIN(0. , VD)) - END IF + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSIN(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDIN(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSDS(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDDS(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSNL(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VDNL(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSLN(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VSBT(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VS(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) WRITE(44,'(1EN15.4)') SUM(VD(:,CSEA)) + IF ((CSEA) == DEBUG_NODE) THEN + WRITE(740+IAPROC,*) ' srce_direct : SHAVE = ', SHAVE + WRITE(740+IAPROC,*) ' srce_direct : DT=', DT(CSEA), ' HDT=', HDT, 'DTG=', DTG + WRITE(740+IAPROC,*) ' srce_direct : sum(SPEC)=', sum(SPEC,JSEA) + WRITE(740+IAPROC,*) ' srce_direct : sum(VSTOT)=', sum(VS(:,CSEA)) + WRITE(740+IAPROC,*) ' srce_direct : sum(VDTOT)=', sum(MIN(0. ,VD(:,CSEA))) + END IF #endif - END IF ! srce_call .eq. srce_direct - ! - ! 5.b Computes - ! atmos->wave flux PHIAW-------------------------------- * - ! wave ->BBL flux PHIBBL------------------------------- * - ! wave ->ice flux PHICE ------------------------------- * - ! - WHITECAP(3)=0. - HSTOT=0. - DO IK=IKS1, NK - FACTOR = DDEN(IK)/CG1(IK) !Jacobian to get energy in band - FACTOR2= FACTOR*GRAV*WN1(IK)/SIG(IK) ! coefficient to get momentum - - ! Wave direction is "direction to" - ! therefore there is a PLUS sign for the stress - DO ITH=1, NTH - IS = (IK-1)*NTH + ITH - COSI(1)=ECOS(IS) - COSI(2)=ESIN(IS) - PHIAW = PHIAW + (VSIN(IS))* DT * FACTOR & - / MAX ( 1. , (1.-HDT*VDIN(IS))) ! semi-implict integration scheme - - PHIBBL= PHIBBL- (VSBT(IS))* DT * FACTOR & - / 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 (VSIN(IS).GT.0.) WHITECAP(3) = WHITECAP(3) + SPEC(IS) * FACTOR - 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 - ! MISSING: TAIL TO BE ADDED ? - ! + END IF ! if src_direct + + END DO ! CSEA/JSEA loop (from section 3) ! TODO: quite a big loop. Split? + + ! GPU Refactor: Everything done for implicit (pre) source call. + if(srce_call .eq. srce_imp_pre) goto 7777 + + ! + ! 5.b Computes + ! atmos->wave flux PHIAW-------------------------------- * + ! wave ->BBL flux PHIBBL------------------------------- * + ! wave ->ice flux PHICE ------------------------------- * + ! + + !! GPU Refactor - loop over chunk + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + + ! HDT Calculation copied from section 3 (to avoid making HDT an array) +#ifdef W3_NL5 + IF (NL5_SELECT .EQ. 1) THEN + HDT = NL5_OFFSET * DT(CSEA) + ELSE +#endif + HDT = OFFSET * DT(CSEA) +#ifdef W3_NL5 + ENDIF +#endif + + WCAP_BHS(JSEA) = 0. + HSTOT=0. + DO IK=IKS1, NK + FACTOR = DDEN(IK)/CG1_CHUNK(IK,CSEA) !Jacobian to get energy in band + FACTOR2= FACTOR*GRAV*WN1_CHUNK(IK,CSEA)/SIG(IK) ! coefficient to get momentum + + ! Wave direction is "direction to" + ! therefore there is a PLUS sign for the stress + DO ITH=1, NTH + IS = (IK-1)*NTH + ITH +!! COSI(1)=ECOS(IS) +!! COSI(2)=ESIN(IS) ! [Refactor] - not used? + PHIAW(JSEA) = PHIAW(JSEA) + (VSIN(IS,CSEA))* DT(CSEA) * FACTOR & + / MAX ( 1. , (1.-HDT*VDIN(IS,CSEA))) ! semi-implict integration scheme + + PHIBBL(JSEA)= PHIBBL(JSEA) - (VSBT(IS,CSEA))* DT(CSEA) * FACTOR & + / MAX ( 1. , (1.-HDT*VDBT(IS,CSEA))) ! semi-implict integration scheme + +! ! PHINL is calculated but never used; I have commented out (Chris Bunney): +! PHINL = PHINL + VSNL(IS,CSEA)* DT(CSEA) * FACTOR & +! / MAX ( 1. , (1.-HDT*VDNL(IS,CSEA))) ! semi-implict integration scheme + IF (VSIN(IS,CSEA).GT.0.) WCAP_BHS(JSEA) = WCAP_BHS(JSEA) + SPEC(IS,JSEA) * FACTOR + HSTOT = HSTOT + SPEC(IS,JSEA) * FACTOR + END DO + END DO + WCAP_BHS(JSEA) = 4. * SQRT(WCAP_BHS(JSEA)) + HSTOT = 4.*SQRT(HSTOT) + TAUWIX(JSEA) = TAUWIX(JSEA) + TAUWX(JSEA) * DRAT(CSEA) * DT(CSEA) + TAUWIY(JSEA) = TAUWIY(JSEA) + TAUWY(JSEA) * DRAT(CSEA) * DT(CSEA) + TAUWNX(JSEA) = TAUWNX(JSEA) + TAUWAX(CSEA) * DRAT(CSEA) * DT(CSEA) + TAUWNY(JSEA) = TAUWNY(JSEA) + TAUWAY(CSEA) * DRAT(CSEA) * DT(CSEA) + ! MISSING: TAIL TO BE ADDED ? + ! + ENDDO ! CSEA + #ifdef W3_NLS - CALL W3SNLS ( SPEC, CG1, WN1, DEPTH, U10ABS, DT, AA=SPEC ) + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + CALL W3SNLS ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), DEPTH(CSEA), U10_CHUNK(CSEA), DT(CSEA), AA=SPEC(:,JSEA) ) + END DO ! CSEA; W3SNLS #endif - ! - ! 6. Add tail ------------------------------------------------------- * - ! a Mean parameters - ! - ! + ! + ! 6. Add tail ------------------------------------------------------- * + ! a Mean parameters + ! + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_ST0 - CALL W3SPR0 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) + CALL W3SPR0 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA)) #endif #ifdef W3_ST1 - CALL W3SPR1 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX) + CALL W3SPR1 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA)) #endif #ifdef W3_ST2 - CALL W3SPR2 (SPEC, CG1, WN1, DEPTH, FPI, U10ABS, USTAR, & - EMEAN, FMEAN, WNMEAN, AMAX, ALPHA, FP ) + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + CALL W3SPR2 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), DEPTH(CSEA), FPI(ISEA), U10_CHUNK(CSEA), UST_CHUNK(CSEA), & + EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA), ALPHA(:,JSEA), FP(CSEA) ) #endif #ifdef W3_ST3 - CALL W3SPR3 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEANS, & - WNMEAN, AMAX, U10ABS, U10DIR, USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS) + CALL W3SPR3 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), FMEANS(CSEA), & + WNMEAN(JSEA), AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), LLWS(:,CSEA), FMEANWS(CSEA)) #endif #ifdef W3_ST4 - CALL W3SPR4 (SPEC, CG1, WN1, EMEAN, FMEAN, FMEAN1, WNMEAN,& - AMAX, U10ABS, U10DIR, & + CALL W3SPR4 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), FMEAN1(CSEA), WNMEAN(JSEA),& + AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & #ifdef W3_FLX5 - TAUA, TAUADIR, DAIR, & + TAUA_CHUNK(CSEA), TAUADIR_CHUNK(CSEA), DAIR_CHUNK(CSEA), & #endif - USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), LLWS(:,CSEA), FMEANWS(CSEA), DLWMEAN(CSEA)) #endif #ifdef W3_ST6 - CALL W3SPR6 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX, FP) + CALL W3SPR6 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), FMEAN(CSEA), WNMEAN(JSEA), AMAX(CSEA), FP(CSEA)) #endif - ! + END DO ! CSEA; W3SPRx + + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 #ifdef W3_FLX2 - CALL W3FLX2 ( ZWND, DEPTH, FP, U10ABS, U10DIR, & - USTAR, USTDIR, Z0, CD ) + CALL W3FLX2 ( ZWND, DEPTH(CSEA), FP(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA) ) #endif #ifdef W3_FLX3 - CALL W3FLX3 ( ZWND, DEPTH, FP, U10ABS, U10DIR, & - USTAR, USTDIR, Z0, CD ) + CALL W3FLX3 ( ZWND, DEPTH(CSEA), FP(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA), CD(CSEA) ) #endif - ! + END DO ! CSEA; W3FLXx +! +! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_ST1 - FH1 = FXFM * FMEAN - FHIGH = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) - NKH = MAX ( 2 , MIN ( NKH1 , & - INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) - ! - IF ( FLTEST ) WRITE (NDST,9060) & - FH1*TPIINV, FH2*TPIINV, FHIGH*TPIINV, NKH + FH1 = FXFM * FMEAN(CSEA) + FH2 = FXPM / UST_CHUNK(CSEA) ! GPU refactor - had to recalculate FH2 here + FHIGH(CSEA) = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) + NKH(CSEA) = MAX ( 2 , MIN ( NKH1(CSEA) , & + INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH(CSEA))) ) ) ) + ! + IF ( FLTEST ) WRITE (NDST,9060) & + FH1*TPIINV, FH2*TPIINV, FHIGH(CSEA)*TPIINV, NKH(CSEA) #endif - ! + ! #ifdef W3_ST2 - FHTRAN = XFT*FPI - FHIGH = XFC*FPI - DFH = FHIGH - FHTRAN - NKH = MAX ( 1 , & - INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHTRAN)) ) ) - ! - IF ( FLTEST ) WRITE (NDST,9061) FHTRAN, FHIGH, NKH + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + FHTRAN = XFT*FPI(ISEA) + FHIGH(CSEA) = XFC*FPI(ISEA) + DFH = FHIGH(CSEA) - FHTRAN + NKH(CSEA) = MAX ( 1 , & + INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHTRAN)) ) ) + + IF ( FLTEST ) WRITE (NDST,9061) FHTRAN, FHIGH(CSEA), NKH(CSEA) #endif - ! + ! #ifdef W3_ST3 - FH1 = FFXFM * FMEAN - FH2 = FFXPM / USTAR - FHIGH = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) - NKH = MAX ( 2 , MIN ( NKH1 , & - INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) - ! - IF ( FLTEST ) WRITE (NDST,9062) & - FH1*TPIINV, FH2*TPIINV, FHIGH*TPIINV, NKH + FH1 = FFXFM * FMEAN(CSEA) + FH2 = FFXPM / UST_CHUNK(CSEA) + FHIGH(CSEA) = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) + NKH(CSEA) = MAX ( 2 , MIN ( NKH1(CSEA) , & + INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH(CSEA))) ) ) ) + ! + IF ( FLTEST ) WRITE (NDST,9062) & + FH1*TPIINV, FH2*TPIINV, FHIGH(CSEA)*TPIINV, NKH(CSEA) #endif - ! + ! #ifdef W3_ST4 - ! Introduces a Long & Resio (JGR2007) type dependance on wave age - FAGE = FFXFA*TANH(0.3*U10ABS*FMEANWS*TPI/GRAV) - FH1 = (FFXFM+FAGE) * FMEAN1 - FH2 = FFXPM / USTAR - FHIGH = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) - NKH = MAX ( 2 , MIN ( NKH1 , & - INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) + ! Introduces a Long & Resio (JGR2007) type dependance on wave age + FAGE(CSEA) = FFXFA*TANH(0.3*U10_CHUNK(CSEA)*FMEANWS(CSEA)*TPI/GRAV) + FH1 = (FFXFM+FAGE(CSEA)) * FMEAN1(CSEA) + FH2 = FFXPM / UST_CHUNK(CSEA) + FHIGH(CSEA) = MIN ( SIG(NK) , MAX ( FH1 , FH2 ) ) + NKH(CSEA) = MAX ( 2 , MIN ( NKH1(CSEA), & + INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH(CSEA))) ) ) ) #endif - ! + ! #ifdef W3_ST6 - IF (FXFM .LE. 0) THEN - FHIGH = SIG(NK) - ELSE - FHIGH = MIN ( SIG(NK), MAX(FXFM * FMEAN, FXPM / USTAR) ) - ENDIF - NKH = MAX ( 2 , MIN ( NKH1 , & - INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH)) ) ) ) - ! - IF ( FLTEST ) WRITE (NDST,9063) FHIGH*TPIINV, NKH + IF (FXFM .LE. 0) THEN + FHIGH(CSEA) = SIG(NK) + ELSE + FHIGH(CSEA) = MIN ( SIG(NK), MAX(FXFM * FMEAN(CSEA), FXPM / UST_CHUNK(CSEA)) ) + ENDIF + NKH(CSEA) = MAX ( 2 , MIN ( NKH1(CSEA) , & + INT ( FACTI2 + FACTI1*LOG(MAX(1.E-7,FHIGH(CSEA))) ) ) ) + ! + IF ( FLTEST ) WRITE (NDST,9063) FHIGH(CSEA)*TPIINV, NKH(CSEA) #endif - ! - ! 6.b Limiter for shallow water or Miche style criterion - ! Last time step ONLY ! - ! uses true depth (D_INP) instead of limited depth - ! + ! + ! 6.b Limiter for shallow water or Miche style criterion + ! Last time step ONLY ! + ! uses true depth (D_INP) instead of limited depth + ! #ifdef W3_MLIM - IF ( DTTOT .GE. 0.9999*DTG ) THEN - HM = FHMAX *TANH(WNMEAN*MAX(0.,D_INP)) / MAX(1.E-4,WNMEAN ) - EM = HM * HM / 16. - IF ( EMEAN.GT.EM .AND. EMEAN.GT.1.E-30 ) THEN - SPEC = SPEC / EMEAN * EM - EMEAN = EM - END IF - END IF + IF ( DTTOT(CSEA) .GE. 0.9999*DTG ) THEN + ! Refactor - need ISEA here for D_INP. Impact is likely small, so + ! calculate rather than have an extra _CHUNK variable. + CALL INIT_GET_ISEA(ISEA, JSEA) !!! SLOW! + + HM = FHMAX *TANH(WNMEAN(JSEA)*MAX(0.,D_INP(ISEA))) / MAX(1.E-4,WNMEAN(JSEA) ) + EM = HM * HM / 16. + IF ( EMEAN(CSEA).GT.EM .AND. EMEAN(CSEA).GT.1.E-30 ) THEN + SPEC(:,JSEA) = SPEC(:,JSEA) / EMEAN(CSEA) * EM + EMEAN(CSEA) = EM + END IF + END IF #endif - ! - ! 6.c Seeding of spectrum - ! alpha = 0.005 , 0.5 in eq., 0.25 for directional distribution - ! + ! + ! 6.c Seeding of spectrum + ! alpha = 0.005 , 0.5 in eq., 0.25 for directional distribution + ! #ifdef W3_SEED - DO IK=MIN(NK,NKH), NK - UC = FACSD * GRAV / SIG(IK) - SLEV = MIN ( 1. , MAX ( 0. , U10ABS/UC-1. ) ) * & - 6.25E-4 / WN1(IK)**3 / SIG(IK) - IF (INFLAGS2(4)) SLEV=SLEV*(1-ICE) - DO ITH=1, NTH - SPEC(ITH+(IK-1)*NTH) = MAX ( SPEC(ITH+(IK-1)*NTH) , & - SLEV * MAX ( 0. , COS(U10DIR-TH(ITH)) )**2 ) - END DO - END DO + DO IK=MIN(NK,NKH(CSEA)), NK + UC = FACSD * GRAV / SIG(IK) + SLEV = MIN ( 1. , MAX ( 0. , U10_CHUNK(CSEA)/UC-1. ) ) * & + 6.25E-4 / WN1_CHUNK(IK,CSEA)**3 / SIG(IK) + IF (INFLAGS2(4)) SLEV=SLEV*(1-ICE_CHUNK(CSEA)) + DO ITH=1, NTH + SPEC(ITH+(IK-1)*NTH,JSEA) = MAX ( SPEC(ITH+(IK-1)*NTH,JSEA) , & + SLEV * MAX ( 0. , COS(U10D_CHUNK(CSEA)-TH(ITH)) )**2 ) + END DO + END DO #endif - ! - ! 6.d Add tail - ! - DO IK=NKH+1, NK + ! + ! 6.d Add tail + ! + DO IK=NKH(CSEA)+1, NK #ifdef W3_ST2 - FACDIA = MAX ( 0. , MIN ( 1., (SIG(IK)-FHTRAN)/DFH) ) - FACPAR = MAX ( 0. , 1.-FACDIA ) + FACDIA = MAX ( 0. , MIN ( 1., (SIG(IK)-FHTRAN)/DFH) ) + FACPAR = MAX ( 0. , 1.-FACDIA ) #endif - DO ITH=1, NTH - SPEC(ITH+(IK-1)*NTH) = SPEC(ITH+(IK-2)*NTH) * FACHFA & + DO ITH=1, NTH + SPEC(ITH+(IK-1)*NTH,JSEA) = SPEC(ITH+(IK-2)*NTH,JSEA) * FACHFA & #ifdef W3_ST2 - * FACDIA + FACPAR * SPEC(ITH+(IK-1)*NTH) & + * FACDIA + FACPAR * SPEC(ITH+(IK-1)*NTH,JSEA) & #endif - + 0. - END DO - END DO - ! - ! 6.e Update wave-supported stress----------------------------------- * - ! + + 0. + END DO + END DO + END DO ! CSEA/JSEA (section 6.a) + ! + ! 6.e Update wave-supported stress----------------------------------- * + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_ST3 - CALL W3SIN3 ( SPEC, CG1, WN2, U10ABS, USTAR, DRAT, AS, & - U10DIR, Z0, CD, TAUWX, TAUWY, TAUWAX, TAUWAY, & - ICE, VSIN, VDIN, LLWS, IX, IY ) + CALL W3SIN3 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), & + U10_CHUNK(CSEA), UST_CHUNK(CSEA), DRAT(CSEA), AS_CHUNK(CSEA), & + U10D_CHUNK(CSEA), Z0(CSEA), CD(CSEA), TAUWX(JSEA), TAUWY(JSEA), & + TAUWAX(CSEA), TAUWAY(CSEA), & + ICE_CHUNK(CSEA), VSIN(:,CSEA), VDIN(:,CSEA), LLWS(:,CSEA), IX(CSEA), IY(CSEA) ) #endif #ifdef W3_ST4 - 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, & + CALL W3SIN4 ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN2(:,CSEA), & + U10_CHUNK(CSEA), UST_CHUNK(CSEA), DRAT(CSEA), AS_CHUNK(CSEA), & + U10D_CHUNK(CSEA), Z0(CSEA), CD(CSEA), TAUWX(JSEA), TAUWY(JSEA), & + TAUWAX(CSEA), TAUWAY(CSEA), & + VSIN(:,CSEA), VDIN(:,CSEA), LLWS(:,CSEA), IX(CSEA), IY(CSEA), BRLAMBDA(:,CSEA) ) + IF (SINTAILPAR(4).LT.0.5) THEN + CALL W3SPR4 (SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), & + FMEAN(CSEA), FMEAN1(CSEA), WNMEAN(JSEA), AMAX(CSEA), U10_CHUNK(CSEA), U10D_CHUNK(CSEA), & #ifdef W3_FLX5 - TAUA, TAUADIR, DAIR, & + TAUA_CHUNK(CSEA), TAUADIR_CHUNK(CSEA), DAIR_CHUNK(CSEA), & #endif - USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + UST_CHUNK(CSEA), USTD_CHUNK(CSEA), & + TAUWX(JSEA), TAUWY(JSEA), CD(CSEA), Z0(CSEA), CHARN(JSEA), & + LLWS(:,CSEA), FMEANWS(CSEA), DLWMEAN(CSEA)) + ENDIF #endif - ! - ! 7. Check if integration complete ---------------------------------- * - ! - ! Update QI5TSTART (Q. Liu) + END DO ! CSEA; W3SINx + + ! + ! 7. Check if integration complete ---------------------------------- * + ! + ! Update QI5TSTART (Q. Liu) #ifdef W3_NL5 - CALL TICK21(QI5TSTART, DT) + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + CALL TICK21(QI5TSTART(:,CSEA), DT(CSEA)) + END DO #endif - IF (srce_call .eq. srce_imp_post) THEN - EXIT - ENDIF + IF (srce_call .eq. srce_imp_post) THEN + DTDYN(CHUNK0:CHUNKN) = DTDYN(CHUNK0:CHUNKN) / REAL(MAX(1,NSTEPS)) + EXIT + ENDIF - IF ( DTTOT .GE. 0.9999*DTG ) THEN - ! IF (IX == DEBUG_NODE) WRITE(*,*) 'DTTOT, DTG', DTTOT, DTG - EXIT - ENDIF +! Note: Leaving these ACC statements here for now - will be useful for GPU port. +!$ACC DATA COPYOUT(COMPLETE) +!$ACC PARALLEL + ! GPU refactor: Update source mask with seapoints that have completed + ! timestepping: + !!WHERE(DTTOT(:NSEAC) .GE. 0.9999*DTG) SRC_MASK(:NSEAC) = .TRUE. + DO CSEA=1,NSEAC + IF(DTTOT(CSEA) .GE. 0.9999*DTG .AND. .NOT. SRC_MASK(CSEA)) THEN + ! Time stepping complete. Set mask to true and calculate DTDYN + SRC_MASK(CSEA) = .TRUE. + JSEA = CHUNK0 + CSEA - 1 + DTDYN(JSEA) = DTDYN(JSEA) / REAL(MAX(1,NSTEPS)) + END IF + END DO + + COMPLETE = ALL(SRC_MASK(:NSEAC)) ! GPU Refactor - store in scalar and return +!$ACC END PARALLEL +!$ACC END DATA + + ! Complete is true if all _active_ points have finished integration loop + IF(COMPLETE) THEN + EXIT + ENDIF + + END DO ! INTEGRATION LOOP - END DO ! INTEGRATION LOOP + ! Refactor - if implicit (pre), then we are all done - cycle chunk loop + IF(srce_call .eq. srce_imp_pre) THEN + GOTO 7777 + ENDIF #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) 'NSTEPS=', NSTEPS - WRITE(740+IAPROC,*) '1 : sum(SPEC)=', sum(SPEC) - END IF - WRITE(740+IAPROC,*) 'DT=', DT, 'DTG=', DTG + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) 'NSTEPS=', NSTEPS + WRITE(740+IAPROC,*) '1 : sum(SPEC)=', sum(SPEC) + END IF + WRITE(740+IAPROC,*) 'DT=', DT(CSEA), 'DTG=', DTG #endif - ! - ! ... End point dynamic integration - - - - - - - - - - - - - - - - - - - ! - ! 8. Save integration data ------------------------------------------ * - ! - DTDYN = DTDYN / REAL(MAX(1,NSTEPS)) - FCUT = FHIGH * TPIINV - ! - GOTO 888 - ! - ! Error escape locations - ! + ! + ! ... End point dynamic integration - - - - - - - - - - - - - - - - - - + ! + ! 8. Save integration data ------------------------------------------ * + ! + ! TODO: Need a better solution than recalculating. + ! Integer source mask? 0 = active, 1=masked(or complete), 2=masked+complete + I = 1 + DO JSEA=CHUNK0,CHUNKN + ! TODO - THIS BLOCK TEMPORARY - NEED BETTER SOLUTION THAN RECALCULATING SRC_MASK + CALL INIT_GET_ISEA(ISEA, JSEA) !!! SLOW! + SRC_MASK(I) = .NOT. (MAPSTA(IY(I),IX(I)) .EQ. 1 .AND. FLAGST(ISEA)) + I = I + 1 + ENDDO ! END TEMPORARY SOLUTION FOR SRC_MASK + + DO CSEA=1,NSEAC + JSEA = CHUNK0 + CSEA - 1 + IF(SRC_MASK(CSEA)) CYCLE + !DTDYN(JSEA) = DTDYN(JSEA) / REAL(MAX(1,NSTEPS)) ! Refactor: Moved to section 7 + FCUT(JSEA) = FHIGH(CSEA) * TPIINV + ENDDO + ! + GOTO 888 + ! + ! Error escape locations + ! #ifdef W3_NNT 800 CONTINUE - WRITE (NDSE,8000) FNAME, IERR - CALL EXTCDE (1) - ! + WRITE (NDSE,8000) FNAME, IERR + CALL EXTCDE (1) + ! 801 CONTINUE - WRITE (NDSE,8001) IERR - CALL EXTCDE (2) + 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 - ! and final energy, plus wind input plus the SNL flux to high freq., - ! minus the energy lost to the bottom boundary layer (BBL) - ! + ! + ! 9.a Computes PHIOC------------------------------------------ * + ! The wave to ocean flux is the difference between initial energy + ! and final energy, plus wind input plus the SNL flux to high freq., + ! minus the energy lost to the bottom boundary layer (BBL) + ! #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) '2 : sum(SPEC)=', sum(SPEC) - END IF + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '2 : sum(SPEC)=', sum(SPEC) + END IF #endif - EFINISH = 0. - MWXFINISH = 0. - MWYFINISH = 0. - DO IK=1, NK - EBAND = 0. - A1BAND = 0. - B1BAND = 0. - DO ITH=1, NTH - DIFF = SPECINIT(ITH+(IK-1)*NTH)-SPEC(ITH+(IK-1)*NTH) - EBAND = EBAND + DIFF - A1BAND = A1BAND + DIFF*ECOS(ITH) - B1BAND = B1BAND + DIFF*ESIN(ITH) - END DO - EFINISH = EFINISH + EBAND * DDEN(IK) / CG1(IK) - MWXFINISH = MWXFINISH + A1BAND * DDEN(IK) / CG1(IK) & - * WN1(IK)/SIG(IK) - MWYFINISH = MWYFINISH + B1BAND * DDEN(IK) / CG1(IK) & - * WN1(IK)/SIG(IK) - END DO - ! - ! Transformation in momentum flux in m^2 / s^2 - ! - TAUOX=(GRAV*MWXFINISH+TAUWIX-TAUBBL(1))/DTG - TAUOY=(GRAV*MWYFINISH+TAUWIY-TAUBBL(2))/DTG - TAUWIX=TAUWIX/DTG - TAUWIY=TAUWIY/DTG - TAUWNX=TAUWNX/DTG - TAUWNY=TAUWNY/DTG - TAUBBL(:)=TAUBBL(:)/DTG - TAUOCX=DAIR*COEF*COEF*USTAR*USTAR*COS(USTDIR) + DWAT*(TAUOX-TAUWIX) - TAUOCY=DAIR*COEF*COEF*USTAR*USTAR*SIN(USTDIR) + DWAT*(TAUOY-TAUWIY) - ! - ! Transformation in wave energy flux in W/m^2=kg / s^3 - ! - PHIOC =DWAT*GRAV*(EFINISH+PHIAW-PHIBBL)/DTG - PHIAW =DWAT*GRAV*PHIAW /DTG - PHINL =DWAT*GRAV*PHINL /DTG - PHIBBL=DWAT*GRAV*PHIBBL/DTG - ! - ! 10.1 Adds ice scattering and dissipation: implicit integration---------------- * - ! INFLAGS2(4) is true if ice concentration was ever read during - ! this simulation - ! + !! GPU Refactor - loop over chunk elements + DO CSEA = 1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + + EFINISH = 0. + MWXFINISH = 0. + MWYFINISH = 0. + DO IK=1, NK + EBAND = 0. + A1BAND = 0. + B1BAND = 0. + DO ITH=1, NTH + DIFF = SPECINIT(ITH+(IK-1)*NTH,CSEA)-SPEC(ITH+(IK-1)*NTH,JSEA) + EBAND = EBAND + DIFF + A1BAND = A1BAND + DIFF*ECOS(ITH) + B1BAND = B1BAND + DIFF*ESIN(ITH) + END DO + EFINISH = EFINISH + EBAND * DDEN(IK) / CG1_CHUNK(IK,CSEA) + MWXFINISH = MWXFINISH + A1BAND * DDEN(IK) / CG1_CHUNK(IK,CSEA) & + * WN1_CHUNK(IK,CSEA)/SIG(IK) + MWYFINISH = MWYFINISH + B1BAND * DDEN(IK) / CG1_CHUNK(IK,CSEA) & + * WN1_CHUNK(IK,CSEA)/SIG(IK) + END DO + ! + ! Transformation in momentum flux in m^2 / s^2 + ! + TAUOX(JSEA) = (GRAV*MWXFINISH+TAUWIX(JSEA)-TAUBBLX(JSEA))/DTG + TAUOY(JSEA) = (GRAV*MWYFINISH+TAUWIY(JSEA)-TAUBBLY(JSEA))/DTG + TAUWIX(JSEA) = TAUWIX(JSEA)/DTG + TAUWIY(JSEA) = TAUWIY(JSEA)/DTG + TAUWNX(JSEA) = TAUWNX(JSEA)/DTG + TAUWNY(JSEA) = TAUWNY(JSEA)/DTG + TAUBBLX(JSEA) = TAUBBLX(JSEA)/DTG + TAUBBLY(JSEA) = TAUBBLY(JSEA)/DTG + TAUOCX(JSEA)= DAIR_CHUNK(CSEA)*COEF_CHUNK(CSEA)*COEF_CHUNK(CSEA)*UST_CHUNK(CSEA)*UST_CHUNK(CSEA)*COS(USTD_CHUNK(CSEA)) + DWAT*(TAUOX(JSEA)-TAUWIX(JSEA)) + TAUOCY(JSEA)= DAIR_CHUNK(CSEA)*COEF_CHUNK(CSEA)*COEF_CHUNK(CSEA)*UST_CHUNK(CSEA)*UST_CHUNK(CSEA)*SIN(USTD_CHUNK(CSEA)) + DWAT*(TAUOY(JSEA)-TAUWIY(JSEA)) + ! + ! Transformation in wave energy flux in W/m^2=kg / s^3 + ! + PHIOC(JSEA) = DWAT * GRAV * (EFINISH + PHIAW(JSEA) - PHIBBL(JSEA)) / DTG + PHIAW(JSEA) = DWAT * GRAV * PHIAW(JSEA) / DTG + ! PHINL is calculated but never used; I have commented out (Chris Bunney): + !PHINL = DWAT * GRAV * PHINL / DTG ! GPU Refactor: NOT USED ANYWHERE. REMOVE? + PHIBBL(JSEA) = DWAT * GRAV * PHIBBL(JSEA) / DTG + END DO ! CSEA/JSEA + ! + ! 10.1 Adds ice scattering and dissipation: implicit integration---------------- * + ! INFLAGS2(4) is true if ice concentration was ever read during + ! this simulation + ! #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) '3 : sum(SPEC)=', sum(SPEC) - END IF + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '3 : sum(SPEC)=', sum(SPEC) + END IF #endif + !! GPU Refactor - loop over chunk elements + !IF ( INFLAGS2(4).AND.ICE.GT.0 ) THEN ! GPU refactor: have split this expression + ! TODO: This is a very big loop (CSEA) - probably needs refactoring + ! into smaller loops + IF( INFLAGS2(4) ) THEN + DO CSEA = 1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + ! GPU Refactor: Zero TAUICE and PHIICE here; for B4B reproducibility. Chris Bunney. + TAUICEX(JSEA) = 0. + TAUICEY(JSEA) = 0. + PHICE(JSEA) = 0. + + IF(ICE_CHUNK(CSEA) .EQ. 0) THEN +#ifdef W3_IS2 + IF(IS2PARS(10).LT.0.5) THEN + ICEF_CHUNK(CSEA) = 0. + ENDIF +#endif + CYCLE + ENDIF - IF ( INFLAGS2(4).AND.ICE.GT.0 ) THEN + JSEA = CHUNK0 + CSEA - 1 - IF (IICEDISP) THEN - ICECOEF2 = 1E-6 - CALL LIU_FORWARD_DISPERSION (ICEH,ICECOEF2,DEPTH, & - SIG,WN_R,CG_ICE,ALPHA_LIU) - ! - IF (IICESMOOTH) THEN + IF (IICEDISP) THEN + ICECOEF2 = 1E-6 + CALL LIU_FORWARD_DISPERSION (ICEH_CHUNK(CSEA),ICECOEF2,DEPTH(CSEA), & + SIG,WN_R,CG_ICE,ALPHA_LIU) + ! + 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_CHUNK(CSEA)) THEN ! IF ICE IS NOT TOO MUCH BROKEN + SMOOTH_ICEDISP=TANH((ICEF_CHUNK(CSEA)-IS2PARS(14)*(TPI/WN_R(IK)))/(ICEF_CHUNK(CSEA)*IS2PARS(13))) + END IF + WN_R(IK)=WN1_CHUNK(IK,CSEA)*(1-SMOOTH_ICEDISP)+WN_R(IK)*(SMOOTH_ICEDISP) + END DO #endif - END IF - ELSE - WN_R=WN1 - CG_ICE=CG1 - END IF - ! - R(:)=1 ! In case IC2 is defined but not IS2 - ! + END IF + ELSE + WN_R=WN1_CHUNK(:,CSEA) + CG_ICE=CG1_CHUNK(:,CSEA) + END IF + ! + R(:)=1 ! TODO - MOVE THIS OUTSIDE LOOP?? ! In case IC2 is defined but not IS2 !!TODO - needs to be a chunk variable (or does it?) + ! #ifdef W3_IC1 - CALL W3SIC1 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) + CALL W3SIC1 ( SPEC(:,JSEA),DEPTH(CSEA), CG1_CHUNK(:,CSEA), IX(CSEA), IY(CSEA), 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 ) + CALL W3SIS2 ( SPEC(:,JSEA), DEPTH(CSEA), ICE_CHUNK(CSEA), ICEH_CHUNK(CSEA), ICEF_CHUNK(CSEA), ICEDMAX_CHUNK(CSEA), IX(CSEA), IY(CSEA), & + VSIR, VDIR, VDIR2, WN1_CHUNK(:,CSEA), CG1_CHUNK(:,CSEA), 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) + CALL W3SIC2 ( SPEC(:,JSEA), DEPTH(CSEA), ICEH_CHUNK(CSEA), ICEF_CHUNK(CSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA),& + IX(CSEA), IY(CSEA), 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(:,JSEA), DEPTH(CSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), IX(CSEA), IY(CSEA), VSIC, VDIC ) #endif #ifdef W3_IC4 - CALL W3SIC4 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) + CALL W3SIC4 ( SPEC(:,JSEA), DEPTH(CSEA), CG1_CHUNK(:,CSEA), IX(CSEA), IY(CSEA), VSIC, VDIC ) #endif #ifdef W3_IC5 - CALL W3SIC5 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) + CALL W3SIC5 ( SPEC(:,JSEA), DEPTH(CSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), IX(CSEA), IY(CSEA), VSIC, VDIC ) #endif - ! + ! #ifdef W3_IS1 - CALL W3SIS1 ( SPEC, ICE, VSIR ) -#endif - SPEC2 = SPEC - ! - 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) -#endif -#ifdef W3_IC2 - ATT=EXP(ICE*VDIC(IS)*DTG) + CALL W3SIS1 ( SPEC(:,JSEA), ICE_CHUNK(CSEA), VSIR ) #endif -#ifdef W3_IC3 - ATT=EXP(ICE*VDIC(IS)*DTG) -#endif -#ifdef W3_IC4 - ATT=EXP(ICE*VDIC(IS)*DTG) -#endif -#ifdef W3_IC5 - ATT=EXP(ICE*VDIC(IS)*DTG) + SPEC2 = SPEC(:,JSEA) + ! + !!TAUICEX(JSEA) = 0. ! ChrisB: GPU Refactor: Now zeroed in outer seapoint loop for B4B reproducibility + !!TAUICEY(JSEA) = 0. ! Ditto... + !!PHICE(JSEA) = 0. ! Ditto... + DO IK=1,NK + IS = 1+(IK-1)*NTH + ! + ! First part of ice term integration: dissipation part + ! + ATT=1. +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + ATT=EXP(ICE_CHUNK(CSEA)*VDIC(IS)*DTG) #endif #ifdef W3_IS1 - ATT=ATT*EXP(ICE*VDIR(IS)*DTG) + ATT=ATT*EXP(ICE_CHUNK(CSEA)*VDIR(IS)*DTG) #endif #ifdef W3_IS2 - 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 + ATT=ATT*EXP(ICE_CHUNK(CSEA)*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_CHUNK(CSEA)*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 + SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH,JSEA) = ATT*SPEC2(1+(IK-1)*NTH:NTH+(IK-1)*NTH) ! - ! 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) + ! Second part of ice term integration: scattering including re-distribution in directions ! - 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 +#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, JSEA))/NTH + SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH, JSEA) = ISO & + +(SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH, JSEA)-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, JSEA)) + SPEC(1+(IK-1)*NTH:NTH+(IK-1)*NTH, JSEA) = & + REAL(MATMUL(IS2EIGVEC(:,:), EXP(IS2EIGVAL(:)*VDIR(IS)*DTG*IS2PARS(2)) & + *MATMUL(TRANSPOSE(IS2EIGVEC(:,:)),SCATSPEC))) + END IF + END IF +#endif ! - ! General solution with matrix exponentials: same as bottom scattering, see Ardhuin & Herbers (JFM 2002) + ! 10.2 Fluxes of energy and momentum due to ice effects ! - 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 -#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(:) - END DO - END DO - PHICE =-1.*DWAT*GRAV*PHICE /DTG - TAUICE(:)=TAUICE(:)/DTG - ELSE + FACTOR = DDEN(IK)/CG1_CHUNK(IK,CSEA) !Jacobian to get energy in band + FACTOR2= FACTOR*GRAV*WN1_CHUNK(IK,CSEA)/SIG(IK) ! coefficient to get momentum + DO ITH = 1,NTH + IS = ITH+(IK-1)*NTH + PHICE(JSEA) = PHICE(JSEA) + (SPEC(IS,JSEA)-SPEC2(IS)) * FACTOR + !COSI(1)=ECOS(IS) + !COSI(2)=ESIN(IS) ! GPU Refactor : Not needed after TAUICE -> TAUICE[XY] + TAUICEX(JSEA) = TAUICEX(JSEA) - (SPEC(IS,JSEA)-SPEC2(IS))*FACTOR2*ECOS(IS) + TAUICEY(JSEA) = TAUICEY(JSEA) - (SPEC(IS,JSEA)-SPEC2(IS))*FACTOR2*ESIN(IS) + END DO + END DO + PHICE(JSEA) = -1. * DWAT * GRAV * PHICE(JSEA) / DTG + TAUICEX(JSEA) = TAUICEX(JSEA) / DTG + TAUICEY(JSEA) = TAUICEY(JSEA) / DTG + ENDDO ! CSEA/JSEA + ELSE ! INPARS(4) #ifdef W3_IS2 - IF (IS2PARS(10).LT.0.5) THEN - ICEF = 0. - ENDIF + IF (IS2PARS(10).LT.0.5) THEN + ICEF_CHUNK(CSEA) = 0. + ENDIF #endif - END IF - ! - ! - ! - - - - - - - - - - - - - - - - - - - - - - - ! 11. Sea state dependent stress routine calls - ! - - - - - - - - - - - - - - - - - - - - - - - !Note the Sea-state dependent stress calculations are primarily for high-wind - !conditions (>10 m/s). It is not recommended to use these at lower wind - !in their current state. - ! + ENDIF ! INPARS(4) + ! + ! + ! - - - - - - - - - - - - - - - - - - - - - - + ! 11. Sea state dependent stress routine calls + ! - - - - - - - - - - - - - - - - - - - - - - + !Note the Sea-state dependent stress calculations are primarily for high-wind + !conditions (>10 m/s). It is not recommended to use these at lower wind + !in their current state. + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) '4 : sum(SPEC)=', sum(SPEC) - END IF + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '4 : sum(SPEC)=', sum(SPEC(:,JSEA)) + END IF #endif - ! FLD1/2 requires the calculation of FPI: -#ifdef W3_FLD1 - CALL CALC_FPI(SPEC, CG1, FPI, VSIN ) -#endif -#ifdef W3_FLD2 - CALL CALC_FPI(SPEC, CG1, FPI, VSIN ) -#endif - ! + ! FLD1/2 requires the calculation of FPI: +#if defined (W3_FLD1) || defined(W3_FLD2) + CALL INIT_GET_ISEA(ISEA, JSEA) !! TODO - to keep FPI working + CALL CALC_FPI(SPEC(:,JSEA), CG1_CHUNK(:,CSEA), FPI(ISEA), VSIN(:,CSEA) ) ! TODO - probably want to pass array of spec in future +#endif + ! #ifdef W3_FLD1 - IF (U10ABS.GT.10. .and. HSTOT.gt.0.5) then - CALL W3FLD1 ( SPEC,min(FPI/TPI,2.0),COEF*U10ABS*COS(U10DIR), & - COEF*U10ABS*Sin(U10DIR), ZWND, DEPTH, 0.0, & - DAIR, USTAR, USTDIR, Z0,TAUNUX,TAUNUY,CHARN) - ELSE - CHARN = AALPHA - ENDIF + IF (U10_CHUNK(CSEA).GT.10. .and. HSTOT.gt.0.5) then + ! TODO - TAUNUX/Y not used. Remove? + CALL W3FLD1 ( SPEC(:,JSEA),min(FPI(ISEA)/TPI,2.0),COEF_CHUNK(CSEA)*U10_CHUNK(CSEA)*COS(U10D_CHUNK(CSEA)), & + COEF_CHUNK(CSEA)*U10_CHUNK(CSEA)*Sin(U10D_CHUNK(CSEA)), ZWND, DEPTH(CSEA), 0.0, & + DAIR_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA),TAUNUX,TAUNUY,CHARN(JSEA)) + ELSE + CHARN(JSEA) = AALPHA + ENDIF #endif #ifdef W3_FLD2 - IF (U10ABS.GT.10. .and. HSTOT.gt.0.5) then - CALL W3FLD2 ( SPEC,min(FPI/TPI,2.0),COEF*U10ABS*COS(U10DIR), & - COEF*U10ABS*Sin(U10DIR), ZWND, DEPTH, 0.0, & - DAIR, USTAR, USTDIR, Z0,TAUNUX,TAUNUY,CHARN) - ELSE - CHARN = AALPHA - ENDIF + IF (U10_CHUNK(CSEA).GT.10. .and. HSTOT.gt.0.5) then + ! TODO - TAUNUX/Y not used. Remove? + CALL W3FLD2 ( SPEC(:,JSEA),min(FPI(ISEA)/TPI,2.0),COEF_CHUNK(CSEA)*U10_CHUNK(CSEA)*COS(U10D_CHUNK(CSEA)), & + COEF_CHUNK(CSEA)*U10_CHUNK(CSEA)*Sin(U10D_CHUNK(CSEA)), ZWND, DEPTH(CSEA), 0.0, & + DAIR_CHUNK(CSEA), UST_CHUNK(CSEA), USTD_CHUNK(CSEA), Z0(CSEA),TAUNUX,TAUNUY,CHARN(JSEA)) + ELSE + CHARN(JSEA) = AALPHA + ENDIF #endif - ! - ! 12. includes shoreline reflection --------------------------------------------- * - ! + END DO ! CSEA + ! + ! 12. includes shoreline reflection --------------------------------------------- * + ! + DO CSEA=1,NSEAC + IF(SRC_MASK(CSEA)) CYCLE + JSEA = CHUNK0 + CSEA - 1 + #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) '5 : sum(SPEC)=', sum(SPEC) - END IF + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '5 : sum(SPEC)=', sum(SPEC(:,JSEA)) + END IF #endif #ifdef W3_REF1 - IF (REFLEC(1).GT.0.OR.REFLEC(2).GT.0.OR.(REFLEC(4).GT.0.AND.BERG.GT.0)) THEN - CALL W3SREF ( SPEC, CG1, WN1, EMEAN, FMEAN, DEPTH, CX, CY, & - REFLEC, REFLED, TRNX, TRNY, & - BERG, DTG, IX, IY, JSEA, VREF ) - IF (GTYPE.EQ.UNGTYPE.AND.REFPARS(3).LT.0.5) THEN + ! NOTE : `REFLEC_CHUNK(4,CSEA) * BERG_CHUNK(CSEA)` calculation moved here from W3SRCE + IF (REFLEC_CHUNK(1,CSEA) .GT. 0 .OR. & + REFLEC_CHUNK(2,CSEA) .GT. 0 .OR. & + (BERG_CHUNK(CSEA) .GT. 0 .AND. REFLEC_CHUNK(4,CSEA) * BERG_CHUNK(CSEA) .GT. 0) & + ) THEN + CALL W3SREF ( SPEC(:,JSEA), CG1_CHUNK(:,CSEA), WN1_CHUNK(:,CSEA), EMEAN(CSEA), & + FMEAN(CSEA), DEPTH(CSEA), CX_CHUNK(CSEA), CY_CHUNK(CSEA), & + REFLEC_CHUNK(:,CSEA), REFLED_CHUNK(:,CSEA), TRNX_CHUNK(CSEA), TRNY_CHUNK(CSEA), & + BERG_CHUNK(CSEA), DTG, IX(CSEA), IY(CSEA), JSEA, VREF(:,CSEA) ) + IF (GTYPE.EQ.UNGTYPE.AND.REFPARS(3).LT.0.5) THEN #ifdef W3_PDLIB - IF (IOBP_LOC(JSEA).EQ.0) THEN + IF (IOBP_LOC(JSEA).EQ.0) THEN #else - IF (IOBP(IX).EQ.0) THEN + IF (IOBP(IX(CSEA)).EQ.0) THEN #endif - DO IK=1, NK - DO ITH=1, NTH - ISP = ITH+(IK-1)*NTH + DO IK=1, NK + DO ITH=1, NTH + ISP = ITH+(IK-1)*NTH #ifdef W3_PDLIB - IF (IOBPD_LOC(ITH,JSEA).EQ.0) SPEC(ISP) = DTG*VREF(ISP) + IF (IOBPD_LOC(ITH,JSEA).EQ.0) SPEC(ISP,JSEA) = DTG*VREF(ISP,CSEA) #else - IF (IOBPD(ITH,IX).EQ.0) SPEC(ISP) = DTG*VREF(ISP) + IF (IOBPD(ITH,IX(CSEA)).EQ.0) SPEC(ISP,JSEA) = DTG*VREF(ISP,CSEA) #endif - END DO - END DO - ELSE - SPEC(:) = SPEC(:) + DTG * VREF(:) - ENDIF - ELSE - SPEC(:) = SPEC(:) + DTG * VREF(:) - END IF - END IF + END DO + END DO + ELSE + SPEC(:,JSEA) = SPEC(:,JSEA) + DTG * VREF(:,CSEA) + ENDIF + ELSE + SPEC(:,JSEA) = SPEC(:,JSEA) + DTG * VREF(:,CSEA) + END IF + END IF #endif - ! + ! #ifdef W3_DEBUGSRC - IF (IX .eq. DEBUG_NODE) THEN - WRITE(740+IAPROC,*) '6 : sum(SPEC)=', sum(SPEC) - END IF + IF (IX(CSEA) .eq. DEBUG_NODE) THEN + WRITE(740+IAPROC,*) '6 : sum(SPEC)=', sum(SPEC,JSEA) + END IF #endif + END DO ! CSEA - FIRST = .FALSE. + !FIRST = .FALSE. ! Refactor: Never used. - IF (IT.EQ.0) SPEC = SPECINIT + IF(IT.EQ.0) SPEC(:,CHUNK0:CHUNKN) = SPECINIT(:,:NSEAC) - SPEC = MAX(0., SPEC) - ! + SPEC(:,CHUNK0:CHUNKN) = MAX(0., SPEC(:,CHUNK0:CHUNKN)) + ! +7777 CONTINUE ! GPU Refactor: Landing point for srce_imp_pre + ! + ! NEW GPU Refactored code: + ! Write temporary local grid CHUNKED arrays back to full grid + ! (INOUT/OUT variables only):: + DO CSEA=1,NSEAC + JSEA = CHUNK0 + CSEA - 1 + CALL INIT_GET_ISEA(ISEA, JSEA) + + ! Set output values in full grid + USTAR(ISEA) = UST_CHUNK(CSEA) + USTDIR(ISEA) = USTD_CHUNK(CSEA) +#ifdef W3_IS2 + ! Only copy ICEF back if ice field read in (INFLAGS(4) is TRUE): + IF(INFLAGS2(4)) THEN + ICEF(ISEA) = ICEF_CHUNK(CSEA) + ENDIF +#endif + + ! This moved from W3WAVE (after W3SRCE call) + ! TODO - check this is ok for implicit calls too... + IF(.NOT. (MAPSTA(IY(CSEA),IX(CSEA)) .EQ. 1 .AND. FLAGST(ISEA))) THEN + USTAR (ISEA) = UNDEF + USTDIR(ISEA) = UNDEF + DTDYN (JSEA) = UNDEF + FCUT (JSEA) = UNDEF + !SPEC(:,JSEA) = 0. !! Do not zero spec if point not active. + ENDIF + ENDDO ! CSEA + END DO !! CHUNK LOOP (CHUNK0,CHUNKN) RETURN ! ! Formats diff --git a/model/src/w3str1md.F90 b/model/src/w3str1md.F90 index d8067abd7..8cc3e31b5 100644 --- a/model/src/w3str1md.F90 +++ b/model/src/w3str1md.F90 @@ -20,10 +20,11 @@ MODULE W3STR1MD !/ | WAVEWATCH III NOAA/NCEP | !/ | A. J. van der Westhuysen | !/ | FORTRAN 90 | - !/ | Last update : 13-Jan-2013 | + !/ | Last update : 18-Jul-2023 | !/ +-----------------------------------+ !/ !/ 13 Jan-2013 : Origination, based on SWAN v40.91 code ( version 4.08 ) + !/ 18-Jul-2023 : Removed unused arguments ( version 7.14 ) !/ !/ Copyright 2009 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -174,13 +175,12 @@ MODULE W3STR1MD !> @param[in] CG Group velocities. !> @param[in] WN Wavenumbers. !> @param[in] DEPTH Mean water depth. - !> @param[in] IX !> @param[out] S Source term (1-D version). !> @param[out] D Diagonal term of derivative (1-D version). !> !> @author A. J. van der Westhuysen @date 13-Jan-2013 !> - SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) + SUBROUTINE W3STR1 (A, CG, WN, DEPTH, S, D) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -193,6 +193,8 @@ SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) !/ 13 Jan-2013 : Origination, based on SWAN v40.91 code ( version 4.08 ) !/ 05 Oct-2016 : Avoiding divide by zero for EMEAN ( version 5.15 ) !/ 28 Feb-2023 : Improvement of efficiency and stability ( version 7.xx) + !/ 18-Jul-2023 : Remove unused arguments and check EMEAN + !/ to avoid divide by zero error. ( version 7.14 ) !/ ! 1. Purpose : ! @@ -320,8 +322,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) - INTEGER, INTENT(IN) :: IX + REAL, INTENT(IN) :: CG(NK), WN(NK), DEPTH, A(NSPEC) REAL, INTENT(OUT) :: S(NSPEC), D(NSPEC) !/ !/ ------------------------------------------------------------------- / @@ -426,6 +427,14 @@ SUBROUTINE W3STR1 (A, AOLD, CG, WN, DEPTH, IX, S, D) EMEAN = EMEAN + EBAND * FTE SIGM01 = SIGM01 + EBAND * FTF ! +! 3.1 Check for zero energy +! + IF(EMEAN .EQ. 0.0) THEN + S(:) = 0.0 + D(:) = 0.0 + return + END IF +! ! 4. Final processing ! SIGM01 = SIGM01 / EMEAN diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 6db2f03af..44e221eda 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -16,7 +16,7 @@ MODULE W3WAVEMD !/ | WAVEWATCH III NOAA/NCEP | !/ | H. L. Tolman | !/ | FORTRAN 90 | - !/ | Last update : 13-Sep-2022 | + !/ | Last update : 03-Nov-2023 | !/ +-----------------------------------+ !/ !/ 04-Feb-2000 : Origination. ( version 2.00 ) @@ -98,6 +98,11 @@ 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 ) + !/ 10-Oct-2023 : Refactored W3SRCE subroutine calls + !/ to pass full arrays. (C. Bunney) ( version 7.14 ) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. (C. Bunney) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -304,6 +309,8 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !/ 25-Sep-2020 : Oasis coupling at T+0 ( version 7.10 ) !/ 22-Mar-2021 : Update TAUA, RHOA ( version 7.13 ) !/ 06-May-2021 : Use ARCTC and SMCTYPE options. JGLi ( version 7.13 ) + !/ 10-Oct-2023 : Refactored W3SRCE subroutine calls + !/ to pass full arrays. (C. Bunney) ( version 7.14 ) !/ ! 1. Purpose : ! @@ -519,7 +526,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & 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 + IK, ITH, IS, NKCFL INTEGER :: ISP, IP_glob INTEGER :: TTEST(2),DTTEST REAL :: ICEDAVE @@ -542,16 +549,16 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & DTL0, DTI0, DTR0, DTI10, DTI50, & DTGA, DTG, DTGpre, 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 + FACX, XXX, DEPTH !, REFLEC(4), & +! DELX, DELY, DELA, D50, PSIC +! REAL :: VSioDummy(NSPEC), VDioDummy(NSPEC), VAoldDummy(NSPEC) ! No longer needed +! LOGICAL :: SHAVETOTioDummy ! No longer needed #ifdef W3_SEC1 REAL :: DTGTEMP #endif ! REAL, ALLOCATABLE :: FIELD(:) - REAL :: TMP1(4), TMP2(3), TMP3(2), TMP4(2) +!! REAL :: TMP1(4), TMP2(3), TMP3(2), TMP4(2) ! No longer needed #ifdef W3_IC3 REAL, ALLOCATABLE :: WN_I(:) #endif @@ -1460,12 +1467,13 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & !$OMP PARALLEL DO PRIVATE (JSEA,ISEA,IX,IY) SCHEDULE (DYNAMIC,1) #endif -#ifdef W3_PDLIB - D50=0.0002 - REFLEC(:)=0. - REFLED(:)=0 - PSIC=0. -#endif +! Refactor notes: No longer needed +!#ifdef W3_PDLIB +! D50=0.0002 +! REFLEC(:)=0. +! REFLED(:)=0 +! PSIC=0. +!#endif #ifdef W3_PDLIB IF (LSLOC) THEN @@ -1479,84 +1487,96 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & #ifdef W3_PDLIB - - DO JSEA = 1, NP - - CALL INIT_GET_ISEA(ISEA, JSEA) - - 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) -#endif - -#ifdef W3_BT4 - D50=SED_D50(ISEA) - PSIC=SED_PSIC(ISEA) -#endif - ! + ! CB: Refactor: removed NP loop; now passing full arrays to W3SRCE #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), & + ! TODO - DEBUG will need changing/moving in to W3SRCE. + 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 + ! Implicit source call + CALL W3SRCE(srce_imp_pre, IT, IMOD, & + VA(:,1:NSEALM), & + ALPHA(1:NK,1:NSEAL), & + WN(0:NK+1,1:NSEA), & ! Note 0:NK+1 to avoid temp array + CG(0:NK+1,1:NSEA), & ! Note 0:NK+1 to avoid temp array + CLATS(1:NSEA), & + DW(1:NSEA), & + U10(1:NSEA), & + U10D(1:NSEA), & #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(1:NSEA), TAUADIR(1:NSEA), & +#endif + AS(1:NSEA), & + UST(1:NSEA), USTDIR(1:NSEA), & + CX(1:NSEA), CY(1:NSEA), & + ICE(1:NSEA), & + ICEH(1:NSEA), & + ICEF(1:NSEA), & + ICEDMAX(1:NSEA), & +#ifdef W3_REF1 + REFLC(:,1:NSEA), REFLD(:,1:NSEA), & + TRNX(1:NY,1:NX), TRNY(1:NY,1:NX), & + BERG(1:NSEA), & +#endif + FPIS(1:NSEA), & + DTDYN(1:NSEAL), & + FCUT(1:NSEAL), & + DTGpre, & + TAUWX(1:NSEAL), TAUWY(1:NSEAL), & + TAUOX(1:NSEAL), TAUOY(1:NSEAL), & + TAUWIX(1:NSEAL), TAUWIY(1:NSEAL), & + TAUWNX(1:NSEAL), TAUWNY(1:NSEAL), & + PHIAW(1:NSEAL), & + CHARN(1:NSEAL), & + TWS(1:NSEAL), & + PHIOC(1:NSEAL), & + WCAP_COV(1:NSEAL), & ! | + WCAP_THK(1:NSEAL), & ! |-- WCAP_* was WHITECAP and formerly TMP1 + WCAP_BHS(1:NSEAL), & ! | + WCAP_MNT(1:NSEAL), & ! | +#ifdef W3_BT4 + SED_D50(1:NSEA), & ! Now passing full arrays, not local scalar + SED_PSIC(1:NSEA), & ! " " + BEDROUGH(1:NSEAL), & ! | + BEDRIPX(1:NSEAL), & ! |-- BED* was BEDFORM(:,1:3) and formerly TMP2 + BEDRIPY(1:NSEAL), & ! | +#endif + PHIBBL(1:NSEAL), & + TAUBBLX(1:NSEAL), & ! WAS TMP3 + TAUBBLY(1:NSEAL), & ! WAS TMP3 + TAUICEX(1:NSEAL), & ! WAS TMP4 + TAUICEY(1:NSEAL), & ! WAS TMP4 + PHICE(1:NSEAL), & + TAUOCX(1:NSEAL), TAUOCY(1:NSEAL), & + WNMEAN(1:NSEAL), & + RHOAIR(1:NSEA), & + ASF(1:NSEA) ) + + ! TODO - These are problematic - they are not allocated if LSLOC is True, + ! but thankfully it is hard coded to False, so we can just no pass them in + !VSIO=VSTOT(:,1:NSEAL), & + !VDIO=VDTOT(:,1:NSEAL), & + !SHAVEIO=SHAVETOT(1:NSEAL) & + !) + + !! This now done in W3SRCE (including test on LSLOC) + !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) -#endif - END DO ! JSEA + 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 END IF ! PDLIB #endif @@ -2130,10 +2150,11 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & 370 CONTINUE IF ( FLSOU ) THEN ! - D50=0.0002 - REFLEC(:)=0. - REFLED(:)=0 - PSIC=0. +! Refactor notes: No longer needed +! D50=0.0002 +! REFLEC(:)=0. +! REFLED(:)=0 +! PSIC=0. #ifdef W3_PDLIB #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'ITIME=', ITIME, ' IT=', IT @@ -2147,126 +2168,148 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & 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) #endif - ! - DO JSEA=1, NSEAL - CALL INIT_GET_ISEA(ISEA, JSEA) - 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 -#endif - ! -#ifdef W3_REF1 - REFLEC=REFLC(:,ISEA) - REFLEC(4)=BERG(ISEA)*REFLEC(4) - REFLED=REFLD(:,ISEA) -#endif -#ifdef W3_BT4 - 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) -#ifdef W3_PDLIB +#ifdef W3_PDLIB + ! Implicit solver call 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), & + ! Note: VSIO, VDIO and SHAVEIO not needed in this call + CALL W3SRCE(srce_imp_post,IT,IMOD, & + VA(:,1:NSEALM), & + ALPHA(1:NK,1:NSEAL), & + WN(0:NK+1,1:NSEA), & ! Note 0:NK+1 to avoid temp array + CG(0:NK+1,1:NSEA), & ! Note 0:NK+1 to avoid temp array + CLATS(1:NSEA), & + DW(1:NSEA), & + U10(1:NSEA), & + U10D(1:NSEA), & #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(1:NSEA), TAUADIR(1:NSEA), & +#endif + AS(1:NSEA), & + UST(1:NSEA), USTDIR(1:NSEA), & + CX(1:NSEA), CY(1:NSEA), & + ICE(1:NSEA), & + ICEH(1:NSEA), & + ICEF(1:NSEA), & + ICEDMAX(1:NSEA), & +#ifdef W3_REF1 + REFLC(:,1:NSEA), REFLD(:,1:NSEA), & + TRNX(1:NY,1:NX), TRNY(1:NY,1:NX), & + BERG(1:NSEA), & +#endif + FPIS(1:NSEA), & + DTDYN(1:NSEAL), & + FCUT(1:NSEAL), & + DTG, & + TAUWX(1:NSEAL), TAUWY(1:NSEAL), & + TAUOX(1:NSEAL), TAUOY(1:NSEAL), & + TAUWIX(1:NSEAL), TAUWIY(1:NSEAL), & + TAUWNX(1:NSEAL), TAUWNY(1:NSEAL), & + PHIAW(1:NSEAL), & + CHARN(1:NSEAL), & + TWS(1:NSEAL), & + PHIOC(1:NSEAL), & + WCAP_COV(1:NSEAL), & ! | + WCAP_THK(1:NSEAL), & ! |-- WCAP_* was WHITECAP and formerly TMP1 + WCAP_BHS(1:NSEAL), & ! | + WCAP_MNT(1:NSEAL), & ! | +#ifdef W3_BT4 + SED_D50(1:NSEA), & ! Now passing full arrays, not local scalar + SED_PSIC(1:NSEA), & ! " " + BEDROUGH(1:NSEAL), & ! | + BEDRIPX(1:NSEAL), & ! |-- BED* was BEDFORM(:,1:3) and formerly TMP2 + BEDRIPY(1:NSEAL), & ! | + +#endif + PHIBBL(1:NSEAL), & + TAUBBLX(1:NSEAL), & ! WAS TMP3 + TAUBBLY(1:NSEAL), & ! WAS TMP3 + TAUICEX(1:NSEAL), & ! WAS TMP4 + TAUICEY(1:NSEAL), & ! WAS TMP4 + PHICE(1:NSEAL), & + TAUOCX(1:NSEAL), TAUOCY(1:NSEAL), & + WNMEAN(1:NSEAL), & + RHOAIR(1:NSEA), & + ASF(1:NSEA) ) 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), & + ! Explicit source call + CALL W3SRCE(srce_direct, IT, IMOD, & + !VAoldDummy, & ! Not used, either here or in w3str1 (where it is passed from w3srce) + VA(:,1:NSEALM), & + ALPHA(1:NK,1:NSEAL), & + WN(0:NK+1,1:NSEA), & ! Note 0:NK+1 to avoid temp array + CG(0:NK+1,1:NSEA), & ! Note 0:NK+1 to avoid temp array + CLATS(1:NSEA), & + DW(1:NSEA), & + U10(1:NSEA), & + U10D(1:NSEA), & #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(1:NSEA), TAUADIR(1:NSEA), & +#endif + AS(1:NSEA), & + UST(1:NSEA), USTDIR(1:NSEA), & + CX(1:NSEA), CY(1:NSEA), & + ICE(1:NSEA), & + ICEH(1:NSEA), & + ICEF(1:NSEA), & + ICEDMAX(1:NSEA), & +#ifdef W3_REF1 + !REFLEC, REFLED, & ! Note - not passing REFLE[CD] - will calculate in w3srce + REFLC(:,1:NSEA), REFLD(:,1:NSEA), & + !DELX, DELY, DELA, & ! Removed these - they are not used in w3srce + TRNX(1:NY,1:NX), TRNY(1:NY,1:NX), & + BERG(1:NSEA), & +#endif + FPIS(1:NSEA), & + DTDYN(1:NSEAL), & + FCUT(1:NSEAL), & + DTG, & + TAUWX(1:NSEAL), TAUWY(1:NSEAL), & + TAUOX(1:NSEAL), TAUOY(1:NSEAL), & + TAUWIX(1:NSEAL), TAUWIY(1:NSEAL), & + TAUWNX(1:NSEAL), TAUWNY(1:NSEAL), & + PHIAW(1:NSEAL), & + CHARN(1:NSEAL), & + TWS(1:NSEAL), & + PHIOC(1:NSEAL), & + WCAP_COV(1:NSEAL), & ! | + WCAP_THK(1:NSEAL), & ! |-- WCAP_* was WHITECAP and formerly TMP1 + WCAP_BHS(1:NSEAL), & ! | + WCAP_MNT(1:NSEAL), & ! | +#ifdef W3_BT4 + SED_D50(1:NSEA), & ! Now passing full arrays, not local scalar + SED_PSIC(1:NSEA), & ! " " + BEDROUGH(1:NSEAL), & ! | + BEDRIPX(1:NSEAL), & ! |-- BED* was BEDFORM(:,1:3) and formerly TMP2 + BEDRIPY(1:NSEAL), & ! | + +#endif + PHIBBL(1:NSEAL), & + TAUBBLX(1:NSEAL), & ! WAS TMP3 + TAUBBLY(1:NSEAL), & ! WAS TMP3 + TAUICEX(1:NSEAL), & ! WAS TMP4 + TAUICEY(1:NSEAL), & ! WAS TMP4 + PHICE(1:NSEAL), & + TAUOCX(1:NSEAL), TAUOCY(1:NSEAL), & + WNMEAN(1:NSEAL), & + RHOAIR(1:NSEA), & + ASF(1:NSEA) & + !VSIO=VSioDummy, & ! Now optional + !VDIO=VDioDummy, & ! Now optional + !SHAVEIO=SHAVETOTioDummy & ! Now optional (not actually used) + ) #ifdef W3_PDLIB 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 - - ! -#ifdef W3_OMPG - !$OMP END DO - !$OMP END PARALLEL -#endif - ! + !! Below now happens at end of W3SRCE +! UST (ISEA) = UNDEF +! USTDIR(ISEA) = UNDEF +! DTDYN (JSEA) = UNDEF +! FCUT (JSEA) = UNDEF +! VA(:,JSEA) = 0. +! #ifdef W3_PDLIB #ifdef W3_DEBUGSRC WRITE(740+IAPROC,*) 'ITIME=', ITIME, ' IT=', IT @@ -2294,10 +2337,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & END DO IF (IT.GT.0) DTG=DTGTEMP #endif - - - - ! ! ! 3.8 Update global time step. @@ -2329,7 +2368,6 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & CALL PRINT_MY_TIME("end of time loop") #endif ! - ! END DO #ifdef W3_TIMINGS diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index bfd2dd467..bf1684360 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -42,6 +42,9 @@ 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 ) + !/ 03-Nov-2023 : Split WHITECAP into 4 separate ( version 7.14 ) + !/ variables and TAUBBL/TAUICE into + !/ X and Y components. C Bunney !/ ! 1. Purpose : ! @@ -1076,7 +1079,7 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & !/ Local Parameters !/ INTEGER :: ISEA, GSEA, IG, IGRID, IPTS, IGX, IGY, IX, & - IY, ISWLL, ICAP, IBED, IFREQ, IK, INRST + IY, ISWLL, IFREQ, IK, INRST INTEGER :: MAPINT, MAPICE, MAPDRY, MAPMSK, MAPLND, & NMAPICE, NMAPDRY, NMAPMSK, NMAPLND, & LMAPICE, LMAPDRY, LMAPMSK, LMAPLND, & @@ -1239,7 +1242,10 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & TAUWIY = UNDEF TAUWNX = UNDEF TAUWNY = UNDEF - WHITECAP = UNDEF + WCAP_COV = UNDEF + WCAP_THK = UNDEF + WCAP_BHS = UNDEF + WCAP_MNT = UNDEF ! ! Group 6 variables ! @@ -1264,7 +1270,8 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & IF ( P2MSF(1).GT.0) THEN P2SMS = UNDEF ENDIF - TAUICE = UNDEF + TAUICEX = UNDEF + TAUICEY = UNDEF PHICE = UNDEF IF ( USSPF(1).GT.0 ) THEN USSP = UNDEF @@ -1276,9 +1283,12 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & ABD = UNDEF UBA = UNDEF UBD = UNDEF - BEDFORMS = UNDEF + BEDROUGH = UNDEF + BEDRIPX = UNDEF + BEDRIPY = UNDEF PHIBBL = UNDEF - TAUBBL = UNDEF + TAUBBLX = UNDEF + TAUBBLY = UNDEF ! ! Group 8 variables ! @@ -2224,22 +2234,77 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - DO ICAP = 1,4 - ! - IF ( FLOGRD(5,ICAP+6) .AND. ACTIVE ) THEN - IF ( WADATS(IGRID)%WHITECAP(GSEA,ICAP) .NE. UNDEF ) THEN - SUMWTC(ICAP) = SUMWTC(ICAP) + WT - IF ( WHITECAPAUX(ICAP) .EQ. UNDEF ) THEN - WHITECAPAUX(ICAP) = WADATS(IGRID)%WHITECAP(GSEA,ICAP)& - *WT - ELSE - WHITECAPAUX(ICAP) = WHITECAPAUX(ICAP) + & - WADATS(IGRID)%WHITECAP(GSEA,ICAP)*WT - END IF + +! CB Refactor: Whitecap now split into 4 separate variables: +! DO ICAP = 1,4 +! ! +! IF ( FLOGRD(5,ICAP+6) .AND. ACTIVE ) THEN +! IF ( WADATS(IGRID)%WHITECAP(GSEA,ICAP) .NE. UNDEF ) THEN +! SUMWTC(ICAP) = SUMWTC(ICAP) + WT +! IF ( WHITECAPAUX(ICAP) .EQ. UNDEF ) THEN +! WHITECAPAUX(ICAP) = WADATS(IGRID)%WHITECAP(GSEA,ICAP)& +! *WT +! ELSE +! WHITECAPAUX(ICAP) = WHITECAPAUX(ICAP) + & +! WADATS(IGRID)%WHITECAP(GSEA,ICAP)*WT +! END IF +! END IF +! END IF +! ! +! END DO +! + ! Whitecap coverage + IF ( FLOGRD(5,7) .AND. ACTIVE ) THEN + IF ( WADATS(IGRID)%WCAP_COV(GSEA) .NE. UNDEF ) THEN + SUMWTC(1) = SUMWTC(1) + WT + IF ( WHITECAPAUX(1) .EQ. UNDEF ) THEN + WHITECAPAUX(1) = WADATS(IGRID)%WCAP_COV(GSEA) * WT + ELSE + WHITECAPAUX(1) = WHITECAPAUX(1) + & + WADATS(IGRID)%WCAP_COV(GSEA) * WT END IF END IF - ! - END DO + END IF + + ! Whitecap Thickness + IF ( FLOGRD(5,8) .AND. ACTIVE ) THEN + IF ( WADATS(IGRID)%WCAP_THK(GSEA) .NE. UNDEF ) THEN + SUMWTC(2) = SUMWTC(2) + WT + IF ( WHITECAPAUX(2) .EQ. UNDEF ) THEN + WHITECAPAUX(2) = WADATS(IGRID)%WCAP_THK(GSEA) * WT + ELSE + WHITECAPAUX(2) = WHITECAPAUX(2) + & + WADATS(IGRID)%WCAP_THK(GSEA) * WT + END IF + END IF + END IF + + ! Whitecap breaker height + IF ( FLOGRD(5,9) .AND. ACTIVE ) THEN + IF ( WADATS(IGRID)%WCAP_BHS(GSEA) .NE. UNDEF ) THEN + SUMWTC(3) = SUMWTC(3) + WT + IF ( WHITECAPAUX(3) .EQ. UNDEF ) THEN + WHITECAPAUX(3) = WADATS(IGRID)%WCAP_BHS(GSEA) * WT + ELSE + WHITECAPAUX(3) = WHITECAPAUX(3) + & + WADATS(IGRID)%WCAP_BHS(GSEA) * WT + END IF + END IF + END IF + + ! Whitecap moment + IF ( FLOGRD(5,10) .AND. ACTIVE ) THEN + IF ( WADATS(IGRID)%WCAP_MNT(GSEA) .NE. UNDEF ) THEN + SUMWTC(4) = SUMWTC(4) + WT + IF ( WHITECAPAUX(4) .EQ. UNDEF ) THEN + WHITECAPAUX(4) = WADATS(IGRID)%WCAP_MNT(GSEA) * WT + ELSE + WHITECAPAUX(4) = WHITECAPAUX(4) + & + WADATS(IGRID)%WCAP_MNT(GSEA) * WT + END IF + END IF + END IF + ! ! Group 6 variables ! @@ -2362,14 +2427,14 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF ! IF ( FLOGRD(6,10) .AND. ACTIVE ) THEN - IF ( WADATS(IGRID)%TAUICE(GSEA,1) .NE. UNDEF ) THEN + IF ( WADATS(IGRID)%TAUICEX(GSEA) .NE. UNDEF ) THEN SUMWT6(10) = SUMWT6(10) + WT IF ( TAUICEAUX(1) .EQ. UNDEF ) TAUICEAUX(1) = 0. IF ( TAUICEAUX(2) .EQ. UNDEF ) TAUICEAUX(2) = 0. TAUICEAUX(1) = TAUICEAUX(1) + & - WADATS(IGRID)%TAUICE(GSEA,1)*WT + WADATS(IGRID)%TAUICEX(GSEA)*WT TAUICEAUX(2) = TAUICEAUX(2) + & - WADATS(IGRID)%TAUICE(GSEA,2)*WT + WADATS(IGRID)%TAUICEY(GSEA)*WT END IF END IF ! @@ -2441,18 +2506,36 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF ! IF ( FLOGRD(7,3) .AND. ACTIVE ) THEN - DO IBED = 1, 3 - IF ( WADATS(IGRID)%BEDFORMS(GSEA,IBED) .NE. UNDEF ) THEN - SUMWTB(IBED) = SUMWTB(IBED) + WT - IF ( BEDFORMSAUX(IBED) .EQ. UNDEF ) THEN - BEDFORMSAUX(IBED) = WADATS(IGRID)%BEDFORMS(GSEA,IBED)& - *WT - ELSE - BEDFORMSAUX(IBED) = BEDFORMSAUX(IBED) + & - WADATS(IGRID)%BEDFORMS(GSEA,IBED)*WT - END IF + IF ( WADATS(IGRID)%BEDROUGH(GSEA) .NE. UNDEF ) THEN + SUMWTB(1) = SUMWTB(1) + WT + IF ( BEDFORMSAUX(1) .EQ. UNDEF ) THEN + BEDFORMSAUX(1) = WADATS(IGRID)%BEDROUGH(GSEA) * WT + ELSE + BEDFORMSAUX(1) = BEDFORMSAUX(1) + & + WADATS(IGRID)%BEDROUGH(GSEA)*WT END IF - END DO + END IF + + IF ( WADATS(IGRID)%BEDRIPX(GSEA) .NE. UNDEF ) THEN + SUMWTB(2) = SUMWTB(2) + WT + IF ( BEDFORMSAUX(2) .EQ. UNDEF ) THEN + BEDFORMSAUX(2) = WADATS(IGRID)%BEDRIPX(GSEA) * WT + ELSE + BEDFORMSAUX(2) = BEDFORMSAUX(2) + & + WADATS(IGRID)%BEDRIPX(GSEA)*WT + END IF + END IF + + IF ( WADATS(IGRID)%BEDRIPY(GSEA) .NE. UNDEF ) THEN + SUMWTB(3) = SUMWTB(1) + WT + IF ( BEDFORMSAUX(3) .EQ. UNDEF ) THEN + BEDFORMSAUX(3) = WADATS(IGRID)%BEDRIPY(GSEA) * WT + ELSE + BEDFORMSAUX(3) = BEDFORMSAUX(3) + & + WADATS(IGRID)%BEDRIPY(GSEA)*WT + END IF + END IF + END IF ! IF ( FLOGRD(7,4) .AND. ACTIVE ) THEN @@ -2467,16 +2550,16 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF ! IF ( FLOGRD(7,5) .AND. ACTIVE ) THEN - IF ( WADATS(IGRID)%TAUBBL(GSEA,1) .NE. UNDEF ) THEN + IF ( WADATS(IGRID)%TAUBBLX(GSEA) .NE. UNDEF ) THEN SUMWT7(5) = SUMWT7(5) + WT IF ( TAUBBLAUX(1) .EQ. UNDEF ) THEN - TAUBBLAUX(1) = WADATS(IGRID)%TAUBBL(GSEA,1)*WT - TAUBBLAUX(2) = WADATS(IGRID)%TAUBBL(GSEA,2)*WT + TAUBBLAUX(1) = WADATS(IGRID)%TAUBBLX(GSEA)*WT + TAUBBLAUX(2) = WADATS(IGRID)%TAUBBLY(GSEA)*WT ELSE TAUBBLAUX(1) = TAUBBLAUX(1) + & - WADATS(IGRID)%TAUBBL(GSEA,1)*WT + WADATS(IGRID)%TAUBBLX(GSEA)*WT TAUBBLAUX(2) = TAUBBLAUX(2) + & - WADATS(IGRID)%TAUBBL(GSEA,2)*WT + WADATS(IGRID)%TAUBBLY(GSEA)*WT END IF END IF END IF @@ -3131,17 +3214,60 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - DO ICAP = 1,4 - IF ( WHITECAPAUX(ICAP) .NE. UNDEF ) THEN - WHITECAPAUX(ICAP) = WHITECAPAUX(ICAP) / SUMWTC(ICAP) - IF ( WHITECAP(ISEA,ICAP) .EQ. UNDEF ) THEN - WHITECAP(ISEA,ICAP) = WHITECAPAUX(ICAP) / REAL( SUMGRD ) - ELSE - WHITECAP(ISEA,ICAP) = WHITECAP(ISEA,ICAP) + & - WHITECAPAUX(ICAP) / REAL( SUMGRD ) - END IF + +! WHITECAP now split into 4 separate variables: +! DO ICAP = 1,4 +! IF ( WHITECAPAUX(ICAP) .NE. UNDEF ) THEN +! WHITECAPAUX(ICAP) = WHITECAPAUX(ICAP) / SUMWTC(ICAP) +! IF ( WHITECAP(ISEA,ICAP) .EQ. UNDEF ) THEN +! WHITECAP(ISEA,ICAP) = WHITECAPAUX(ICAP) / REAL( SUMGRD ) +! ELSE +! WHITECAP(ISEA,ICAP) = WHITECAP(ISEA,ICAP) + & +! WHITECAPAUX(ICAP) / REAL( SUMGRD ) +! END IF +! END IF +! END DO +! + ! Whitecap coverage: + IF ( WHITECAPAUX(1) .NE. UNDEF ) THEN + WHITECAPAUX(1) = WHITECAPAUX(1) / SUMWTC(1) + IF ( WCAP_COV(ISEA) .EQ. UNDEF ) THEN + WCAP_COV(ISEA) = WHITECAPAUX(1) / REAL( SUMGRD ) + ELSE + WCAP_COV(ISEA) = WCAP_COV(ISEA) + WHITECAPAUX(1) / REAL( SUMGRD ) END IF - END DO + END IF + + ! Whitecap thickness: + IF ( WHITECAPAUX(2) .NE. UNDEF ) THEN + WHITECAPAUX(2) = WHITECAPAUX(2) / SUMWTC(2) + IF ( WCAP_THK(ISEA) .EQ. UNDEF ) THEN + WCAP_THK(ISEA) = WHITECAPAUX(2) / REAL( SUMGRD ) + ELSE + WCAP_THK(ISEA) = WCAP_THK(ISEA) + WHITECAPAUX(2) / REAL( SUMGRD ) + END IF + END IF + + ! Whitecap breaker height: + IF ( WHITECAPAUX(3) .NE. UNDEF ) THEN + WHITECAPAUX(3) = WHITECAPAUX(3) / SUMWTC(3) + IF ( WCAP_BHS(ISEA) .EQ. UNDEF ) THEN + WCAP_BHS(ISEA) = WHITECAPAUX(3) / REAL( SUMGRD ) + ELSE + WCAP_BHS(ISEA) = WCAP_BHS(ISEA) + WHITECAPAUX(3) / REAL( SUMGRD ) + END IF + END IF + + ! Whitecap moment: + IF ( WHITECAPAUX(4) .NE. UNDEF ) THEN + WHITECAPAUX(4) = WHITECAPAUX(4) / SUMWTC(4) + IF ( WCAP_MNT(ISEA) .EQ. UNDEF ) THEN + WCAP_MNT(ISEA) = WHITECAPAUX(4) / REAL( SUMGRD ) + ELSE + WCAP_MNT(ISEA) = WCAP_MNT(ISEA) + WHITECAPAUX(4) / REAL( SUMGRD ) + END IF + END IF +! ! ! Group 6 variables ! @@ -3253,11 +3379,11 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF ! IF ( TAUICEAUX(1) .NE. UNDEF ) THEN - IF ( TAUICE(ISEA,1) .EQ. UNDEF ) TAUICE(ISEA,1) = 0. - IF ( TAUICE(ISEA,2) .EQ. UNDEF ) TAUICE(ISEA,2) = 0. - TAUICE(ISEA,1) = TAUICE(ISEA,1) + & + IF ( TAUICEX(ISEA) .EQ. UNDEF ) TAUICEX(ISEA) = 0. + IF ( TAUICEY(ISEA) .EQ. UNDEF ) TAUICEY(ISEA) = 0. + TAUICEX(ISEA) = TAUICEX(ISEA) + & TAUICEAUX(1) / REAL( SUMWT6(10) * SUMGRD ) - TAUICE(ISEA,2) = TAUICE(ISEA,2) + & + TAUICEY(ISEA) = TAUICEY(ISEA) + & TAUICEAUX(2) / REAL( SUMWT6(10) * SUMGRD ) END IF ! @@ -3321,17 +3447,35 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & END IF END IF ! - DO IBED = 1,3 - IF ( BEDFORMSAUX(IBED) .NE. UNDEF ) THEN - BEDFORMSAUX(IBED) = BEDFORMSAUX(IBED) / SUMWTB(IBED) - IF ( BEDFORMS(ISEA,IBED) .EQ. UNDEF ) THEN - BEDFORMS(ISEA,IBED) = BEDFORMSAUX(IBED) / REAL( SUMGRD ) - ELSE - BEDFORMS(ISEA,IBED) = BEDFORMS(ISEA,IBED) + & - BEDFORMSAUX(IBED) / REAL( SUMGRD ) - END IF + IF ( BEDFORMSAUX(1) .NE. UNDEF ) THEN + BEDFORMSAUX(1) = BEDFORMSAUX(1) / SUMWTB(1) + IF ( BEDROUGH(ISEA) .EQ. UNDEF ) THEN + BEDROUGH(ISEA) = BEDFORMSAUX(1) / REAL( SUMGRD ) + ELSE + BEDROUGH(ISEA) = BEDROUGH(ISEA) + & + BEDFORMSAUX(1) / REAL( SUMGRD ) END IF - END DO + END IF + + IF ( BEDFORMSAUX(2) .NE. UNDEF ) THEN + BEDFORMSAUX(2) = BEDFORMSAUX(2) / SUMWTB(2) + IF ( BEDRIPX(ISEA) .EQ. UNDEF ) THEN + BEDRIPX(ISEA) = BEDFORMSAUX(2) / REAL( SUMGRD ) + ELSE + BEDRIPX(ISEA) = BEDRIPX(ISEA) + & + BEDFORMSAUX(2) / REAL( SUMGRD ) + END IF + END IF + + IF ( BEDFORMSAUX(3) .NE. UNDEF ) THEN + BEDFORMSAUX(3) = BEDFORMSAUX(3) / SUMWTB(3) + IF ( BEDRIPY(ISEA) .EQ. UNDEF ) THEN + BEDRIPY(ISEA) = BEDFORMSAUX(3) / REAL( SUMGRD ) + ELSE + BEDRIPY(ISEA) = BEDRIPY(ISEA) + & + BEDFORMSAUX(3) / REAL( SUMGRD ) + END IF + END IF ! IF ( PHIBBLAUX .NE. UNDEF ) THEN PHIBBLAUX = PHIBBLAUX / SUMWT7(4) @@ -3345,13 +3489,13 @@ SUBROUTINE W3EXGI ( NGRD, NSEA, NOSWLL_MIN, INTMETHOD, OUTorRESTflag, & IF ( TAUBBLAUX(1) .NE. UNDEF ) THEN TAUBBLAUX(1) = TAUBBLAUX(1) / SUMWT7(5) TAUBBLAUX(2) = TAUBBLAUX(2) / SUMWT7(5) - IF ( TAUBBL(ISEA,1) .EQ. UNDEF ) THEN - TAUBBL(ISEA,1) = TAUBBLAUX(1) / REAL( SUMGRD ) - TAUBBL(ISEA,2) = TAUBBLAUX(2) / REAL( SUMGRD ) + IF ( TAUBBLX(ISEA) .EQ. UNDEF ) THEN + TAUBBLX(ISEA) = TAUBBLAUX(1) / REAL( SUMGRD ) + TAUBBLY(ISEA) = TAUBBLAUX(2) / REAL( SUMGRD ) ELSE - TAUBBL(ISEA,1) = TAUBBL(ISEA,1) + & + TAUBBLX(ISEA) = TAUBBLX(ISEA) + & TAUBBLAUX(1) / REAL( SUMGRD ) - TAUBBL(ISEA,2) = TAUBBL(ISEA,2) + & + TAUBBLY(ISEA) = TAUBBLY(ISEA) + & TAUBBLAUX(2) / REAL( SUMGRD ) END IF END IF diff --git a/model/src/ww3_multi.F90 b/model/src/ww3_multi.F90 index e3101b7c2..970ccd0d7 100644 --- a/model/src/ww3_multi.F90 +++ b/model/src/ww3_multi.F90 @@ -91,6 +91,7 @@ PROGRAM W3MLTI !/ USE WMMDATMD, ONLY: MDSI, MDSO, MDSS, MDST, MDSE, & NMPROC, IMPROC, NMPSCR, NRGRD, ETIME + USE W3SRCEMD, ONLY: W3SRCE_INIT #ifdef W3_OMPG USE OMP_LIB #endif @@ -182,6 +183,9 @@ PROGRAM W3MLTI END IF ! + ! Source term refactor - init some stuff in W3SRCE + CALL W3SRCE_INIT() + ! !/ ------------------------------------------------------------------- / ! 2. Run the wave model diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index a2ff83e26..138e5753d 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -190,8 +190,10 @@ PROGRAM W3OUNF USSX, USSY, MSSX, MSSY, MSSD, MSCX, MSCY, & MSCD, CHARN, TWS, TAUA, TAUADIR, & TAUWNX, TAUWNY, BHD, T02, HSIG, CGE, & - T01, BEDFORMS, WHITECAP, TAUBBL, PHIBBL, & - CFLTHMAX, CFLXYMAX, CFLKMAX, TAUICE, PHICE, & + T01, BEDROUGH, BEDRIPX, BEDRIPY, & + WCAP_COV, WCAP_THK, WCAP_BHS, WCAP_MNT, & + TAUBBLX, TAUBBLY, PHIBBL, CFLTHMAX, & + CFLXYMAX, CFLKMAX, TAUICEX, TAUICEY, PHICE, & STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& P2SMS, EF, US3D, TH1M, STH1M, TH2M, STH2M, & WN, USSP, WBT, WNMEAN, QKK, SKEW, EMBIA1, EMBIA2 @@ -1647,19 +1649,19 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! ! Whitecap coverage ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 7 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,1), X1) + CALL S2GRID(WCAP_COV(1:NSEA), X1) ! ! Whitecap foam thickness ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 8 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,2), X1) + CALL S2GRID(WCAP_THK(1:NSEA), X1) ! ! Significant breaking wave height ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 9 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,3), X1) + CALL S2GRID(WCAP_BHS(1:NSEA), X1) ! ! Whitecap moment ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 10 ) THEN - CALL S2GRID(WHITECAP(1:NSEA,4), X1) + CALL S2GRID(WCAP_MNT(1:NSEA), X1) ! ! Wind sea mean period T0M1 ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN @@ -1807,10 +1809,10 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & 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) + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUICEX(1:NSEA), TAUICEY(1:NSEA), AnglD) #endif - CALL S2GRID(TAUICE(1:NSEA,1), XX) - CALL S2GRID(TAUICE(1:NSEA,2), XY) + CALL S2GRID(TAUICEX(1:NSEA), XX) + CALL S2GRID(TAUICEY(1:NSEA), XY) NFIELD=2 ! ! Wave to sea ice energy flux @@ -1884,12 +1886,12 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & 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) + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, BEDRIPX(1:NSEA), & + BEDRIPY(1:NSEA), AnglD) #endif - CALL S2GRID(BEDFORMS(1:NSEA,1), X1) - CALL S2GRID(BEDFORMS(1:NSEA,2), X2) - CALL S2GRID(BEDFORMS(1:NSEA,3), XY) + CALL S2GRID(BEDROUGH(1:NSEA), X1) + CALL S2GRID(BEDRIPX(1:NSEA), X2) + CALL S2GRID(BEDRIPY(1:NSEA), XY) NFIELD=3 ! ! Wave dissipation in bottom boundary layer @@ -1900,11 +1902,11 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & 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, TAUBBL(1:NSEA,1), & - TAUBBL(1:NSEA,2), AnglD) + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUBBLX(1:NSEA), & + TAUBBLY(1:NSEA), AnglD) #endif - CALL S2GRID(TAUBBL(1:NSEA,1), XX) - CALL S2GRID(TAUBBL(1:NSEA,2), XY) + CALL S2GRID(TAUBBLX(1:NSEA), XX) + CALL S2GRID(TAUBBLY(1:NSEA), XY) NFIELD=2 ! ! Mean square slope diff --git a/model/src/ww3_ounp.F90 b/model/src/ww3_ounp.F90 index a1533c73b..93949822b 100644 --- a/model/src/ww3_ounp.F90 +++ b/model/src/ww3_ounp.F90 @@ -1677,7 +1677,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) #endif #ifdef W3_ST4 REAL :: AMAX, FMEANS, FMEANWS, TAUWX, TAUWY, & - TAUWNX, TAUWNY, FMEAN1, WHITECAP(1:4) + TAUWNX, TAUWNY, FMEAN1, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3 REAL :: LAMBDA(NSPEC), DLWMEAN #endif #ifdef W3_ST6 @@ -2206,7 +2206,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) USTAR, USTD, TAUWX, TAUWY, CD, Z0, & CHARN, LLWS, FMEANWS,DLWMEAN ) CALL W3SDS4 ( A, WN, CG, USTAR, USTD, DEPTH, DAIR, XDS, & - DIA, IX, IY, LAMBDA, WHITECAP, DLWMEAN ) + DIA, IX, IY, LAMBDA, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN ) CALL W3SIN4 (A, CG, WN2, UABS, USTAR, DAIR/DWAT, & ASO(J), UDIRR, Z0, CD, TAUWX, TAUWY, TAUWNX, & TAUWNY, XIN, DIA, LLWS, IX, IY, LAMBDA ) @@ -2334,7 +2334,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) USTAR, USTD, TAUWX, TAUWY, CD, Z0, & CHARN, LLWS, FMEANWS, DLWMEAN ) CALL W3SDS4 ( A, WN, CG, USTAR, USTD, DEPTH, DAIR, XDS, & - DIA, IX, IY, LAMBDA, WHITECAP, DLWMEAN ) + DIA, IX, IY, LAMBDA, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN ) #endif #ifdef W3_ST6 CALL W3SPR6 (A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX, FP) @@ -2430,7 +2430,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) USTAR, USTD, TAUWX, TAUWY, CD, Z0, & CHARN, LLWS, FMEANWS, DLWMEAN ) CALL W3SDS4 ( A, WN, CG, USTAR, USTD, DEPTH, DAIR, XDS, & - DIA, IX, IY, LAMBDA, WHITECAP, DLWMEAN ) + DIA, IX, IY, LAMBDA, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN ) CALL W3SIN4 (A, CG, WN2, UABS, USTAR, DAIR/DWAT, & ASO(J), UDIRR, Z0, CD, TAUWX, TAUWY, TAUWNX, & TAUWNY, XIN, DIA, LLWS, IX, IY, LAMBDA ) @@ -2480,7 +2480,7 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) USTAR, USTD, TAUWX, TAUWY, CD, Z0, & CHARN, LLWS, FMEANWS, DLWMEAN ) CALL W3SDS4 ( A, WN, CG, USTAR, USTD, DEPTH, DAIR, XDS, & - DIA, IX, IY, LAMBDA, WHITECAP , DLWMEAN) + DIA, IX, IY, LAMBDA, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN) #endif #ifdef W3_ST6 CALL W3SDS6 ( A, CG, WN, XDS, DIA ) @@ -2502,8 +2502,8 @@ SUBROUTINE W3EXNC(I,NCID,NREQ,INDREQ,ORDER) ISEA=1 ! to be fixed later D50 = SED_D50(ISEA) PSIC= SED_PSIC(ISEA) - CALL W3SBT4 ( A, CG, WN, DEPTH, D50, PSIC, TAUBBL, & - BEDFORM, XBT, DIA, IX, IY ) + CALL W3SBT4 ( A, CG, WN, DEPTH, D50, PSIC, TAUBBL(1), TAUBBL(2), & + BEDFORM(1), BEDFORM(2) ,BEDFORM(3), XBT, DIA, IX, IY ) #endif ! see remarks about BT8 and BT9 in ww3_outp.ftn diff --git a/model/src/ww3_outf.F90 b/model/src/ww3_outf.F90 index 590518037..983bf4feb 100644 --- a/model/src/ww3_outf.F90 +++ b/model/src/ww3_outf.F90 @@ -164,9 +164,11 @@ PROGRAM W3OUTF TAUOX, TAUOY, TAUWIX,BHD, & TAUWIY, PHIAW, PHIOC, TUSX, TUSY, PRMS, TPMS,& USSX, USSY, MSSX, MSSY, MSCX, MSCY, CHARN, & - TAUWNX, TAUWNY, TAUBBL, PHIBBL, CFLXYMAX, & - CFLTHMAX, CFLKMAX, BEDFORMS, WHITECAP, T02, & - CGE, T01, HSIG, STMAXE, STMAXD, HMAXE, & + TAUWNX, TAUWNY, TAUBBLX, TAUBBLY, PHIBBL, & + CFLXYMAX, CFLTHMAX, CFLKMAX, & + BEDROUGH, BEDRIPX, BEDRIPY, & + WCAP_COV, WCAP_THK, WCAP_BHS, WCAP_MNT, & + T02, CGE, T01, HSIG, STMAXE, STMAXD, HMAXE, & HCMAXE, HMAXD, HCMAXD, MSSD, MSCD, WBT, & WNMEAN, TAUA, TAUADIR USE W3ODATMD, ONLY: NDSO, NDSE, NDST, NOGRP, NGRPP, IDOUT, & @@ -1655,9 +1657,9 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) UNITS = '1' ENAME = '.wcc' IF ( ITYPE .EQ. 4 ) THEN - XS1 = WHITECAP(1:NSEA,1) + XS1 = WCAP_COV(1:NSEA) ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,1) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WCAP_COV(1:NSEA) & , MAPSF, X1 ) ENDIF ! @@ -1667,9 +1669,9 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) UNITS = 'm' ENAME = '.wcf' IF ( ITYPE .EQ. 4 ) THEN - XS1 = WHITECAP(1:NSEA,2) + XS1 = WCAP_THK(1:NSEA) ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,2) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WCAP_THK(1:NSEA) & , MAPSF, X1 ) ENDIF ! @@ -1679,9 +1681,9 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) UNITS = 'm' ENAME = '.wch' IF ( ITYPE .EQ. 4 ) THEN - XS1 = WHITECAP(1:NSEA,3) + XS1 = WCAP_BHS(1:NSEA) ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,3) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WCAP_BHS(1:NSEA) & , MAPSF, X1 ) ENDIF ! @@ -1691,9 +1693,9 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) UNITS = '1' ENAME = '.wcm' IF ( ITYPE .EQ. 4 ) THEN - XS1 = WHITECAP(1:NSEA,4) + XS1 = WCAP_MNT(1:NSEA) ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WHITECAP(1:NSEA,4) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, WCAP_MNT(1:NSEA) & , MAPSF, X1 ) ENDIF ! @@ -2037,19 +2039,19 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ENAME = '.bed' #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) + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, BEDRIPX(1:NSEA), & + BEDRIPY(1:NSEA), AnglD) #endif IF ( ITYPE .EQ. 4 ) THEN - XS1 = BEDFORMS(1:NSEA,1) - XS2 = BEDFORMS(1:NSEA,2) - XS3 = BEDFORMS(1:NSEA,3) + XS1 = BEDROUGH(1:NSEA) + XS2 = BEDRIPX(1:NSEA) + XS3 = BEDRIPY(1:NSEA) ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,1) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDROUGH(1:NSEA) & , MAPSF, X1 ) - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,2) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDRIPX(1:NSEA) & , MAPSF, X2 ) - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDFORMS(1:NSEA,3) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, BEDRIPY(1:NSEA) & , MAPSF, XY ) ENDIF ! @@ -2072,16 +2074,16 @@ SUBROUTINE W3EXGO ( NX, NY, NSEA ) ENAME = '.tbb' #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) + IF ( FLAGUNR ) CALL W3XYRTN(NSEA, TAUBBLX(1:NSEA), & + TAUBBLY(1:NSEA), AnglD) #endif IF ( ITYPE .EQ. 4 ) THEN - XS1 = TAUBBL(1:NSEA,1) - XS2 = TAUBBL(1:NSEA,2) + XS1 = TAUBBLX(1:NSEA) + XS2 = TAUBBLY(1:NSEA) ELSE - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBL(1:NSEA,1) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBLX(1:NSEA) & , MAPSF, XX ) - CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBL(1:NSEA,2) & + CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUBBLY(1:NSEA) & , MAPSF, XY ) ENDIF ! diff --git a/model/src/ww3_outp.F90 b/model/src/ww3_outp.F90 index d793783ca..855e51b4c 100644 --- a/model/src/ww3_outp.F90 +++ b/model/src/ww3_outp.F90 @@ -1321,7 +1321,7 @@ SUBROUTINE W3EXPO #endif #ifdef W3_ST4 REAL :: AMAX, FMEANS, FMEANWS, TAUWX, TAUWY, & - TAUWNX, TAUWNY, FMEAN1, WHITECAP(1:4), DLWMEAN + TAUWNX, TAUWNY, FMEAN1, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN #endif #ifdef W3_ST6 REAL :: AMAX, TAUWX, TAUWY, TAUWNX, TAUWNY @@ -2029,7 +2029,7 @@ SUBROUTINE W3EXPO #endif #ifdef W3_ST4 CALL W3SDS4 ( A, WN, CG, USTAR, USTD, DEPTH, DAIR, XDS, & - DIA, IX, IY, LAMBDA, WHITECAP, DLWMEAN ) + DIA, IX, IY, LAMBDA, WCAP_DUM1, WCAP_DUM2, WCAP_DUM3, DLWMEAN ) #endif #ifdef W3_ST6 CALL W3SDS6 ( A, CG, WN, XDS, DIA ) @@ -2054,8 +2054,8 @@ SUBROUTINE W3EXPO #endif #ifdef W3_BT4 - CALL W3SBT4 ( A, CG, WN, DEPTH, D50, PSIC, TAUBBL, & - BEDFORM, XBT, DIA, IX, IY ) + CALL W3SBT4 ( A, CG, WN, DEPTH, D50, PSIC, TAUBBL(1), TAUBBL(2), & + BEDFORM(1), BEDFORM(2), BEDFORM(3), XBT, DIA, IX, IY ) #endif BT8MSG='ww3_outp: ITYPE=3 with BT8 or BT9: Sbot out'//& diff --git a/model/src/ww3_shel.F90 b/model/src/ww3_shel.F90 index 4bb888b48..15b4168e0 100644 --- a/model/src/ww3_shel.F90 +++ b/model/src/ww3_shel.F90 @@ -283,6 +283,7 @@ PROGRAM W3SHEL USE W3IOPOMD USE W3SERVMD, ONLY : NEXTLN, EXTCDE USE W3TIMEMD + USE W3SRCEMD, ONLY: W3SRCE_INIT #ifdef W3_OASIS USE W3OACPMD, ONLY: CPL_OASIS_INIT, CPL_OASIS_GRID, & @@ -641,6 +642,10 @@ PROGRAM W3SHEL WRITE (NDST,9000) (NDS(I),I=1,12) WRITE (NDST,9001) (NTRACE(I),I=1,2) #endif + + ! Source term refactor - init some stuff in W3SRCE + CALL W3SRCE_INIT() + ! ! 1.c Local parameters ! diff --git a/regtests/bin/matrix_cmake_ukmo_cray b/regtests/bin/matrix_cmake_ukmo_cray index fc6cf64b9..bbd2121e4 100755 --- a/regtests/bin/matrix_cmake_ukmo_cray +++ b/regtests/bin/matrix_cmake_ukmo_cray @@ -131,39 +131,39 @@ fi export omp='y' # Threaded (OpenMP) tests export hybd='y' # Hybrid options - export prop1D='y' # 1-D propagation tests (ww3_tp1.X) - export prop2D='y' # 2-D propagation tests (ww3_tp2.X) - export time='y' # time linmited growth - export fetch='y' # fetch linmited growth - export hur1mg='y' # Hurricane with one moving grid - export shwtr='y' # shallow water tests - export unstr='y' # unstructured grid tests - export pdlib='y' # unstr with pdlib for domain decomposition and implicit solver + export prop1D='n' # 1-D propagation tests (ww3_tp1.X) + export prop2D='n' # 2-D propagation tests (ww3_tp2.X) + export time='n' # time linmited growth + export fetch='n' # fetch linmited growth + export hur1mg='n' # Hurricane with one moving grid + export shwtr='n' # shallow water tests + export unstr='n' # unstructured grid tests + export pdlib='n' # unstr with pdlib for domain decomposition and implicit solver export smcgr='y' # SMC grid test - export rtd='y' # Rotated pole test + export rtd='n' # Rotated pole test export mudice='y' # Mud/Ice and wave interaction tests - export infgrv='y' # Second harmonic generation tests - export uost='y' # ww3_ts4 Unresolved Obstacles Source Term (UOST) - export assim='y' # Restart spectra update - export oasis='y' # Atmosphere, ocean, and ice coupling using oasis - export calendar='y' # Calendar type - export confignc='y' # Configurable netCDF meta data (ww3_ounf) - - export multi01='y' # mww3_test_01 (wetting and drying) - export multi02='y' # mww3_test_02 (basic two-way nesting test)) - export multi03='y' # mww3_test_03 (three high and three low res grids). - export multi04='y' # mww3_test_04 (swell on sea mount and/or current) - export multi05='y' # mww3_test_05 (three-grid moving hurricane) - export multi06='y' # mww3_test_06 (curvilinear grid tests) - export multi07='y' # mww3_test_07 (unstructured grid tests) - export multi08='y' # mww3_test_08 (wind and ice tests) - export multi09='y' # mww3_test_09 (SMC multi grid test) + export infgrv='n' # Second harmonic generation tests + export uost='n' # ww3_ts4 Unresolved Obstacles Source Term (UOST) + export assim='n' # Restart spectra update + export oasis='n' # Atmosphere, ocean, and ice coupling using oasis + export calendar='n' # Calendar type + export confignc='n' # Configurable netCDF meta data (ww3_ounf) + + export multi01='n' # mww3_test_01 (wetting and drying) + export multi02='n' # mww3_test_02 (basic two-way nesting test)) + export multi03='n' # mww3_test_03 (three high and three low res grids). + export multi04='n' # mww3_test_04 (swell on sea mount and/or current) + export multi05='n' # mww3_test_05 (three-grid moving hurricane) + export multi06='n' # mww3_test_06 (curvilinear grid tests) + export multi07='n' # mww3_test_07 (unstructured grid tests) + export multi08='n' # mww3_test_08 (wind and ice tests) + export multi09='n' # mww3_test_09 (SMC multi grid test) export ufs='n' # The Unified Forecast System export ufscoarse='n' # Option for small PCs export grib='n' # grib file field output - export rstrt_b4b='y' # Restart Reproducibility - export npl_b4b='y' # MPI task Reproducibility - export nth_b4b='y' # Thread Reproducibility + export rstrt_b4b='n' # Restart Reproducibility + export npl_b4b='n' # MPI task Reproducibility + export nth_b4b='n' # Thread Reproducibility export esmf='n' # ESMF coupling # export filter='PR3 ST2 UQ' # The filter does a set of consecutinve greps on the diff --git a/regtests/bin/matrix_divider_cmake.sh b/regtests/bin/matrix_divider_cmake.sh index b88638911..b946135c4 100755 --- a/regtests/bin/matrix_divider_cmake.sh +++ b/regtests/bin/matrix_divider_cmake.sh @@ -73,6 +73,7 @@ count=0 cat before >> matrix${countf} cat list_mpi_$i >> matrix${countf} sed -i 's/'matrix.out'/'matrix${countf}.out'/gI' matrix${countf} + sed -i 's/'matrix.err'/'matrix${countf}.err'/gI' matrix${countf} sed -i 's/'buildmatrix'/'buildmatrix${countf}'/gI' matrix${countf} sed -i 's/'ww3_regtest'/'ww3_regtest_${countf}'/gI' matrix${countf} echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}*' >> matrix${countf} @@ -94,6 +95,7 @@ count=0 cat before >> matrix${countf} cat list_omp_$i >> matrix${countf} sed -i 's/'matrix.out'/'matrix${countf}.out'/gI' matrix${countf} + sed -i 's/'matrix.err'/'matrix${countf}.err'/gI' matrix${countf} sed -i 's/'buildmatrix'/'buildmatrix${countf}'/gI' matrix${countf} sed -i 's/'ww3_regtest'/'ww3_regtest_${countf}'/gI' matrix${countf} echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}*' >> matrix${countf} @@ -115,6 +117,7 @@ count=0 cat before >> matrix${countf} cat list_serial_$i >> matrix${countf} sed -i 's/'matrix.out'/'matrix${countf}.out'/gI' matrix${countf} + sed -i 's/'matrix.err'/'matrix${countf}.err'/gI' matrix${countf} sed -i 's/'buildmatrix'/'buildmatrix${countf}'/gI' matrix${countf} sed -i 's/'ww3_regtest'/'ww3_regtest_${countf}'/gI' matrix${countf} echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}*' >> matrix${countf} @@ -136,6 +139,7 @@ count=0 cat before >> matrix${countf} cat list_heavy >> matrix${countf} sed -i 's/'matrix.out'/'matrix${countf}.out'/gI' matrix${countf} + sed -i 's/'matrix.err'/'matrix${countf}.err'/gI' matrix${countf} sed -i 's/'buildmatrix'/'buildmatrix${countf}'/gI' matrix${countf} sed -i 's/'ww3_regtest'/'ww3_regtest_${countf}'/gI' matrix${countf} echo ' [[ -d ${path_build_root} ]] && rm -rf ${path_build_root}*' >> matrix${countf} @@ -156,6 +160,7 @@ count=0 sed -i 's/'n\ 24'/'n\ 140'/gI' matrix${countf} cat list_ufs >> matrix${countf} sed -i 's/'matrix.out'/'matrix${countf}.out'/gI' matrix${countf} + sed -i 's/'matrix.err'/'matrix${countf}.err'/gI' matrix${countf} sed -i 's/'##SBATCH'/'#SBATCH'/gI' matrix${countf} sed -i 's/'buildmatrix'/'buildmatrix${countf}'/gI' matrix${countf} sed -i 's/'ww3_regtest'/'ww3_regtest_${countf}'/gI' matrix${countf}