diff --git a/model/src/w3adatmd.F90 b/model/src/w3adatmd.F90 index 61d97aeff8..904d4f4182 100644 --- a/model/src/w3adatmd.F90 +++ b/model/src/w3adatmd.F90 @@ -154,6 +154,8 @@ MODULE W3ADATMD ! US3D R.A. Public 3D Stokes drift. ! USSP R.A. Public Partitioned Surface Stokes drift ! +! USSHX/Y R.A. Public Surface layer averaged Stokes drift. +! ! ABA R.A. Public Near-bottom rms wave ex. amplitude. ! ABD R.A. Public Corresponding direction. ! UBA R.A. Public Near-bottom rms wave velocity. @@ -440,9 +442,7 @@ MODULE W3ADATMD XPRMS(:), XTPMS(:), XPHICE(:), & XTAUICE(:,:) REAL, POINTER :: XP2SMS(:,:), XUS3D(:,:), XUSSP(:,:) -#ifdef W3_CESMCOUPLED - REAL, POINTER :: XLANGMT(:) -#endif + REAL, POINTER :: XUSSHX(:), XUSSHY(:) ! ! Output fields group 7) ! @@ -471,12 +471,7 @@ MODULE W3ADATMD ! REAL, POINTER :: USERO(:,:) REAL, POINTER :: XUSERO(:,:) -#ifdef W3_CESMCOUPLED - ! Output fileds for Langmuir mixing in group - REAL, POINTER :: LANGMT(:), LAPROJ(:), LASL(:), & - LASLPJ(:), LAMULT(:), ALPHAL(:), & - ALPHALS(:), USSXH(:), USSYH(:) -#endif + REAL, POINTER :: USSHX(:), USSHY(:) ! ! Spatial derivatives ! @@ -557,11 +552,7 @@ MODULE W3ADATMD !/ !/ Data aliases for structure WADAT(S) !/ -#ifdef W3_CESMCOUPLED - REAL, POINTER :: LANGMT(:), LAPROJ(:), ALPHAL(:), & - ALPHALS(:), LAMULT(:), LASL(:), & - LASLPJ(:), USSXH(:), USSYH(:) -#endif + REAL, POINTER :: USSHX(:), USSHY(:) REAL, POINTER :: CG(:,:), WN(:,:) REAL, POINTER :: IC3WN_R(:,:), IC3WN_I(:,:), IC3CG(:,:) ! @@ -1042,19 +1033,6 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) -#ifdef W3_CESMCOUPLED - ALLOCATE ( WADATS(IMOD)%USSXH(NSEALM) , & - WADATS(IMOD)%USSYH(NSEALM) , & - WADATS(IMOD)%LANGMT(NSEALM) , & - WADATS(IMOD)%LAPROJ(NSEALM) , & - WADATS(IMOD)%LASL(NSEALM) , & - WADATS(IMOD)%LASLPJ(NSEALM) , & - WADATS(IMOD)%ALPHAL(NSEALM) , & - WADATS(IMOD)%ALPHALS(NSEALM) , & - WADATS(IMOD)%LAMULT(NSEALM) , & - STAT=ISTAT ) - CHECK_ALLOC_STATUS ( ISTAT ) -#endif ! WADATS(IMOD)%HS = UNDEF WADATS(IMOD)%WLM = UNDEF @@ -1230,6 +1208,8 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%TPMS (NSEALM) , & WADATS(IMOD)%PHICE (NSEALM) , & WADATS(IMOD)%TAUICE(NSEALM,2), & + WADATS(IMOD)%USSHX(NSEALM), & + WADATS(IMOD)%USSHY(NSEALM), & STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ! @@ -1269,12 +1249,11 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) WADATS(IMOD)%TPMS = UNDEF WADATS(IMOD)%PHICE = UNDEF WADATS(IMOD)%TAUICE = UNDEF -#ifdef W3_CESMCOUPLED - WADATS(IMOD)%LANGMT = UNDEF -#endif 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 + WADATS(IMOD)%USSHX = UNDEF + WADATS(IMOD)%USSHY = UNDEF #ifdef W3_MEMCHECK WRITE(30000+IAPROC,*) 'memcheck_____:', 'W3DIMA 6' @@ -1543,7 +1522,7 @@ SUBROUTINE W3DIMA ( IMOD, NDSE, NDST, D_ONLY ) ! 5. Restore previous grid setting if necessary ! IF ( JGRID .NE. IMOD ) CALL W3SETG ( JGRID, NDSE, NDST ) - + #ifdef W3_MEMCHECK WRITE(30000+IAPROC,*) 'memcheck_____:', 'W3DIMA END' call getMallocInfo(mallinfos) @@ -2232,15 +2211,17 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) CHECK_ALLOC_STATUS ( ISTAT ) END IF ! -#ifdef W3_CESMCOUPLED IF ( OUTFLAGS( 6, 14) ) THEN - ALLOCATE ( WADATS(IMOD)%XLANGMT(NXXX), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XUSSHX(NXXX), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XUSSHY(NXXX), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) ELSE - ALLOCATE ( WADATS(IMOD)%XLANGMT(1), STAT=ISTAT ) + ALLOCATE ( WADATS(IMOD)%XUSSHX(1), STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ALLOCATE ( WADATS(IMOD)%XUSSHY(1), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) END IF -#endif ! WADATS(IMOD)%XSXX = UNDEF WADATS(IMOD)%XSYY = UNDEF @@ -2262,9 +2243,8 @@ SUBROUTINE W3XDMA ( IMOD, NDSE, NDST, OUTFLAGS ) WADATS(IMOD)%XUSSP = UNDEF WADATS(IMOD)%XTAUOCX = UNDEF WADATS(IMOD)%XTAUOCY = UNDEF -#ifdef W3_CESMCOUPLED - WADATS(IMOD)%XLANGMT = UNDEF -#endif + WADATS(IMOD)%XUSSHX = UNDEF + WADATS(IMOD)%XUSSHY = UNDEF ! IF ( OUTFLAGS( 7, 1) ) THEN ALLOCATE ( WADATS(IMOD)%XABA(NXXX), STAT=ISTAT ) @@ -2987,18 +2967,8 @@ SUBROUTINE W3SETA ( IMOD, NDSE, NDST ) USERO => WADATS(IMOD)%USERO ! WN => WADATS(IMOD)%WN -#ifdef W3_CESMCOUPLED - ! USSX and USSY are already set - LANGMT => WADATS(IMOD)%LANGMT - LAPROJ => WADATS(IMOD)%LAPROJ - LASL => WADATS(IMOD)%LASL - LASLPJ => WADATS(IMOD)%LASLPJ - ALPHAL => WADATS(IMOD)%ALPHAL - ALPHALS=> WADATS(IMOD)%ALPHALS - USSXH => WADATS(IMOD)%USSXH - USSYH => WADATS(IMOD)%USSYH - LAMULT => WADATS(IMOD)%LAMULT -#endif + USSHX => WADATS(IMOD)%USSHX + USSHY => WADATS(IMOD)%USSHY #ifdef W3_IC3 IC3WN_R=> WADATS(IMOD)%IC3WN_R IC3WN_I=> WADATS(IMOD)%IC3WN_I @@ -3319,9 +3289,6 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) BEDFORMS=> WADATS(IMOD)%XBEDFORMS PHIBBL => WADATS(IMOD)%XPHIBBL TAUBBL => WADATS(IMOD)%XTAUBBL -#ifdef W3_CESMCOUPLED - LANGMT => WADATS(IMOD)%XLANGMT -#endif ! MSSX => WADATS(IMOD)%XMSSX MSSY => WADATS(IMOD)%XMSSY @@ -3337,6 +3304,9 @@ SUBROUTINE W3XETA ( IMOD, NDSE, NDST ) CFLKMAX => WADATS(IMOD)%XCFLKMAX ! USERO => WADATS(IMOD)%XUSERO +! + USSHX => WADATS(IMOD)%XUSSHX + USSHY => WADATS(IMOD)%XUSSHY ! END IF ! diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index ebfebb20cc..7af84c34d9 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -728,6 +728,9 @@ MODULE W3GDATMD #ifdef W3_IS2 REAL, POINTER :: IS2PARS(:) #endif + LOGICAL :: LMPENABLED ! flag to enable Li et al. Langmuir parameterization + LOGICAL :: SDTAIL ! flag to enable high-freq tail in Li et al. Stokes Drift computations + REAL :: HSLMODE ! 0 for test (HSL=10m everywhere, 1 for coupler-based HSL) ! ! unstructured data ! @@ -1082,6 +1085,10 @@ MODULE W3GDATMD #endif INTEGER, POINTER :: NBEDGE INTEGER, POINTER :: EDGES(:,:), NEIGH(:,:) + + LOGICAL, POINTER :: LMPENABLED + LOGICAL, POINTER :: SDTAIL + REAL, POINTER :: HSLMODE ! ! Variables for unstructured grids ! @@ -2301,6 +2308,10 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) US3DF => GRIDS(IMOD)%US3DF USSPF => GRIDS(IMOD)%USSPF USSP_WN => GRIDS(IMOD)%USSP_WN +! + LMPENABLED => GRIDS(IMOD)%LMPENABLED + SDTAIL => GRIDS(IMOD)%SDTAIL + HSLMODE => GRIDS(IMOD)%HSLMODE #ifdef W3_REF1 REFLC => GRIDS(IMOD)%REFLC REFLD => GRIDS(IMOD)%REFLD diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 6f231bf0fc..f7e4390c35 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -1109,6 +1109,7 @@ MODULE W3GRIDMD STH1MF, I1STH1M, I2STH1M, & TH2MF, I1TH2M, I2TH2M, & STH2MF, I1STH2M, I2STH2M + NAMELIST /LMPN/ LMPENABLED, SDTAIL, HSLMODE #ifdef W3_IS1 NAMELIST /SIS1/ ISC1, ISC2 #endif @@ -2769,6 +2770,11 @@ SUBROUTINE W3GRID() I2STH2M=NK ! FACBERG=1. +! + LMPENABLED = .false. + SDTAIL = .false. + HSLMODE = 0 ! 0 for test (HSL=10m everywhere, 1 for coupler-based HSL) +! #ifdef W3_IS0 WRITE (NDSO,944) #endif @@ -2927,6 +2933,10 @@ SUBROUTINE W3GRID() IC5MAXKI, IC5MINHW, IC5MAXITER, IC5RKICK, & IC5KFILTER, IC5MSTR(NINT(IC5VEMOD)) #endif +! + CALL READNL ( NDSS, 'LMPN', STATUS ) + WRITE (NDSO,4960) STATUS + WRITE (NDSO,4961) LMPENABLED, SDTAIL, HSLMODE ! CALL READNL ( NDSS, 'OUTS', STATUS ) WRITE (NDSO,4970) STATUS @@ -6829,6 +6839,10 @@ SUBROUTINE W3GRID() /' (0.0==> no reduction and 1.0==> no wind', & /' input with 100% ice cover)') ! +! + 4960 FORMAT (/' Langmuir Mixing Parameterization ',A/ & + ' --------------------------------------------------') + 4961 FORMAT (' &LMPN LMPENABLED = ',L, 'SDTAIL = ', L, ' HSLMODE = ', I2 '/' ) ! 4970 FORMAT (/' Spectral output on full grid ',A/ & ' --------------------------------------------------') @@ -7506,6 +7520,8 @@ SUBROUTINE READNL ( NDS, NAME, STATUS ) READ (NDS,NML=UNST,END=801,ERR=802,IOSTAT=J) CASE('OUTS') READ (NDS,NML=OUTS,END=801,ERR=802,IOSTAT=J) + CASE('LMPN') + READ (NDS,NML=LMPN,END=801,ERR=802,IOSTAT=J) CASE('MISC') READ (NDS,NML=MISC,END=801,ERR=802,IOSTAT=J) CASE DEFAULT diff --git a/model/src/w3idatmd.F90 b/model/src/w3idatmd.F90 index 417706a93c..022d361ea2 100644 --- a/model/src/w3idatmd.F90 +++ b/model/src/w3idatmd.F90 @@ -81,9 +81,8 @@ MODULE W3IDATMD ! FLCUR Log. Public Flag for current input. ! FLWIND Log. Public Flag for wind input. ! FLICE Log. Public Flag for ice input. -#ifdef W3_CESMCOUPLED -! HML R.A. Public Mixed layer depth -#endif +! HSL R.A. Public Depth of a surface layer over which Stokes +! drift is averaged ! FLTAUA Log. Public Flag for atmospheric momentum input ! FLRHOA Log. Public Flag for air density input ! INFLAGS1 L.A. Public Array consolidating the above six @@ -206,9 +205,7 @@ MODULE W3IDATMD REAL, POINTER :: CYTIDE(:,:,:,:) REAL, POINTER :: WLTIDE(:,:,:,:) #endif -#ifdef W3_CESMCOUPLED - REAL, POINTER :: HML(:,:) -#endif + REAL, POINTER :: HSL(:,:) LOGICAL :: IINIT #ifdef W3_WRST LOGICAL :: WRSTIINIT=.FALSE. @@ -259,9 +256,7 @@ MODULE W3IDATMD LOGICAL, POINTER :: FLLEVTIDE, FLCURTIDE, & FLLEVRESI, FLCURRESI #endif -#ifdef W3_CESMCOUPLED - REAL , POINTER :: HML(:,:) -#endif + REAL , POINTER :: HSL(:,:) !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -558,7 +553,7 @@ SUBROUTINE W3DIMI ( IMOD, NDSE, NDST, FLAGSTIDEIN ) FLLEVRESI = FLAGSTIDE(3) FLCURRESI = FLAGSTIDE(4) #endif - + FLWIND => INPUTS(IMOD)%INFLAGS1(3) FLICE => INPUTS(IMOD)%INFLAGS1(4) FLTAUA => INPUTS(IMOD)%INFLAGS1(5) @@ -713,10 +708,8 @@ SUBROUTINE W3DIMI ( IMOD, NDSE, NDST, FLAGSTIDEIN ) CHECK_ALLOC_STATUS ( ISTAT ) END IF ! -#ifdef W3_CESMCOUPLED - ALLOCATE ( INPUTS(IMOD)%HML(NX,NY), STAT=ISTAT ) + ALLOCATE ( INPUTS(IMOD)%HSL(NX,NY), STAT=ISTAT ) CHECK_ALLOC_STATUS ( ISTAT ) -#endif ! INPUTS(IMOD)%IINIT = .TRUE. ! @@ -1022,9 +1015,7 @@ SUBROUTINE W3SETI ( IMOD, NDSE, NDST ) ICEI => INPUTS(IMOD)%ICEI BERGI => INPUTS(IMOD)%BERGI END IF -#ifdef W3_CESMCOUPLED - HML => INPUTS(IMOD)%HML -#endif + HSL => INPUTS(IMOD)%HSL ! IF ( FLTAUA ) THEN UX0 => INPUTS(IMOD)%UX0 diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 34ccc559d6..808991b99f 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -2569,10 +2569,7 @@ SUBROUTINE W3MPIO ( IMOD ) TAUOCX, TAUOCY, WNMEAN #endif -#ifdef W3_CESMCOUPLED - USE W3ADATMD, ONLY: LANGMT, LAPROJ, ALPHAL, LASL, LASLPJ, & - ALPHALS, LAMULT -#endif + USE W3ADATMD, ONLY: USSHX, USSHY #ifdef W3_MPI USE W3GDATMD, ONLY: NK @@ -2673,7 +2670,7 @@ SUBROUTINE W3MPIO ( IMOD ) 0 + 0 + 0 + & ! group 3 (extra contributions below) 2+(NOGE(4)-2)*(NOSWLL+1) + 0 + 0 + & ! group 4 11 + 3 + 1 + & ! group 5 - 12 + 7 + 1 + & ! group 6 (extra contributions below) + 10 + 7 + 1 + & ! group 6 (extra contributions below) 5 + 4 + 1 + & ! group 7 5 + 2 + 0 + & ! group 8 5 + 0 + 0 + & ! group 9 @@ -2689,6 +2686,7 @@ SUBROUTINE W3MPIO ( IMOD ) P2MSF(3) - P2MSF(2) + 1 IF ( FLGRDALL( 6, 8) ) NRQMAX = NRQMAX + 2*NK IF ( FLGRDALL( 6,12) ) NRQMAX = NRQMAX + 2*NK + IF ( FLGRDALL( 6,14) ) NRQMAX = NRQMAX + 2 #endif ! #ifdef W3_MPI @@ -3778,37 +3776,32 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IROOT, IT, IRQGO(IH), IERR #endif -#ifdef W3_CESMCOUPLED +#ifdef W3_MPI + END IF +#endif +! #ifdef W3_MPI IF ( FLGRDALL( 6, 14) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (LANGMT (1),NSEALM , MPI_REAL, IROOT, & + CALL MPI_SEND_INIT (USSHX (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) - END IF #endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/14', IROOT, IT, IRQGO(IH), IERR #endif -#endif - -#ifdef W3_MPI - END IF -#endif -! #ifdef W3_MPI -#ifdef W3_CESMCOUPLED - IF ( FLGRDALL( 6, 14) ) THEN IH = IH + 1 IT = IT + 1 - CALL MPI_SEND_INIT (LANGMT(1),NSEALM , MPI_REAL, IROOT, & + CALL MPI_SEND_INIT (USSHY (1),NSEALM , MPI_REAL, IROOT, & IT, MPI_COMM_WAVE, IRQGO(IH), IERR) +#endif #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/14', IROOT, IT, IRQGO(IH), IERR #endif - END IF -#endif !W3_CESMCOUPLED -#endif !W3_MPI +#ifdef W3_MPI + END IF +#endif ! #ifdef W3_MPI IF ( FLGRDALL( 7, 1) ) THEN @@ -5213,36 +5206,32 @@ SUBROUTINE W3MPIO ( IMOD ) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/13', IFROM, IT, IRQGO2(IH), IERR #endif -#ifdef W3_CESMCOUPLED #ifdef W3_MPI - IF ( FLGRDALL( 6, 14) ) THEN - IH = IH + 1 - IT = IT + 1 - CALL MPI_RECV_INIT (LANGMT (1),NSEALM , MPI_REAL, IROOT, & - IT, MPI_COMM_WAVE, IRQGO(IH), IERR) - END IF + END IF #endif -#ifdef W3_MPIT - WRITE (NDST,9011) IH, ' 6/14', IROOT, IT, IRQGO(IH), IERR +! +#ifdef W3_MPI + IF ( FLGRDALL( 6, 14) ) THEN + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (USSHX (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) #endif +#ifdef W3_MPIT + WRITE (NDST,9011) IH, ' 6/14', IFROM, IT, IRQGO2(IH), IERR #endif #ifdef W3_MPI - END IF + IH = IH + 1 + IT = IT + 1 + CALL MPI_RECV_INIT (USSHY (I0),1,WW3_FIELD_VEC, IFROM, IT, & + MPI_COMM_WAVE, IRQGO2(IH), IERR ) #endif -! -#ifdef W3_MPI -#ifdef W3_CESMCOUPLED - IF ( FLGRDALL( 6, 14) ) THEN - IH = IH + 1 - IT = IT + 1 - CALL MPI_RECV_INIT (LANGMT(I0),1,WW3_FIELD_VEC, IFROM, IT, & - MPI_COMM_WAVE, IRQGO2(IH), IERR) #ifdef W3_MPIT WRITE (NDST,9011) IH, ' 6/14', IFROM, IT, IRQGO2(IH), IERR #endif +#ifdef W3_MPI END IF -#endif ! W3_CESMCOUPLED -#endif ! W3_MPI +#endif ! #ifdef W3_MPI IF ( FLGRDALL( 7, 1) ) THEN diff --git a/model/src/w3iogomd.F90 b/model/src/w3iogomd.F90 index 2f736e1065..2f4628e006 100644 --- a/model/src/w3iogomd.F90 +++ b/model/src/w3iogomd.F90 @@ -1014,6 +1014,9 @@ SUBROUTINE W3FLDTOIJ(FLD, I, J, IAPROC, NAPOUT, NDSEN) CASE('TOC') I = 6 J = 13 + CASE('USSH') + I = 6 + J = 14 ! ! Group 7 ! @@ -1216,23 +1219,11 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ICPRT, DTPRT, WSCUT, NOSWLL, FLOGRD, FLOGR2,& NOGRP, NGRPP USE W3ADATMD, ONLY: NSEALM -#ifdef W3_CESMCOUPLED - ! USSX, USSY : surface Stokes drift (SD) - ! USSXH, USSYH : surface layer (SL) averaged SD - ! LANGMT : La_t - ! LAPROJ : La_{Proj} - ! LASL : La_{SL} - ! LASLPJ : La_{SL,Proj} - ! ALPHAL : angle between wind and Langmuir cells (SL averaged) - ! ALPHALS : angle between wind and Langmuir cells (surface) - ! UD : wind direction - ! LAMULT : enhancement factor - ! HML : mixing layer depth (from coupler) - USE W3ADATMD, ONLY: LAMULT, USSXH, USSYH, LANGMT, LAPROJ, & - ALPHAL, ALPHALS, LASL, UD, LASLPJ - USE W3IDATMD, ONLY: HML - USE W3WDATMD, ONLY: ASF -#endif + ! USSHX, USSHY : surface layer (SL) averaged SD + ! HSL : surface layer depth (1/5 of the mixed layer depth + ! from the coupler) + USE W3ADATMD, ONLY: USSHX, USSHY + USE W3IDATMD, ONLY: HSL #ifdef W3_S USE W3SERVMD, ONLY: STRACE #endif @@ -1291,17 +1282,12 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) REAL USSCO, FT1 REAL, SAVE :: HSMIN = 0.01 LOGICAL :: FLOLOC(NOGRP,NGRPP) -#ifdef W3_CESMCOUPLED ! SWW: angle between wind and waves - ! HSL: surface layer depth (=0.2*HML) - REAL :: SWW !angle between wind and waves - REAL :: HSL !surface layer depth (=0.2*HML) - ! tmp variables for surface and SL averaged SD - REAL :: ETUSSX(NSEAL), & - ETUSSY(NSEAL), & - ETUSSXH(NSEAL), & - ETUSSYH(NSEAL) -#endif + ! LHSL: local surface layer depth + REAL :: SWW + REAL :: LHSL + ! tmp variable for surface layer averaged Stokes drift + REAL :: USSCOH !/ !/ ------------------------------------------------------------------- / !/ @@ -1422,25 +1408,10 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ! FP1 = UNDEF THP1 = UNDEF -#ifdef W3_CESMCOUPLED - ETUSSX = 0. - ETUSSY = 0. ETUSCX = 0. ETUSCY = 0. - ETUSSXH = 0. - ETUSSYH = 0 - LANGMT = UNDEF - LAPROJ = UNDEF - LASL = UNDEF - LASLPJ = UNDEF - ALPHAL = UNDEF - ALPHALS = UNDEF - USSX = 0. - USSY = 0. - USSXH = 0. - USSYH = 0. - LAMULT = 1. -#endif + USSHX = 0. + USSHY = 0. ! ! 2. Integral over discrete part of spectrum ------------------------ * ! @@ -1566,12 +1537,16 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) TPMS(JSEA) = TPI/SIG(IK) END IF -#ifdef W3_CESMCOUPLED -! Get surface layer depth - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) - HSL = HML(IX,IY)/5. ! depth over which SD is averaged -#endif + IF (LMPENABLED) then + IF (HSLMODE.EQ.0) then + LHSL = 10.0 ! a constant value for testing purposes + ELSE + ! Get surface layer depth from coupler + IX = MAPSF(ISEA,1) + IY = MAPSF(ISEA,2) + LHSL = HSL(IX,IY) ! depth over which SD is averaged + END IF + END IF ! ! Directional moments in the last freq. band @@ -1612,39 +1587,14 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) USSCO=FKD*SIG(IK)*WN(IK,ISEA)*COSH(2.*KD) BHD(JSEA) = BHD(JSEA) + & GRAV*WN(IK,ISEA) * EBD(IK,JSEA) / (SINH(2.*KD)) -#ifdef W3_CESMCOUPLED - ! Surface Stokes Drift - ETUSSX(JSEA) = ETUSSX(JSEA) + ABX(JSEA)*FACTOR*SIG(IK) & - *WN(IK,ISEA)*COSH(2*WN(IK,ISEA)*DW(ISEA)) & - /(SINH(WN(IK,ISEA)*DW(ISEA)))**2 - ETUSSY(JSEA) = ETUSSY(JSEA) + ABY(JSEA)*FACTOR*SIG(IK) & - *WN(IK,ISEA)*COSH(2*WN(IK,ISEA)*DW(ISEA)) & - /(SINH(WN(IK,ISEA)*DW(ISEA)))**2 - ! Depth averaged Stokes Drift - ETUSSXH(JSEA) = ETUSSXH(JSEA) + ABX(JSEA)*FACTOR*SIG(IK) & - *(1.-EXP(-2.*WN(IK,ISEA)*HSL))/2./HSL & - *COSH(2*WN(IK,ISEA)*DW(ISEA)) & - /(SINH(WN(IK,ISEA)*DW(ISEA)))**2 - ETUSSYH(JSEA) = ETUSSYH(JSEA) + ABY(JSEA)*FACTOR*SIG(IK) & - *(1.-EXP(-2.*WN(IK,ISEA)*HSL))/2./HSL & - *COSH(2*WN(IK,ISEA)*DW(ISEA)) & - /(SINH(WN(IK,ISEA)*DW(ISEA)))**2 -#endif + IF (LMPENABLED) THEN + USSCOH=0.5*FKD*SIG(IK)*(1.-EXP(-2.*WN(IK,ISEA)*LHSL))/LHSL*COSH(2.*KD) + ENDIF ELSE USSCO=FACTOR*SIG(IK)*2.*WN(IK,ISEA) -#ifdef W3_CESMCOUPLED - ! deep water limit - ! Surface Stokes Drift - ETUSSX(JSEA) = ETUSSX(JSEA) + ABX(JSEA)*FACTOR*SIG(IK) & - *2.*WN(IK,ISEA) - ETUSSY(JSEA) = ETUSSY(JSEA) + ABY(JSEA)*FACTOR*SIG(IK) & - *2.*WN(IK,ISEA) - ! Depth averaged Stokes Drift - ETUSSXH(JSEA) = ETUSSXH(JSEA) + ABX(JSEA)*FACTOR*SIG(IK) & - *(1.-EXP(-2.*WN(IK,ISEA)*HSL))/HSL - ETUSSYH(JSEA) = ETUSSYH(JSEA) + ABY(JSEA)*FACTOR*SIG(IK) & - *(1.-EXP(-2.*WN(IK,ISEA)*HSL))/HSL -#endif + IF (LMPENABLED) THEN + USSCOH=FACTOR*SIG(IK)*(1.-EXP(-2.*WN(IK,ISEA)*LHSL))/LHSL + ENDIF END IF ! ABXX(JSEA) = MAX ( 0. , ABXX(JSEA) ) * FACTOR @@ -1660,6 +1610,10 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ! USSX(JSEA) = USSX(JSEA) + ABX(JSEA)*USSCO USSY(JSEA) = USSY(JSEA) + ABY(JSEA)*USSCO + IF (LMPENABLED) THEN + USSHX(JSEA) = USSHX(JSEA) + ABX(JSEA)*USSCOH + USSHY(JSEA) = USSHY(JSEA) + ABY(JSEA)*USSCOH + ENDIF ! ! Fills the 3D Stokes drift spectrum array ! ! The US3D Stokes drift specrum array is now calculated in a @@ -1957,11 +1911,17 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) ! DO JSEA=1, NSEAL CALL INIT_GET_ISEA(ISEA, JSEA) -#ifdef W3_CESMCOUPLED - IX = MAPSF(ISEA,1) - IY = MAPSF(ISEA,2) - HS = HML(IX,IY)/5. ! depth over which SD is averaged -#endif + + IF (LMPENABLED) then + IF (HSLMODE.EQ.0) then + LHSL = 10.0 ! a constant value for testing purposes + ELSE + ! Get surface layer depth from coupler + IX = MAPSF(ISEA,1) + IY = MAPSF(ISEA,2) + LHSL = HSL(IX,IY) ! depth over which SD is averaged + END IF + END IF ! ! 3.a Directional mss parameters ! NB: the slope PDF is proportional to ell1=ETYY*EC2-2*ETXY*ECS+ETXX*ES2 = C*EC2-2*B*ECS+A*ES2 @@ -1991,16 +1951,23 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) SXX(JSEA) = SXX(JSEA) + FTE * ABXX(JSEA) / CG(NK,ISEA) SYY(JSEA) = SYY(JSEA) + FTE * ABYY(JSEA) / CG(NK,ISEA) SXY(JSEA) = SXY(JSEA) + FTE * ABXY(JSEA) / CG(NK,ISEA) -#ifdef W3_CESMCOUPLED - ! tail for SD - ETUSSX(JSEA) = ETUSSX(JSEA) + 2*GRAV*ETUSCX(JSEA)/SIG(NK) - ETUSSY(JSEA) = ETUSSY(JSEA) + 2*GRAV*ETUSCY(JSEA)/SIG(NK) -#endif ! ! Tail for surface stokes drift is commented out: very sensitive to tail power ! ! USSX(JSEA) = USSX(JSEA) + 2*GRAV*ETUSCX(JSEA)/SIG(NK) ! USSY(JSEA) = USSY(JSEA) + 2*GRAV*ETUSCY(JSEA)/SIG(NK) + + ! Add tail contribution for surface and layer averaged Stokes drift + IF (LMPENABLED.and.SDTAIL) then + USSX(JSEA) = USSX(JSEA) + 2*GRAV*ETUSCX(JSEA)/SIG(NK) + USSY(JSEA) = USSY(JSEA) + 2*GRAV*ETUSCY(JSEA)/SIG(NK) + USSHX(JSEA) = USSHX(JSEA) + 2*GRAV*ETUSCX(JSEA)/SIG(NK) & + *(1.-(1.-4.*LHSL*WN(NK,ISEA))*EXP(-2.*WN(NK,ISEA)*LHSL)) & + /6./WN(NK,ISEA)/LHSL + USSHY(JSEA) = USSHY(JSEA) + 2*GRAV*ETUSCY(JSEA)/SIG(NK) & + *(1.-(1.-4.*LHSL*WN(NK,ISEA))*EXP(-2.*WN(NK,ISEA)*LHSL)) & + /6./WN(NK,ISEA)/LHSL + END IF UBS(JSEA) = UBS(JSEA) + FTWL * EBAND/GRAV END DO ! @@ -2069,87 +2036,6 @@ SUBROUTINE W3OUTG ( A, FLPART, FLOUTG, FLOUTG2 ) T02(JSEA) = TPI / SIG(NK) T01(JSEA)= T02(JSEA) ENDIF -#ifdef W3_CESMCOUPLED - !TODO is this affected by the NXXX vs. NSEALM? - ! Should LAMULT, etc. be NSEAML length? - ! Output Stokes drift and Langmuir numbers - ! USERO(JSEA,1) = HS(JSEA) / MAX ( 0.001 , DW(JSEA) ) - ! USERO(JSEA,2) = ASF(ISEA) - IF (ETUSSX(JSEA) .NE. 0. .OR. ETUSSY(JSEA) .NE. 0.) THEN - - USSX(JSEA) = ETUSSX(JSEA) - USSY(JSEA) = ETUSSY(JSEA) - USSXH(JSEA) = ETUSSXH(JSEA) - USSYH(JSEA) = ETUSSYH(JSEA) - - ! this check is to divide by zeror error with gx17 - ! is there a better way to do this check? - IF( SQRT(USSX(JSEA)**2 + USSY(JSEA)**2) .GT. 0) THEN - IF( SQRT(USSXH(JSEA)**2+USSYH(JSEA)**2) .GT. 0) THEN - - LANGMT(JSEA) = SQRT ( UST(ISEA) * ASF(ISEA) & - * SQRT ( DAIR / DWAT ) & - / SQRT ( USSX(JSEA)**2 + USSY(JSEA)**2 ) ) - ! Calculating Langmuir Number for misaligned wind and waves - ! see Van Roekel et al., 2012 - ! take z1 = 4 * HS - ! SWW: angle between Stokes drift and wind - - ! no Stokes depth - SWW = ATAN2(USSY(JSEA),USSX(JSEA)) - UD(ISEA) - ! ALPHALS: angle between wind and LC direction, Surface - ! Stokes drift - ! LR check for divide by zero - if ((LANGMT(JSEA)**2 & - /0.4*LOG(MAX(ABS(HML(IX,IY)/4./HS(JSEA)),1.0))+COS(SWW)).eq.0.) then - print *, 'LR warning A denom 0.' - ! This appears to be a decimal precision error - ! The first term equals minus the second term to 6 decimal places - ! The denominator should be a very small number (e-7) - ! ATAN(sin(sww)/small number) tends to pi/2 - ! So I hardcoded this here. - ALPHALS(JSEA) = -1.5707956594501575 - else - - ALPHALS(JSEA) = ATAN(SIN(SWW) / (LANGMT(JSEA)**2 & - /0.4*LOG(MAX(ABS(HML(IX,IY)/4./HS(JSEA)),1.0))+COS(SWW))) - end if - - - ALPHALS(JSEA) = ATAN( SIN(SWW) / ( LANGMT(JSEA)**2 & - /0.4*LOG(MAX(ABS(HML(IX,IY)/4./HS(JSEA)),1.0))+COS(SWW))) - LAPROJ(JSEA) = LANGMT(JSEA) & - * SQRT(ABS(COS(ALPHALS(JSEA))) & - / ABS(COS(SWW-ALPHALS(JSEA)))) - ! Stokes depth - SWW = ATAN2(USSYH(JSEA),USSXH(JSEA)) - UD(ISEA) - ! ALPHAL: angle between wind and LC direction - - ! LR check for divide by zero (same as above) - if ((LANGMT(JSEA)**2 & - /0.4*LOG(MAX(ABS(HML(IX,IY)/4./HS(JSEA)),1.0))+COS(SWW)).eq.0.) then - print *, 'LR warning B denom 0.' - ALPHAL(JSEA) = -1.5707956594501575 - else - - ALPHAL(JSEA) = ATAN(SIN(SWW) / (LANGMT(JSEA)**2 & - /0.4*LOG(MAX(ABS(HML(IX,IY)/4./HS(JSEA)),1.0))+COS(SWW))) - end if - LASL(JSEA) = SQRT(UST(ISEA)*ASF(ISEA) & - * SQRT(DAIR/DWAT) & - / SQRT(USSXH(JSEA)**2+USSYH(JSEA)**2)) - LASLPJ(JSEA) = LASL(JSEA) * SQRT(ABS(COS(ALPHAL(JSEA))) & - / ABS(COS(SWW-ALPHAL(JSEA)))) - ! LAMULT - LAMULT(JSEA) = MIN(5.0, ABS(COS(ALPHAL(JSEA))) * & - SQRT(1.0+(1.5*LASLPJ(JSEA))**(-2)+(5.4*real(LASLPJ(JSEA),kind=8))**(-4))) - ! user defined output - USERO(JSEA,1) = HML(IX,IY) - !USERO(JSEA,2) = COS(ALPHAL(JSEA) - END IF - END IF - END IF -#endif ! ! Add here USERO(JSEA,1) ... ! @@ -2765,6 +2651,7 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) TH1M, STH1M, TH2M, STH2M, HSIG, PHICE, TAUICE,& STMAXE, STMAXD, HMAXE, HCMAXE, HMAXD, HCMAXD,& USSP, TAUOCX, TAUOCY + USE W3ADATMD, ONLY: USSHX, USSHY !/ USE W3ODATMD, ONLY: NOGRP, NGRPP, IDOUT, UNDEF, NDST, NDSE, & FLOGRD, IPASS => IPASS1, WRITE => WRITE1, & @@ -3139,6 +3026,10 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) TAUOCX(ISEA) = UNDEF TAUOCY(ISEA) = UNDEF END IF + IF ( FLOGRD( 6, 14) ) THEN + USSHX (ISEA) = UNDEF + USSHY (ISEA) = UNDEF + END IF ! IF ( FLOGRD( 7, 1) ) THEN ABA (ISEA) = UNDEF @@ -3449,19 +3340,22 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 8 ) THEN WRITE ( NDSOG ) US3D(1:NSEA, US3DF(2):US3DF(3)) WRITE ( NDSOG ) US3D(1:NSEA,NK+US3DF(2):NK+US3DF(3)) - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 9 ) THEN WRITE ( NDSOG ) P2SMS(1:NSEA,P2MSF(2):P2MSF(3)) - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 10 ) THEN WRITE ( NDSOG ) TAUICE(1:NSEA,1) WRITE ( NDSOG ) TAUICE(1:NSEA,2) - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 11 ) THEN WRITE ( NDSOG ) PHICE(1:NSEA) - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 12 ) THEN WRITE ( NDSOG ) USSP(1:NSEA, 1:USSPF(2)) WRITE ( NDSOG ) USSP(1:NSEA,NK+1:NK+USSPF(2)) - ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 13 ) THEN WRITE ( NDSOG ) TAUOCX(1:NSEA) WRITE ( NDSOG ) TAUOCY(1:NSEA) + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 14 ) THEN + WRITE ( NDSOG ) USSHX(1:NSEA) + WRITE ( NDSOG ) USSHY(1:NSEA) ! ! Section 7) ! @@ -3803,6 +3697,11 @@ SUBROUTINE W3IOGO ( INXOUT, NDSOG, IOTST, IMOD ) TAUOCX(1:NSEA) READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & TAUOCY(1:NSEA) + ELSE IF ( IFI .EQ. 6 .AND. IFJ .EQ. 14 ) THEN + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + USSHX(1:NSEA) + READ (NDSOG,END=801,ERR=802,IOSTAT=IERR) & + USSHY(1:NSEA) ! ! Section 7) diff --git a/model/src/w3iogoncdmd.F90 b/model/src/w3iogoncdmd.F90 index a164151bad..bd2a98918c 100644 --- a/model/src/w3iogoncdmd.F90 +++ b/model/src/w3iogoncdmd.F90 @@ -60,9 +60,7 @@ subroutine w3iogoncd () use w3adatmd , only : cflxymax, cflthmax, cflkmax, p2sms, us3d use w3adatmd , only : th1m, sth1m, th2m, sth2m, hsig, phice, tauice use w3adatmd , only : stmaxe, stmaxd, hmaxe, hcmaxe, hmaxd, hcmaxd, ussp, tauocx, tauocy -#ifdef W3_CESMCOUPLED - use w3adatmd , only : langmt -#endif + use w3adatmd , only : usshx, usshy use wav_grdout , only : varatts, outvars use w3timemd , only : set_user_timestring use w3odatmd , only : time_origin, calendar_name, elapsed_secs @@ -322,9 +320,8 @@ subroutine w3iogoncd () if (vname .eq. 'PHICE') call write_var2d(vname, phice (1:nsea) ) if (vname .eq. 'TAUOCX') call write_var2d(vname, tauocx (1:nsea) ) if (vname .eq. 'TAUOCY') call write_var2d(vname, tauocy (1:nsea) ) -#ifdef W3_CESMCOUPLED - if (vname .eq. 'LANGMT') call write_var2d(vname, langmt (1:nsea) ) -#endif + if (vname .eq. 'USSHX') call write_var2d(vname, usshx (1:nsea) ) + if (vname .eq. 'USSHY') call write_var2d(vname, usshy (1:nsea) ) ! Group 7 if (vname .eq. 'ABAX') call write_var2d(vname, aba (1:nsea), dir=cos(abd(1:nsea)) ) if (vname .eq. 'ABAY') call write_var2d(vname, aba (1:nsea), dir=sin(abd(1:nsea)) ) diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index b44aa6fcb6..5887da7cbd 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -1095,6 +1095,17 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) FTF, FTWN, FTTR, FTWL, FACTI1, FACTI2, FACHFA, FACHFE END IF +! -------------- + IF ( WRITE ) THEN + WRITE (NDSM) & + LMPENABLED, SDTAIL, HSLMODE + ELSE + READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & + LMPENABLED, SDTAIL, HSLMODE + END IF + +! -------------- + #ifdef W3_DEBUGIOGR WRITE(740+IAPROC,*) 'W3IOGR, step 10' FLUSH(740+IAPROC) diff --git a/model/src/w3iorsmd.F90 b/model/src/w3iorsmd.F90 index 313c0e11a2..e5325558b7 100644 --- a/model/src/w3iorsmd.F90 +++ b/model/src/w3iorsmd.F90 @@ -283,6 +283,7 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) USE W3PARALL, ONLY: PRINT_MY_TIME #endif USE w3odatmd, ONLY : RUNTYPE, INITFILE + USE w3adatmd, ONLY : USSHX, USSHY !!!!!/PDLIB USE PDLIB_FIELD_VEC!, only : UNST_PDLIB_READ_FROM_FILE, UNST_PDLIB_WRITE_TO_FILE #ifdef W3_PDLIB USE PDLIB_FIELD_VEC @@ -1097,6 +1098,10 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOCX(1:NSEA) WRITE(NDSR,ERR=803,IOSTAT=IERR) TAUOCY(1:NSEA) ENDIF + IF ( FLOGRR(6,14) ) THEN + WRITE(NDSR,ERR=803,IOSTAT=IERR) USSHX(1:NSEA) + WRITE(NDSR,ERR=803,IOSTAT=IERR) USSHY(1:NSEA) + ENDIF IF ( FLOGRR(7,2) ) THEN WRITE(NDSR,ERR=803,IOSTAT=IERR) UBA(1:NSEA) WRITE(NDSR,ERR=803,IOSTAT=IERR) UBD(1:NSEA) @@ -1442,6 +1447,20 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) ENDIF ENDDO ENDIF +#ifdef W3_DEBUGINIT + WRITE(740+IAPROC,*) 'Before reading USSH' +#endif + IF ( FLOGOA(6,14) ) THEN + READ (NDSR,ERR=802,IOSTAT=IERR) TMP(1:NSEA) + READ (NDSR,ERR=802,IOSTAT=IERR) TMP2(1:NSEA) + DO I=1, NSEALM + J = IAPROC + (I-1)*NAPROC + IF (J .LE. NSEA) THEN + USSHX(I) = TMP(J) + USSHY(I) = TMP2(J) + ENDIF + ENDDO + ENDIF #ifdef W3_DEBUGINIT WRITE(740+IAPROC,*) 'Before reading UB' #endif @@ -1534,6 +1553,8 @@ SUBROUTINE W3IORS ( INXOUT, NDSR, DUMFPI, IMOD, FLRSTRT ) UBD = 0. PHIBBL = 0. TAUBBL = 0. + USSHX = 0. + USSHY = 0. ENDIF #ifdef W3_T WRITE (NDST,9008) diff --git a/model/src/w3odatmd.F90 b/model/src/w3odatmd.F90 index c6da30d71a..a7e083ec4e 100644 --- a/model/src/w3odatmd.F90 +++ b/model/src/w3odatmd.F90 @@ -891,9 +891,7 @@ SUBROUTINE W3NOUT ( NDSERR, NDSTST ) IDOUT( 6,11) = 'Wave-ice energy flux' IDOUT( 6,12) = 'Split Surface Stokes' IDOUT( 6,13) = 'Tot wav-ocn mom flux' -#ifdef W3_CESMCOUPLED IDOUT( 6,14) = 'Turbulent Langmuir number' -#endif ! ! 7) Wave-bottom layer ! diff --git a/model/src/wav_comp_nuopc.F90 b/model/src/wav_comp_nuopc.F90 index 4ab470f3cb..64788b5da1 100644 --- a/model/src/wav_comp_nuopc.F90 +++ b/model/src/wav_comp_nuopc.F90 @@ -842,6 +842,7 @@ subroutine DataInitialize(gcomp, rc) integer :: jsea real(r8), pointer :: z0rlen(:) real(r8), pointer :: sw_lamult(:) + real(r8), pointer :: sw_lasl(:) real(r8), pointer :: sw_ustokes(:) real(r8), pointer :: sw_vstokes(:) real(r8), pointer :: wave_elevation_spectrum(:,:) @@ -863,6 +864,14 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sw_lamult (:) = 1. endif + if (state_fldchk(exportState, 'Sw_lasl')) then + call state_getfldptr(exportState, 'Sw_lasl', sw_lasl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! note: the default value of this surface layer averaged Langmuir number + ! should be a large number to be consistent with lamult=1., ustokes=0., + ! and vstokes=0. + sw_lasl (:) = 1.e6 + endif if (state_fldchk(exportState, 'Sw_ustokes')) then call state_getfldptr(exportState, 'Sw_ustokes', sw_ustokes, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/model/src/wav_grdout.F90 b/model/src/wav_grdout.F90 index 166802ad6b..a9f78a52f7 100644 --- a/model/src/wav_grdout.F90 +++ b/model/src/wav_grdout.F90 @@ -4,7 +4,7 @@ module wav_grdout implicit none - integer, parameter :: maxvars = 24 ! maximum number of variables/group + integer, parameter :: maxvars = 25 ! maximum number of variables/group private ! except @@ -222,7 +222,7 @@ subroutine initialize_gridout ] ! 6 Wave-ocean layer - gridoutdefs(6,1:24) = [ & + gridoutdefs(6,1:25) = [ & varatts( "SXY ", "SXX ", "Radiation stresses xx ", "N m-1 ", " ", .false.) , & varatts( "SXY ", "SYY ", "Radiation stresses yy ", "N m-1 ", " ", .false.) , & varatts( "SXY ", "SXY ", "Radiation stresses xy ", "N m-1 ", " ", .false.) , & @@ -246,7 +246,8 @@ subroutine initialize_gridout varatts( "USP ", "USSPY ", "Partitioned surface Stokes drift y ", "m s-1 ", "p ", .false.) , & varatts( "TWC ", "TAUOCX ", "Total wave to ocean stress x ", "Pa ", " ", .false.) , & varatts( "TWC ", "TAUOCY ", "Total wave to ocean stress y ", "Pa ", " ", .false.) , & - varatts( "LAN ", "LANGMT ", "Turbulent Langmuir number (La_t) ", "nd ", " ", .false.) & + varatts( "USSH ", "USSHX ", "Surface layer averaged Stokes drift x ", "m s-1 ", " ", .false.) , & + varatts( "USSH ", "USSHY ", "Surface layer averaged Stokes drift y ", "m s-1 ", " ", .false.) & ] ! 7 Wave-bottom layer diff --git a/model/src/wav_import_export.F90 b/model/src/wav_import_export.F90 index 068627acbe..98de1259b2 100644 --- a/model/src/wav_import_export.F90 +++ b/model/src/wav_import_export.F90 @@ -20,7 +20,7 @@ module wav_import_export use wav_shr_mod , only : chkerr use wav_shr_mod , only : state_diagnose, state_reset, state_getfldptr, state_fldchk use wav_shr_mod , only : wav_coupling_to_cice, merge_import, dbug_flag, multigrid - use constants , only : grav, tpi, dwat + use constants , only : grav, tpi, dwat, dair implicit none private ! except @@ -138,6 +138,7 @@ subroutine advertise_fields(importState, ExportState, flds_scalar_name, rc) call fldlist_add(fldsFrWav_num, fldsFrWav, trim(flds_scalar_name)) if (cesmcoupled) then call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_lamult' ) + call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_lasl' ) call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_ustokes') call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes') !call fldlist_add(fldsFrWav_num, fldsFrWav, 'Sw_hstokes') @@ -271,7 +272,7 @@ subroutine import_fields( gcomp, time0, timen, rc ) use w3odatmd , only: w3seto use w3wdatmd , only: time, w3setw #ifdef W3_CESMCOUPLED - use w3idatmd , only: HML + use w3idatmd , only: HSL #else use wmupdtmd , only: wmupd2 use wmmdatmd , only: wmsetm @@ -484,8 +485,8 @@ subroutine import_fields( gcomp, time0, timen, rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ocn mixing layer depth - global_data = max(global_data, 5.) - call FillGlobalInput(global_data, HML) + global_data = max(global_data, 5.)*0.2 + call FillGlobalInput(global_data, HSL) #endif ! --------------- ! INFLAGS1(5) - atm momentum fields @@ -592,7 +593,9 @@ subroutine export_fields (gcomp, rc) use w3gdatmd , only : nseal, mapsf, MAPSTA, USSPF, NK, w3setg use w3iogomd , only : CALC_U3STOKES #ifdef W3_CESMCOUPLED - use w3adatmd , only : LAMULT + use w3wdatmd , only : ASF, UST + use w3adatmd , only : USSHX, USSHY, UD, HS + use w3idatmd , only : HSL #else use wmmdatmd , only : mdse, mdst, wmsetm #endif @@ -603,6 +606,9 @@ subroutine export_fields (gcomp, rc) ! Local variables real(R8) :: fillvalue = 1.0e30_R8 ! special missing value +#ifdef W3_CESMCOUPLED + real(R8) :: sww, laslpj, alphal +#endif type(ESMF_State) :: exportState integer :: n, jsea, isea, ix, iy, lsize, ib @@ -618,6 +624,7 @@ subroutine export_fields (gcomp, rc) real(r8), pointer :: syyn(:) real(r8), pointer :: sw_lamult(:) + real(r8), pointer :: sw_lasl(:) real(r8), pointer :: sw_ustokes(:) real(r8), pointer :: sw_vstokes(:) @@ -661,13 +668,46 @@ subroutine export_fields (gcomp, rc) isea = iaproc + (jsea-1)*naproc ix = mapsf(isea,1) iy = mapsf(isea,2) - if (mapsta(iy,ix) == 1) then - sw_lamult(jsea) = LAMULT(jsea) + if (mapsta(iy,ix) == 1 .and. HS(jsea) > zero) then + sww = atan2(USSHY(jsea),USSHX(jsea)) - UD(isea) + alphal = atan( sin(sww) / ( & + 2.5 * UST(isea)*ASF(isea)*sqrt(dair/dwat) & + / max(1.e-14, sqrt(USSX(jsea)**2+USSY(jsea)**2)) & + * log(max(1.0, abs(1.25*HSL(ix,iy)/HS(jsea)))) & + + cos(sww) ) & + ) + ! note: an arbitrary minimum value of 0.2 is set to avoid zero + ! Langmuir number which may result from zero surface friction + ! velocity but may cause unphysically strong Langmuir mixing + laslpj = max( 0.2, sqrt( UST(isea)*ASF(isea)*sqrt(dair/dwat) & + / max(1.e-14, sqrt(USSHX(jsea)**2+USSHY(jsea)**2)) ) & + * sqrt(abs(cos(alphal))/abs(cos(sww-alphal))) ) + sw_lamult(jsea) = abs(cos(alphal)) * & + sqrt(1.0+(1.5*laslpj)**(-2)+(5.4*laslpj)**(-4)) else sw_lamult(jsea) = 1. endif enddo end if + if (state_fldchk(exportState, 'Sw_lasl')) then + call state_getfldptr(exportState, 'Sw_lasl', sw_lasl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + sw_lasl(:) = fillvalue + do jsea=1, nseal + isea = iaproc + (jsea-1)*naproc + ix = mapsf(isea,1) + iy = mapsf(isea,2) + if (mapsta(iy,ix) == 1) then + ! note: an arbitrary minimum value of 0.2 is set to avoid zero + ! Langmuir number which may result from zero surface friction + ! velocity but may cause unphysically strong Langmuir mixing + sw_lasl(jsea) = max(0.2, sqrt(UST(isea)*ASF(isea)*sqrt(dair/dwat) & + / max(1.e-14, sqrt(USSHX(jsea)**2+USSHY(jsea)**2)))) + else + sw_lasl(jsea) = 1.e6 + endif + enddo + end if #endif ! surface stokes drift