From bccd5e6d19d162e0f50c10159cdeb9729d899912 Mon Sep 17 00:00:00 2001 From: Erin Thomas Date: Wed, 28 May 2025 09:38:22 -0700 Subject: [PATCH 1/5] ADD Z0 and USTAR2 to output for E3SM Coupling --- model/src/w3adatmd.F90 | 37 ++++++++++++++++++++++++++++++++++--- model/src/w3iogomd.F90 | 16 ++++++++++++++-- model/src/w3odatmd.F90 | 4 +++- model/src/w3src4md.F90 | 10 +++++++--- model/src/w3srcemd.F90 | 22 ++++++++++++++++------ model/src/w3wavemd.F90 | 3 +++ 6 files changed, 77 insertions(+), 15 deletions(-) diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 3c0a70591f..6944d3c142 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -131,6 +131,8 @@ MODULE W3ADATMD ! WNMEAN R.A. Public Mean wave number ! ! CHARN R.A. Public Charnock parameter for air-sea friction. +! Z0 R.A. Public Sfc Roughness Length for E3SM Coupling +! USTAR2 R.A. Public Friction Velocity for E3SM coupling ! TWS R.A. Public Wind sea period (used for flux parameterizations) ! CGE R.A. Public Energy flux. ! PHIAW R.A. Public Wind to wave energy flux. @@ -417,10 +419,12 @@ MODULE W3ADATMD ! ! Output fields group 5) ! - REAL, POINTER :: CHARN(:), CGE(:), PHIAW(:), & + REAL, POINTER :: CHARN(:), Z0(:), USTAR2(:), & + CGE(:), PHIAW(:), & TAUWIX(:), TAUWIY(:), TAUWNX(:), & TAUWNY(:), WHITECAP(:,:), TWS(:) - REAL, POINTER :: XCHARN(:), XCGE(:), XPHIAW(:), & + REAL, POINTER :: XCHARN(:), XZ0(:) , XUSTAR2(:), & + XCGE(:), XPHIAW(:), & XTAUWIX(:), XTAUWIY(:), XTAUWNX(:), & XTAUWNY(:), XWHITECAP(:,:), XTWS(:) ! @@ -576,7 +580,8 @@ MODULE W3ADATMD PTHP0(:,:), PQP(:,:), PPE(:,:), & PTM1(:,:), PT1(:,:), PT2(:,:),PEP(:,:) ! - REAL, POINTER :: CHARN(:), CGE(:), PHIAW(:), & + REAL, POINTER :: CHARN(:), Z0(:), USTAR2(:), & + CGE(:), PHIAW(:), & TAUWIX(:), TAUWIY(:), TAUWNX(:), & TAUWNY(:), WHITECAP(:,:), TWS(:) ! @@ -1155,6 +1160,8 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ! Friction velocity UST and USTDIR in W3WDATMD ! ALLOCATE ( WADATS(IMOD)%CHARN (NSEALM), & + WADATS(IMOD)%Z0 (NSEALM), & + WADATS(IMOD)%USTAR2 (NSEALM), & WADATS(IMOD)%TWS (NSEALM), & WADATS(IMOD)%CGE (NSEALM), & WADATS(IMOD)%PHIAW (NSEALM), & @@ -1167,6 +1174,8 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) CHECK_ALLOC_STATUS ( ISTAT ) ! WADATS(IMOD)%CHARN = UNDEF + WADATS(IMOD)%Z0 = UNDEF + WADATS(IMOD)%USTAR2 = UNDEF WADATS(IMOD)%TWS = UNDEF WADATS(IMOD)%CGE = UNDEF WADATS(IMOD)%PHIAW = UNDEF @@ -2058,8 +2067,26 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) ALLOCATE ( WADATS(IMOD)%XTWS(1), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF + + IF ( OUTFLAGS( 5, 12) ) THEN + ALLOCATE ( WADATS(IMOD)%XZ0(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ELSE + ALLOCATE ( WADATS(IMOD)%XZ0(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + END IF + + IF ( OUTFLAGS( 5, 13) ) THEN + ALLOCATE ( WADATS(IMOD)%XUSTAR2(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ELSE + ALLOCATE ( WADATS(IMOD)%XUSTAR2(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + END IF ! WADATS(IMOD)%XCHARN = UNDEF + WADATS(IMOD)%XZ0 = UNDEF + WADATS(IMOD)%XUSTAR2 = UNDEF WADATS(IMOD)%XTWS = UNDEF WADATS(IMOD)%XCGE = UNDEF WADATS(IMOD)%XPHIAW = UNDEF @@ -2890,6 +2917,8 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) PEP => WADATS(IMOD)%PEP ! CHARN => WADATS(IMOD)%CHARN + Z0 => WADATS(IMOD)%Z0 + USTAR2 => WADATS(IMOD)%USTAR2 TWS => WADATS(IMOD)%TWS CGE => WADATS(IMOD)%CGE PHIAW => WADATS(IMOD)%PHIAW @@ -3228,6 +3257,8 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) PEP => WADATS(IMOD)%XPEP ! CHARN => WADATS(IMOD)%XCHARN + Z0 => WADATS(IMOD)%XZ0 + USTAR2 => WADATS(IMOD)%XUSTAR2 TWS => WADATS(IMOD)%XTWS CGE => WADATS(IMOD)%XCGE PHIAW => WADATS(IMOD)%XPHIAW diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index e7f224f255..c6196876a6 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1209,7 +1209,7 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) SYY, SXY, PHS, PTP, PLP, PDIR, PSI, PWS, & PWST, PNR, USERO, TUSX, TUSY, PRMS, TPMS, & USSX, USSY, MSSX, MSSY, MSSD, MSCX, MSCY, & - MSCD, CHARN, & + MSCD, CHARN, Z0, USTAR2, & BHD, CGE, P2SMS, US3D, EF, TH1M, STH1M, & TH2M, STH2M, HSIG, STMAXE, STMAXD, & HCMAXE, HMAXE, HCMAXD, HMAXD, USSP, QP, PQP,& @@ -2596,7 +2596,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) CFLXYMAX, CFLTHMAX, CFLKMAX, P2SMS, US3D, & TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, TAUICE,& STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& - USSP, TAUOCX, TAUOCY + USSP, TAUOCX, TAUOCY, Z0, USTAR2 !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & @@ -2915,6 +2915,8 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) 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,12) ) Z0(ISEA) = UNDEF + IF ( FLOGRD( 5,13) ) USTAR2(ISEA) = UNDEF ! IF ( FLOGRD( 6, 1) ) THEN SXX (ISEA) = UNDEF @@ -3232,6 +3234,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) WRITE ( NDSOG ) WHITECAP(1:NSEA,4) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) TWS(1:NSEA) + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 12 ) THEN + WRITE ( NDSOG ) Z0(1:NSEA) + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 13 ) THEN + WRITE ( NDSOG ) USTAR2(1:NSEA) ! ! Section 6) ! @@ -3553,6 +3559,12 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 11 ) THEN READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & TWS(1:NSEA) + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 12 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + Z0(1:NSEA) + ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ. 13 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + USTAR2(1:NSEA) ! ! Section 6) ! diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index 2e8e65eecd..381bda3bfc 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -846,7 +846,7 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST, NDSOUT) ! ! 5) Atmosphere-waves layer ! - NOGE(5) = 11 + NOGE(5) = 13 ! IDOUT( 5, 1) = 'Friction velocity ' IDOUT( 5, 2) = 'Charnock parameter ' @@ -860,6 +860,8 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST, NDSOUT) IDOUT( 5,10) = 'Dominant break prob ' IDOUT( 5,11) = 'Wind sea period' ! C.Bunney - reinstated this as is used in ww3_ounf ! Is it suposed to be defunct? It is not in ww3_outf... + IDOUT( 5, 12) = 'Sfc Rough. Length ' + IDOUT( 5, 13) = 'Friction Velocity ' ! ! 6) Wave-ocean layer ! diff --git a/model/src/w3src4md.F90 b/model/src/w3src4md.F90 index 0c42999265..ee51f10206 100644 --- a/model/src/w3src4md.F90 +++ b/model/src/w3src4md.F90 @@ -88,7 +88,8 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & TAUA, TAUADIR, DAIR, & #endif USTAR, USDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + TAUWX, TAUWY, CD, Z0, CHARN, USTAR2, & + LLWS, FMEANWS, DLWMEAN) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III SHOM | @@ -136,6 +137,7 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & ! CD Real O Drag coefficient at wind level ZWND. ! Z0 Real O Corresponding z0. ! CHARN Real O Corresponding Charnock coefficient +! USTAR2 Real I/O Friction velocity for E3SM coupling ! LLWS L.A. I Wind sea true/false array for each component ! FMEANWS Real O Mean frequency of wind sea, used for tail ! DLWMEAN Real O Mean Long wave direction (L. Romero 2019) @@ -196,9 +198,10 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & #endif REAL, INTENT(IN) :: TAUWX, TAUWY LOGICAL, INTENT(IN) :: LLWS(NSPEC) - REAL, INTENT(INOUT) :: USTAR ,USDIR + REAL, INTENT(INOUT) :: USTAR, USDIR REAL, INTENT(OUT) :: EMEAN, FMEAN, FMEAN1, WNMEAN, AMAX, & - CD, Z0, CHARN, FMEANWS, DLWMEAN + CD, Z0, CHARN, FMEANWS, DLWMEAN, & + USTAR2 !/ !/ ------------------------------------------------------------------- / !/ Local parameters @@ -306,6 +309,7 @@ SUBROUTINE W3SPR4 (A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, & CALL CALC_USTAR(U,TAUW,USTAR,Z0,CHARN) UNZ = MAX ( 0.01 , U ) CD = (USTAR/UNZ)**2 + USTAR2 = USTAR USDIR = UDIR #endif ! diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 73f2f639af..475f2715f4 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -61,7 +61,8 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & REFLEC, REFLED, DELX, DELY, DELA, TRNX, & TRNY, BERG, FPI, DTDYN, FCUT, DTG, TAUWX, & TAUWY, TAUOX, TAUOY, TAUWIX, TAUWIY, TAUWNX,& - TAUWNY, PHIAW, CHARN, TWS, PHIOC, WHITECAP, & + TAUWNY, PHIAW, CHARN, Z0, USTAR2, & + TWS, PHIOC, WHITECAP, & D50, PSIC, BEDFORM , PHIBBL, TAUBBL, TAUICE,& PHICE, TAUOCX, TAUOCY, WNMEAN, DAIR, COEF) !/ @@ -224,6 +225,9 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! TAUOCX-YReal O Total ocean momentum components ! WNMEAN Real O Mean wave number ! DAIR Real I Air density +! CHARN Real I/O Charnock parameter +! Z0 Real I/O Sfc Roughness Length +! USTAR2 Real I/O Friction Vel for E3SM Coupling ! ---------------------------------------------------------------- ! Note: several pars are set to I/O to avoid compiler warnings. ! @@ -530,7 +534,8 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & SPEC(NSPEC), ALPHA(NK), USTAR, & USTDIR, FPI, TAUOX, TAUOY, & TAUWX, TAUWY, PHIAW, PHIOC, PHICE, & - CHARN, TWS, BEDFORM(3), PHIBBL, & + CHARN, Z0, USTAR2, & + TWS, BEDFORM(3), PHIBBL, & TAUBBL(2), TAUICE(2), WHITECAP(4), & TAUWIX, TAUWIY, TAUWNX, TAUWNY, & ICEF, TAUOCX, TAUOCY, WNMEAN @@ -559,7 +564,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & HDT, ZWND, FP, DEPTH, TAUSCX, TAUSCY, FHIGI ! Scaling factor for SIN, SDS, SNL REAL :: ICESCALELN, ICESCALEIN, ICESCALENL, ICESCALEDS - REAL :: EMEAN, FMEAN, AMAX, CD, Z0, SCAT, & + REAL :: EMEAN, FMEAN, AMAX, CD, SCAT, & SMOOTH_ICEDISP REAL :: WN_R(NK), CG_ICE(NK),ALPHA_LIU(NK), ICECOEF2,& R(NK) @@ -843,6 +848,8 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & NSTEPS = 0 PHIAW = 0. CHARN = 0. + Z0 = 0. + USTAR2 = 0. TWS = 0. PHINL = 0. PHIBBL = 0. @@ -937,7 +944,8 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & TAUA, TAUADIR, DAIR, & #endif USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + TAUWX, TAUWY, CD, Z0, CHARN, USTAR2, & + LLWS, FMEANWS, DLWMEAN) #endif #ifdef W3_DEBUGSRC @@ -980,7 +988,8 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & TAUA, TAUADIR, DAIR, & #endif USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + TAUWX, TAUWY, CD, Z0, CHARN, USTAR2, & + LLWS, FMEANWS, DLWMEAN) TWS = 1./FMEANWS #endif #ifdef W3_ST6 @@ -1636,7 +1645,8 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & TAUA, TAUADIR, DAIR, & #endif USTAR, USTDIR, & - TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS, DLWMEAN) + TAUWX, TAUWY, CD, Z0, CHARN, USTAR2, & + LLWS, FMEANWS, DLWMEAN) #endif #ifdef W3_ST6 CALL W3SPR6 (SPEC, CG1, WN1, EMEAN, FMEAN, WNMEAN, AMAX, FP) diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 29659b39a9..ff89cc970a 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -1889,6 +1889,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & TAUWIY(JSEA), TAUWNX(JSEA), & TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & + Z0(JSEA), USTAR2(JSEA), & TWS(JSEA), PHIOC(JSEA), TMP1, D50, PSIC, TMP2, & PHIBBL(JSEA), TMP3, TMP4, PHICE(JSEA), & TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & @@ -2733,6 +2734,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & TAUWIY(JSEA), TAUWNX(JSEA), & TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & + Z0(JSEA), USTAR2(JSEA), & TWS(JSEA),PHIOC(JSEA), TMP1, D50, PSIC, TMP2,& PHIBBL(JSEA), TMP3, TMP4, PHICE(JSEA), & TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & @@ -2759,6 +2761,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & TAUOX(JSEA), TAUOY(JSEA), TAUWIX(JSEA), & TAUWIY(JSEA), TAUWNX(JSEA), & TAUWNY(JSEA), PHIAW(JSEA), CHARN(JSEA), & + Z0(JSEA), USTAR2(JSEA), & TWS(JSEA), PHIOC(JSEA), TMP1, D50, PSIC,TMP2,& PHIBBL(JSEA), TMP3, TMP4 , PHICE(JSEA), & TAUOCX(JSEA), TAUOCY(JSEA), WNMEAN(JSEA), & From 1cc49e76d32368ea813bc674a62e57d251d3fc3c Mon Sep 17 00:00:00 2001 From: Erin Thomas Date: Wed, 28 May 2025 18:20:50 -0700 Subject: [PATCH 2/5] add IC4M10 --- model/src/w3sic4md.F90 | 40 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) diff --git a/model/src/w3sic4md.F90 b/model/src/w3sic4md.F90 index 8661b42af8..2d84fe9653 100644 --- a/model/src/w3sic4md.F90 +++ b/model/src/w3sic4md.F90 @@ -322,7 +322,8 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) REAL, ALLOCATABLE :: ALPHA(:) ! exponential decay rate for energy REAL, ALLOCATABLE :: MARG1(:), MARG2(:) ! Arguments for M2 REAL, ALLOCATABLE :: KARG1(:), KARG2(:), KARG3(:) !Arguments for M3 - + REAL :: x1,x2,x3,x1sqr,x2sqr,x3sqr !Arguments for M10 + REAL :: perfour,amhb,bmhb !Arguments for M10 !/ !/ ------------------------------------------------------------------- / !/ @@ -513,6 +514,43 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) ALPHA(IK) = 0.2*(FREQ**2.13)*HICE END DO WN_I= 0.5 * ALPHA + + CASE (10) + ! Cubic fit to Meylan, Horvat & Bitz 2021 + ! ICECOEF1 is thickness + ! ICECOEF5 is floe size + ! TPI/SIG is period + x3=min(ICECOEF1,3.5) ! limit thickness to 3.5 m + x3=max(x3,0.1) ! limit thickness >0.1 m since I make fit below + x2=min(ICECOEF5*0.5,100.0) ! convert dia to radius, limit to 100m + x2=max(2.5,x2) + x2sqr=x2*x2 + x3sqr=x3*x3 + amhb = 2.12e-3 + bmhb = 4.59e-2 + + DO IK=1, NK + x1=TPI/SIG(IK) ! period + x1sqr=x1*x1 + KARG1(ik)=-0.26982 + 1.5043*x3 - 0.70112*x3sqr + 0.011037*x2 + & + (-0.0073178)*x2*x3 + 0.00036604*x2*x3sqr + & + (-0.00045789)*x2sqr + 1.8034e-05*x2sqr*x3 + & + (-0.7246)*x1 + 0.12068*x1*x3 + & + (-0.0051311)*x1*x3sqr + 0.0059241*x1*x2 + & + 0.00010771*x1*x2*x3 - 1.0171e-05*x1*x2sqr + & + 0.0035412*x1sqr - 0.0031893*x1sqr*x3 + & + (-0.00010791)*x1sqr*x2 + & + 0.00031073*x1**3 + 1.5996e-06*x2**3 + 0.090994*x3**3 + KARG1(IK)=min(KARG1(IK),0.0) + ALPHA(IK) = 10.0**KARG1(IK) + perfour=x1sqr*x1sqr + if ((x1.gt.5.0) .and. (x1.lt.20.0)) then + ALPHA(IK) = ALPHA(IK) + amhb/x1sqr+bmhb/perfour + else if (x1.gt.20.0) then + ALPHA(IK) = amhb/x1sqr+bmhb/perfour + endif + WN_I(IK) = ALPHA(IK) * 0.5 + end do CASE DEFAULT WN_I = ICECOEF1 !Default to IC1: Uniform in k From 5aadc04ed98b2442891b6751e0dced2dbea948ca Mon Sep 17 00:00:00 2001 From: Erin Thomas Date: Wed, 28 May 2025 19:49:51 -0700 Subject: [PATCH 3/5] IC NUMERIC --- model/src/w3gdatmd.F90 | 5 +++- model/src/w3gridmd.F90 | 9 ++++-- model/src/w3iogrmd.F90 | 4 +-- model/src/w3srcemd.F90 | 66 +++++++++++++++++++++++++++++++++++++++++- 4 files changed, 77 insertions(+), 7 deletions(-) diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 9331a70e33..126d5300c6 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -680,6 +680,7 @@ MODULE W3GDATMD LOGICAL :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,& IICESMOOTH + LOGICAL :: IC_NUMERICS LOGICAL :: FLAGLL LOGICAL :: CMPRTRCK LOGICAL, POINTER :: FLAGST(:) @@ -1182,6 +1183,7 @@ MODULE W3GDATMD LOGICAL, POINTER :: GINIT, FLDRY, FLCX, FLCY, FLCTH, FLCK, FLSOU, IICEDISP,& IICESMOOTH + LOGICAL, POINTER :: IC_NUMERICS LOGICAL, POINTER :: FLAGLL LOGICAL, POINTER :: CMPRTRCK LOGICAL, POINTER :: FLAGST(:) @@ -2359,7 +2361,8 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) FLSOU => GRIDS(IMOD)%FLSOU IICEDISP => GRIDS(IMOD)%IICEDISP IICESMOOTH => GRIDS(IMOD)%IICESMOOTH -! + IC_NUMERICS => GRIDS(IMOD)%IC_NUMERICS + ! GNAME => GRIDS(IMOD)%GNAME FILEXT => GRIDS(IMOD)%FILEXT TRIGP => GRIDS(IMOD)%TRIGP diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 967cc25726..b22adaa678 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -808,6 +808,7 @@ MODULE W3GRIDMD ! REAL(8) :: GSHIFT ! see notes in WMGHGH LOGICAL :: FLC, ICEDISP, TRCKCMPR + LOGICAL :: ICNUMERICS INTEGER :: PTM ! Partitioning method REAL :: PTFC ! Part. cut off freq (for method 5) REAL :: AIRCMIN, AIRGB @@ -1101,7 +1102,7 @@ MODULE W3GRIDMD STDX, STDY, STDT, ICEHMIN, ICEHINIT, ICEDISP, & ICESLN, ICEWIND, ICESNL, ICESDS, ICEHFAC, & ICEHDISP, ICEDDISP, ICEFDISP, CALTYPE, & - TRCKCMPR, PTM, PTFC, BTBET + TRCKCMPR, PTM, PTFC, BTBET, ICNUMERICS NAMELIST /OUTS/ P2SF, I1P2SF, I2P2SF, & US3D, I1US3D, I2US3D, & USSP, IUSSP, STK_WN, & @@ -2744,6 +2745,7 @@ SUBROUTINE W3GRID(MDS) STDY = -1. STDT = -1. ICEDISP = .FALSE. + ICNUMERICS=.FALSE. CALTYPE = 'standard' ! Variables for 3D array output E3D=0 @@ -3017,6 +3019,7 @@ SUBROUTINE W3GRID(MDS) IICEHDISP = ICEHDISP IICEDDISP = ICEDDISP IICEFDISP = ICEFDISP + IC_NUMERICS=ICNUMERICS PMOVE = MAX ( 0. , PMOVE ) PFMOVE = PMOVE ! @@ -3404,7 +3407,7 @@ SUBROUTINE W3GRID(MDS) ICEHINIT, ICEDISP, ICEHDISP, & ICESLN, ICEWIND, ICESNL, ICESDS, & ICEDDISP,ICEFDISP, CALTYPE, TRCKCMPR, & - BTBETA + BTBETA,ICNUMERICS ELSE WRITE (NDSO,2966) CICE0, CICEN, LICE, PMOVE, XSEED, FLAGTR, & XP, XR, XFILT, IHMAX, HSPMIN, WSMULT, & @@ -3414,7 +3417,7 @@ SUBROUTINE W3GRID(MDS) ICEHINIT, ICEDISP, ICEHDISP, & ICESLN, ICEWIND, ICESNL, ICESDS, & ICEDDISP, ICEFDISP, CALTYPE, TRCKCMPR,& - BTBETA + BTBETA,ICNUMERICS END IF ! #ifdef W3_FLD1 diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index 2775bcfb43..3c1ff36f10 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -787,7 +787,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, CTHG0S, & STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, IICEDISP, & ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, IICEHDISP,& - IICEDDISP, IICEFDISP, BTBETA, & + IICEDDISP, IICEFDISP, BTBETA, IC_NUMERICS, & AAIRCMIN, AAIRGB WRITE(NDSM)GRIDSHIFT @@ -980,7 +980,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) FLCTH, FLCK, FLSOU, FLBPI, FLBPO, CLATS, CLATIS, & CTHG0S, STEXU, STEYU, STEDU, IICEHMIN, IICEHINIT, & IICEDISP, ICESCALES(1:4), CALTYPE, CMPRTRCK, IICEHFAC, & - IICEDDISP, IICEHDISP, IICEFDISP, BTBETA, & + IICEDDISP, IICEHDISP, IICEFDISP, BTBETA, IC_NUMERICS, & AAIRCMIN, AAIRGB #ifdef W3_DEBUGIOGR WRITE(740+IAPROC,*) 'W3IOGR, step 7.14' diff --git a/model/src/w3srcemd.F90 b/model/src/w3srcemd.F90 index 475f2715f4..1eb5ee0468 100644 --- a/model/src/w3srcemd.F90 +++ b/model/src/w3srcemd.F90 @@ -366,6 +366,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & XFC, XFLT, XREL, XFT, FXFM, FXPM, DDEN, & FTE, FTF, FHMAX, ECOS, ESIN, IICEDISP, & ICESCALES, IICESMOOTH + USE W3GDATMD, ONLY: IC_NUMERICS USE W3GDATMD, ONLY: FSSOURCE, optionCall USE W3GDATMD, ONLY: B_JGS_NLEVEL, B_JGS_SOURCE_NONLINEAR #ifdef W3_REF1 @@ -1227,6 +1228,32 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & CALL UOST_SRCTRMCOMPUTE(IX, IY, SPEC, CG1, DT, & U10ABS, U10DIR, VSUO, VDUO) #endif +! Sea Ice Source Terms if IC_NUMERICS namelist flag = True + IF (IC_NUMERICS) THEN +#ifdef W3_IC1 + IF (ICE .GT. 0) CALL W3SIC1 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IS2 + IF (ICE .GT. 0) CALL W3SIS2 ( SPEC, DEPTH, ICE, ICEH, ICEF, ICEDMAX, IX, IY, & + VSIR, VDIR, VDIR2, WN1, CG1, WN_R, CG_ICE, R ) +#endif +#ifdef W3_IC2 + IF (ICE .GT. 0) CALL W3SIC2 ( SPEC, DEPTH, ICEH, ICEF, CG1, WN1,& + IX, IY, VSIC, VDIC, WN_R, CG_ICE, ALPHA_LIU, R) +#endif +#ifdef W3_IC3 + IF (ICE .GT. 0) CALL W3SIC3 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IC4 + IF (ICE .GT. 0) CALL W3SIC4 ( SPEC,DEPTH, CG1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IC5 + IF (ICE .GT. 0) CALL W3SIC5 ( SPEC,DEPTH, CG1, WN1, IX, IY, VSIC, VDIC ) +#endif +#ifdef W3_IS1 + IF (ICE .GT. 0) CALL W3SIS1 ( SPEC, ICE, VSIR ) +#endif + ENDIF ! ! 2.g Dump training data if necessary ! @@ -1288,6 +1315,12 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & VDIN(1:NSPECH) = ICESCALEIN * VDIN(1:NSPECH) VSDS(1:NSPECH) = ICESCALEDS * VSDS(1:NSPECH) VDDS(1:NSPECH) = ICESCALEDS * VDDS(1:NSPECH) + IF(IC_NUMERICS) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + VSIC(1:NSPECH) = ICE * VSIC(1:NSPECH) ! (see Rogers et al 2016) + VDIC(1:NSPECH) = ICE * VDIC(1:NSPECH) +#endif + ENDIF END IF ! VS = 0 @@ -1307,6 +1340,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_UOST VS(IS) = VS(IS) + VSUO(IS) #endif + IF ( IC_NUMERICS .AND. ICE.GT.0. ) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + VS(IS) = VS(IS) + VSIC(IS) +#endif + ENDIF VD(IS) = VDIN(IS) + VDNL(IS) & + VDDS(IS) + VDBT(IS) #ifdef W3_ST6 @@ -1321,6 +1359,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #ifdef W3_UOST VD(IS) = VD(IS) + VDUO(IS) #endif + IF ( IC_NUMERICS .AND. ICE.GT.0. ) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + VD(IS) = VD(IS) + VDIC(IS) +#endif + ENDIF DAMAX = MIN ( DAM(IS) , MAX ( XREL*SPECINIT(IS) , AFILT ) ) AFAC = 1. / MAX( 1.E-10 , ABS(VS(IS)/DAMAX) ) #ifdef W3_NL5 @@ -1603,6 +1646,14 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & / MAX ( 1. , (1.-HDT*VDBT(IS))) ! semi-implict integration scheme PHINL = PHINL + VSNL(IS)* DT * FACTOR & / MAX ( 1. , (1.-HDT*VDNL(IS))) ! semi-implict integration scheme + IF ( IC_NUMERICS .AND. ICE.GT.0 ) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + PHICE = PHICE + VSIC(IS) * DT * FACTOR & + / MAX ( 1. , (1.-HDT*VDIC(IS))) ! semi-implicit integration + TAUICE(:) = TAUICE(:) - FACTOR2*COSI(:)*VSIC(IS) * DT & + / MAX ( 1. , (1.-HDT*VDIC(IS))) +#endif + ENDIF IF (VSIN(IS).GT.0.) WHITECAP(3) = WHITECAP(3) + SPEC(IS) * FACTOR HSTOT = HSTOT + SPEC(IS) * FACTOR END DO @@ -1867,6 +1918,13 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & ! TAUOX=(GRAV*MWXFINISH+TAUWIX-TAUBBL(1))/DTG TAUOY=(GRAV*MWYFINISH+TAUWIY-TAUBBL(2))/DTG + IF (IC_NUMERICS) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + TAUICE(:)=TAUICE(:)/DTG + TAUOX = TAUOX - TAUICE(1) + TAUOY = TAUOY - TAUICE(2) +#endif + ENDIF TAUWIX=TAUWIX/DTG TAUWIY=TAUWIY/DTG TAUWNX=TAUWNX/DTG @@ -1881,6 +1939,11 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & PHIAW =DWAT*GRAV*PHIAW /DTG PHINL =DWAT*GRAV*PHINL /DTG PHIBBL=DWAT*GRAV*PHIBBL/DTG + IF (IC_NUMERICS) THEN +#if defined(W3_IC1) || defined(W3_IC2) || defined(W3_IC3) || defined(W3_IC4) || defined(W3_IC5) + PHICE =-1.*DWAT*GRAV*PHICE/DTG +#endif + ENDIF ! ! 10.1 Adds ice scattering and dissipation: implicit integration---------------- * ! INFLAGS2(4) is true if ice concentration was ever read during @@ -1893,7 +1956,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & #endif IF ( INFLAGS2(4).AND.ICE.GT.0 ) THEN - + IF (.NOT. IC_NUMERICS ) THEN IF (IICEDISP) THEN ICECOEF2 = 1E-6 CALL LIU_FORWARD_DISPERSION (ICEH,ICECOEF2,DEPTH, & @@ -2021,6 +2084,7 @@ SUBROUTINE W3SRCE ( srce_call, IT, ISEA, JSEA, IX, IY, IMOD, & END DO PHICE =-1.*DWAT*GRAV*PHICE /DTG TAUICE(:)=TAUICE(:)/DTG + ENDIF ! end if IC_NUMERICS ELSE #ifdef W3_IS2 IF (IS2PARS(10).LT.0.5) THEN From 8575c2bfdecd527e6b5dd327ce504b43cabab39f Mon Sep 17 00:00:00 2001 From: Erin Thomas Date: Wed, 28 May 2025 20:11:13 -0700 Subject: [PATCH 4/5] add wavice switch file --- model/bin/switch_E3SM_wavice | 1 + model/src/w3fld1md.F90 | 6 +++++- 2 files changed, 6 insertions(+), 1 deletion(-) create mode 100644 model/bin/switch_E3SM_wavice diff --git a/model/bin/switch_E3SM_wavice b/model/bin/switch_E3SM_wavice new file mode 100644 index 0000000000..88b91fd77a --- /dev/null +++ b/model/bin/switch_E3SM_wavice @@ -0,0 +1 @@ +F90 NOGRB NC4 DIST MPI PR3 UQ FLX0 LN1 ST4 STAB0 NL1 BT1 DB1 MLIM TR0 BS0 IC4 IS0 REF0 XX0 WNT1 WNX1 CRT1 CRX1 O0 O1 O2 O3 O4 O5 O6 O7 SCRIPNC SCRIP RTD RWND UOST diff --git a/model/src/w3fld1md.F90 b/model/src/w3fld1md.F90 index 970e207069..a7af8a179f 100644 --- a/model/src/w3fld1md.F90 +++ b/model/src/w3fld1md.F90 @@ -1134,7 +1134,11 @@ SUBROUTINE APPENDTAIL(INSPC, WN2, NKT, KA1, KA2, KA3, WNDDIR,SAT) ENDDO AVG=SUM(NORMSPC)/MAX(REAL(NTH),1.) DO T=1, NTH - INSPC(K,T) = SAT * NORMSPC(T)/TPI/(WN2(K)**3.0)/AVG + IF (AVG /= 0.0) THEN + INSPC(K,T)=BT(K)*INSPC(K,T)/TPI/(WN2(K)**3.0)/AVG + ELSE + INSPC(K,T)=0.0 + ENDIF ENDDO ENDDO DO T=1, NTH From 9793971b4a3b32478e4ca122d7c33536061eb1a6 Mon Sep 17 00:00:00 2001 From: Erin Thomas Date: Wed, 11 Jun 2025 14:25:38 -0700 Subject: [PATCH 5/5] method 8 --- model/src/w3sic4md.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/model/src/w3sic4md.F90 b/model/src/w3sic4md.F90 index 2d84fe9653..1597be9d8a 100644 --- a/model/src/w3sic4md.F90 +++ b/model/src/w3sic4md.F90 @@ -515,7 +515,7 @@ SUBROUTINE W3SIC4 (A, DEPTH, CG, IX, IY, S, D) END DO WN_I= 0.5 * ALPHA - CASE (10) + CASE (8) ! Cubic fit to Meylan, Horvat & Bitz 2021 ! ICECOEF1 is thickness ! ICECOEF5 is floe size