diff --git a/.circleci/config.yml b/.circleci/config.yml index dead29969..5c89ea615 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -1,11 +1,11 @@ version: 2.1 # Anchors in case we need to override the defaults from the orb -#baselibs_version: &baselibs_version v7.14.0 -#bcs_version: &bcs_version v11.1.0 +#baselibs_version: &baselibs_version v7.17.0 +#bcs_version: &bcs_version v11.4.0 orbs: - ci: geos-esm/circleci-tools@1 + ci: geos-esm/circleci-tools@2 workflows: build-test: diff --git a/CMakeLists.txt b/CMakeLists.txt index 4c9699c3e..85c78f0aa 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -5,6 +5,7 @@ set (alldirs GEOSdataatm_GridComp GEOSmkiau_GridComp GEOSogcm_GridComp + GEOSwgcm_GridComp ) diff --git a/GEOS_GcmGridComp.F90 b/GEOS_GcmGridComp.F90 index d5e9ebb0e..74c9f8d0d 100644 --- a/GEOS_GcmGridComp.F90 +++ b/GEOS_GcmGridComp.F90 @@ -21,6 +21,7 @@ module GEOS_GcmGridCompMod use GEOS_mkiauGridCompMod, only: AIAU_SetServices => SetServices use DFI_GridCompMod, only: ADFI_SetServices => SetServices use GEOS_OgcmGridCompMod, only: OGCM_SetServices => SetServices + use GEOS_WgcmGridCompMod, only: WGCM_SetServices => SetServices use MAPL_HistoryGridCompMod, only: Hist_SetServices => SetServices use MAPL_HistoryGridCompMod, only: HISTORY_ExchangeListWrap use iso_fortran_env @@ -39,6 +40,8 @@ module GEOS_GcmGridCompMod integer :: DO_DATA_ATM4OCN integer :: DO_OBIO integer :: DO_DATASEA + integer :: DO_WAVES + integer :: DO_SEA_SPRAY logical :: seaIceT_extData !============================================================================= @@ -53,6 +56,7 @@ module GEOS_GcmGridCompMod integer :: OGCM integer :: AIAU integer :: ADFI +integer :: WGCM integer :: hist integer :: bypass_ogcm @@ -82,6 +86,20 @@ module GEOS_GcmGridCompMod character(len=ESMF_MAXSTR) :: checkpointFileType = '' type(ESMF_GridComp) :: history_parent logical :: run_history = .false. + + ! coupling to wave model + type(ESMF_State) :: SURF_EXP + type(ESMF_State) :: SURF_IMP + type(ESMF_State) :: TURB_EXP + type(ESMF_State) :: TURB_IMP + type(ESMF_State) :: OCN_EXP + type(ESMF_State) :: OCN_IMP + type(ESMF_State) :: WGCM_EXP + type(ESMF_State) :: WGCM_IMP + type(ESMF_RouteHandle), pointer :: rh_a2w => NULL() + type(ESMF_RouteHandle), pointer :: rh_w2a => NULL() + type(ESMF_RouteHandle), pointer :: rh_o2w => NULL() + type(ESMF_RouteHandle), pointer :: rh_w2o => NULL() end type T_GCM_STATE ! Wrapper for extracting internal state @@ -187,10 +205,12 @@ subroutine SetServices ( GC, RC ) NUM_ICE_LAYERS = 1 endif - call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:",DEFAULT=0, _RC) - call MAPL_GetResource ( MAPL, DO_DATA_ATM4OCN, Label="USE_DATAATM:" , DEFAULT=0, _RC) - call MAPL_GetResource ( MAPL, DO_DATASEA, Label="USE_DATASEA:" , DEFAULT=1, _RC) - call MAPL_GetResource ( MAPL, seaIceT_extData, Label="SEAICE_THICKNESS_EXT_DATA:", DEFAULT=.FALSE., _RC ) ! .TRUE. or .FALSE. + call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:", DEFAULT=0, _RC) + call MAPL_GetResource ( MAPL, DO_DATA_ATM4OCN, Label="USE_DATAATM:", DEFAULT=0, _RC) + call MAPL_GetResource ( MAPL, DO_DATASEA, Label="USE_DATASEA:", DEFAULT=1, _RC) + call MAPL_GetResource ( MAPL, seaIceT_extData, Label="SEAICE_THICKNESS_EXT_DATA:", DEFAULT=.FALSE., _RC ) + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:", DEFAULT=0, _RC) + call MAPL_GetResource ( MAPL, DO_SEA_SPRAY, Label="USE_SEA_SPRAY:", DEFAULT=0, _RC) call MAPL_GetResource(MAPL, ReplayMode, 'REPLAY_MODE:', default="NoReplay", _RC ) @@ -239,6 +259,10 @@ subroutine SetServices ( GC, RC ) OGCM = MAPL_AddChild(GC, NAME='OGCM', SS=Ogcm_SetServices, RC=STATUS) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + WGCM = MAPL_AddChild(GC, NAME='WGCM', SS=Wgcm_SetServices, RC=STATUS) + VERIFY_(STATUS) + end if ! Get RUN Parameters (MERRA-2 Defaults) and Initialize for use in other Components (e.g., AGCM_GridComp and MKIAU_GridComp) !-------------------------------------------------------------------------------------------------------------------------- @@ -606,6 +630,21 @@ subroutine SetServices ( GC, RC ) _RC) endif + if (DO_WAVES /= 0) then + ! Terminate the imports of WGCM with the exception + ! of the few that have to be sent to ExtData + call MAPL_TerminateImport(GC, & + SHORT_NAME = (/ & + 'U10M ', 'V10M ', 'U10N ', 'V10N ', & + 'RHOS ', 'TSKINW ', 'TS ', 'FRLAND ', & + 'FROCEAN', 'FRACI ', 'PS ', 'Q10M ', & + 'RH2M ', 'T10M ', 'LHFX ', 'SH ', & + 'TW ', 'UW ', 'VW '/), & + CHILD=WGCM, & + RC=STATUS) + VERIFY_(STATUS) + end if + ! Allocate this instance of the internal state and put it in wrapper. ! ------------------------------------------------------------------- @@ -654,6 +693,15 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="--O2A" ,RC=STATUS) VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="--A2W" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="--W2A" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="--O2W" ,RC=STATUS) + VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="--W2O" ,RC=STATUS) + VERIFY_(STATUS) + RETURN_(ESMF_SUCCESS) @@ -875,6 +923,13 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GridCreate(GCS(AGCM), rc=status) VERIFY_(STATUS) +! Create Waves grid +!------------------------ + if (DO_WAVES /= 0) then + call MAPL_GridCreate(GCS(WGCM), rc=status) + VERIFY_(STATUS) + end if + ! Create Ocean grid !------------------ call MAPL_GridCreate(GCS(OGCM), rc=status) @@ -1198,6 +1253,14 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_AddRecord(CMAPL, ALARMS, (/MAPL_Write2Ram/), rc=status) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call MAPL_GetObjectFromGC ( GCS(WGCM), CMAPL, RC=STATUS) + VERIFY_(STATUS) + Alarms(1) = replayStartAlarm + call MAPL_AddRecord(CMAPL, ALARMS, (/MAPL_Write2Ram/), rc=status) + VERIFY_(STATUS) + end if + call MAPL_GetObjectFromGC ( GCS(OGCM), CMAPL, RC=STATUS) VERIFY_(STATUS) call MAPL_AddRecord(CMAPL, ALARMS, (/MAPL_Write2Ram/), rc=status) @@ -1252,6 +1315,45 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) skinname = 'SALTWATER' + ! wave model addition + ! select SURFACE export + call MAPL_ExportStateGet(GEX, name='SURFACE', & + result=GCM_INTERNAL_STATE%SURF_EXP, rc=status) + VERIFY_(STATUS) + + !select SURFACE import + call MAPL_ImportStateGet(GC, import=import, name='SURFACE', & + result=GCM_INTERNAL_STATE%SURF_IMP, rc=status) + VERIFY_(STATUS) + + !select TURBULENCE export + call MAPL_ExportStateGet(GEX, name='TURBULENCE', & + result=GCM_INTERNAL_STATE%TURB_EXP, rc=status) + VERIFY_(STATUS) + + !select SURFACE import + call MAPL_ImportStateGet(GC, import=import, name='TURBULENCE', & + result=GCM_INTERNAL_STATE%TURB_IMP, rc=status) + VERIFY_(STATUS) + + !select OCEAN export + call MAPL_ExportStateGet(GEX, name='OCEAN', & + result=GCM_INTERNAL_STATE%OCN_EXP, rc=status) + VERIFY_(STATUS) + + !select OCEAN import + call MAPL_ImportStateGet(GC, import=import, name='OCEAN', & + result=GCM_INTERNAL_STATE%OCN_IMP, rc=status) + VERIFY_(STATUS) + + if (DO_WAVES /= 0) then + !select WAVE import + GCM_INTERNAL_STATE%WGCM_IMP = GIM(WGCM) + + !select WAVE export + GCM_INTERNAL_STATE%WGCM_EXP = GEX(WGCM) + end if + call MAPL_GetResource(MAPL, bypass_ogcm, "BYPASS_OGCM:", & default=0, rc=status) VERIFY_(STATUS) @@ -1782,6 +1884,18 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) end if + ! Run the WGCM Gridded Component + ! ------------------------------ + ! ...not safe for WW3. It is also unneccessary, unless + ! there are two-way interactions between W and O/A, + ! so for now we opt not to run a wave model + if (DO_WAVES /= 0) then +#if (0) + call RUN_WAVES(RC=STATUS) + VERIFY_(STATUS) +#endif + end if + ! Advance the Clock ! ----------------- @@ -1884,6 +1998,10 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) call MAPL_GenericRefresh( GCS(OGCM), GIM(OGCM), GEX(OGCM), clock, rc=status ) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call MAPL_GenericRefresh( GCS(WGCM), GIM(WGCM), GEX(WGCM), clock, rc=status ) + VERIFY_(STATUS) + endif call ESMF_GridCompRun ( ExtData_internal_state%gc, importState=dummy, & exportState=ExtData_internal_state%ExpState, clock=clock, userRC=status ) @@ -1954,6 +2072,10 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call RUN_OCEAN(RC=STATUS) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call RUN_WAVES(RC=STATUS) + VERIFY_(STATUS) + end if call MAPL_TimerOff(MAPL,"TOTAL") call MAPL_TimerOff(MAPL,"RUN" ) @@ -2213,6 +2335,110 @@ subroutine RUN_OCEAN(phase, rc) RETURN_(ESMF_SUCCESS) end subroutine RUN_OCEAN + subroutine RUN_WAVES(rc) + implicit none + + integer, optional, intent(OUT) :: rc + integer :: status + character(len=ESMF_MAXSTR) :: Iam='Run_Waves' + + type(ESMF_State), pointer :: SRC, DST + + call MAPL_TimerOn(MAPL, "--A2W") + + ! aliases + SRC => GCM_INTERNAL_STATE%SURF_EXP + DST => GCM_INTERNAL_STATE%WGCM_IMP + + call DO_A2W(SRC, DST, NAME='FRLAND', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='FROCEAN', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='FRACI', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='U10M', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='V10M', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='U10N', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='V10N', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='RHOS', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='TS', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='TSKINW', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='SH', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='LHFX', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='PS', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='Q10M', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='T10M', RC=STATUS) + VERIFY_(STATUS) + call DO_A2W(SRC, DST, NAME='RH2M', RC=STATUS) + VERIFY_(STATUS) + + call MAPL_TimerOff(MAPL, "--A2W") + + + call MAPL_TimerOn(MAPL, "--O2W") + + ! aliases + SRC => GCM_INTERNAL_STATE%OCN_EXP + DST => GCM_INTERNAL_STATE%WGCM_IMP + + call DO_O2W(SRC, DST, NAME='UW', RC=STATUS) + VERIFY_(STATUS) + call DO_O2W(SRC, DST, NAME='VW', RC=STATUS) + VERIFY_(STATUS) + call DO_O2W(SRC, DST, NAME='TW', RC=STATUS) + VERIFY_(STATUS) + + call MAPL_TimerOff(MAPL, "--O2W") + + ! run the actual wave model + call MAPL_TimerOn(MAPL, "WGCM") + + call ESMF_GridCompRun ( GCS(WGCM), importState=gim(WGCM), exportState=gex(WGCM), clock=clock, userRC=status ) + VERIFY_(STATUS) + + call MAPL_TimerOff(MAPL, "WGCM") + + + call MAPL_TimerOn (MAPL,"--W2A" ) + + ! aliases + SRC => GCM_INTERNAL_STATE%WGCM_EXP + DST => GCM_INTERNAL_STATE%SURF_IMP + + call DO_W2A(SRC, DST, NAME='CHARNOCK', RC=STATUS) + VERIFY_(STATUS) + + if (DO_SEA_SPRAY /= 0) then + ! aliases + SRC => GCM_INTERNAL_STATE%WGCM_EXP + DST => GCM_INTERNAL_STATE%TURB_IMP + + call DO_W2A(SRC, DST, NAME='SHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + call DO_W2A(SRC, DST, NAME='LHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + end if + + call MAPL_TimerOff(MAPL,"--W2A" ) + + ! possibly W2O + ! ... + + RETURN_(ESMF_SUCCESS) + + end subroutine RUN_WAVES + subroutine OBIO_A2O(DO_DATA_ATM4OCN, RC) integer, intent(IN ) :: DO_DATA_ATM4OCN @@ -2611,7 +2837,186 @@ subroutine DO_O2A_SUBTILES2D_R8R4(STATEA,NAMEA,SUBINDEXA,STATEO,NAMEO,SUBINDEXO, RETURN_(ESMF_SUCCESS) end subroutine DO_O2A_SUBTILES2D_R8R4 + subroutine DO_A2W(SRC,DST,NAME,RC) + implicit none + + type(ESMF_STATE), intent(INout) :: SRC + type(ESMF_STATE), intent(inout) :: DST + character(len=*), intent(in) :: NAME + integer, optional,intent(out) :: RC + + character(len=ESMF_MAXSTR), parameter :: Iam = 'A2W' + integer :: status + + type(ESMF_RouteHandle), pointer :: rh + type(ESMF_Field) :: srcField, dstField + + call ESMF_StateGet(SRC, name, srcField, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(DST, name, dstField, rc=status) + VERIFY_(STATUS) + rh => GCM_INTERNAL_STATE%rh_a2w + if (.not.associated(rh)) then + !ALT: this should be done only once per regridder + allocate(rh, stat=status) + VERIFY_(STATUS) + call ESMF_FieldRegridStore(srcField, dstField, & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + lineType=ESMF_LINETYPE_GREAT_CIRCLE, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + GCM_INTERNAL_STATE%rh_a2w => rh + + ! we could specify a regridMethod as additional argument in call above. + ! The default is ESMF_REGRID_METHOD_BILINEAR. + ! Also, we could have specified srcMaskValues, and dstMaskValues, + ! we might need to attach a mask to the grid + + end if + + call ESMF_FieldRegrid(srcField=srcField, dstField=dstField, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + RETURN_(ESMF_SUCCESS) + end subroutine DO_A2W + + subroutine DO_W2A(SRC,DST,NAME,RC) + type(ESMF_STATE), intent(INout) :: SRC + type(ESMF_STATE), intent(inout) :: DST + character(len=*), intent(in) :: NAME + integer, optional,intent(out) :: RC + + character(len=ESMF_MAXSTR), parameter :: Iam = 'W2A' + integer :: status + + type(ESMF_RouteHandle), pointer :: rh + type(ESMF_Field) :: srcField, dstField + + call ESMF_StateGet(SRC, name, srcField, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(DST, name, dstField, rc=status) + VERIFY_(STATUS) + rh => GCM_INTERNAL_STATE%rh_w2a + if (.not.associated(rh)) then + !ALT: this should be done only once per regridder + allocate(rh, stat=status) + VERIFY_(STATUS) + call ESMF_FieldRegridStore(srcField, dstField, & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + lineType=ESMF_LINETYPE_GREAT_CIRCLE, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + GCM_INTERNAL_STATE%rh_w2a => rh + + ! we could specify a regridMethod as additional argument in call above. + ! The default is ESMF_REGRID_METHOD_BILINEAR. + ! Also, we could have specified srcMaskValues, and dstMaskValues, + ! we might need to attach a mask to the grid + + end if + + call ESMF_FieldRegrid(srcField=srcField, dstField=dstField, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + RETURN_(ESMF_SUCCESS) + end subroutine DO_W2A + + subroutine DO_O2W(SRC,DST,NAME,RC) + type(ESMF_STATE), intent(INout) :: SRC + type(ESMF_STATE), intent(inout) :: DST + character(len=*), intent(in) :: NAME + integer, optional,intent(out) :: RC + + character(len=ESMF_MAXSTR), parameter :: Iam = 'O2W' + integer :: status + + type(ESMF_RouteHandle), pointer :: rh + type(ESMF_Field) :: srcField, dstField + + call ESMF_StateGet(SRC, name, srcField, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(DST, name, dstField, rc=status) + VERIFY_(STATUS) + rh => GCM_INTERNAL_STATE%rh_o2w + if (.not.associated(rh)) then + !ALT: this should be done only once per regridder + allocate(rh, stat=status) + VERIFY_(STATUS) + call ESMF_FieldRegridStore(srcField, dstField, & + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, & + lineType=ESMF_LINETYPE_GREAT_CIRCLE, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + GCM_INTERNAL_STATE%rh_o2w => rh + + ! we could specify a regridMethod as additional argument in call above. + ! The default is ESMF_REGRID_METHOD_BILINEAR. + ! Also, we could have specified srcMaskValues, and dstMaskValues, + ! we might need to attach a mask to the grid + + end if + + call ESMF_FieldRegrid(srcField=srcField, dstField=dstField, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + RETURN_(ESMF_SUCCESS) + end subroutine DO_O2W + + subroutine DO_W2O(SRC,DST,NAME,RC) + type(ESMF_STATE), intent(INout) :: SRC + type(ESMF_STATE), intent(inout) :: DST + character(len=*), intent(in) :: NAME + integer, optional,intent(out) :: RC + + character(len=ESMF_MAXSTR), parameter :: Iam = 'W2O' + integer :: status + + type(ESMF_RouteHandle), pointer :: rh + type(ESMF_Field) :: srcField, dstField + + call ESMF_StateGet(SRC, name, srcField, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(DST, name, dstField, rc=status) + VERIFY_(STATUS) + rh => GCM_INTERNAL_STATE%rh_w2o + if (.not.associated(rh)) then + !ALT: this should be done only once per regridder + allocate(rh, stat=status) + VERIFY_(STATUS) + call ESMF_FieldRegridStore(srcField, dstField, & + regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & + lineType=ESMF_LINETYPE_GREAT_CIRCLE, & + routeHandle=rh, & + unmappedAction=ESMF_UNMAPPEDACTION_IGNORE, rc=status) + VERIFY_(STATUS) + + GCM_INTERNAL_STATE%rh_w2o => rh + ! we could specify a regridMethod as additional argument in call above. + ! The default is ESMF_REGRID_METHOD_BILINEAR. + ! For conservative regridding, in addition to specify + ! ESMF_REGRID_METHOD_CONSERVATIVE, we need the corners of both grids + ! Also, we could have specified srcMaskValues, and dstMaskValues, + ! we might need to attach a mask to the grid + + end if + + call ESMF_FieldRegrid(srcField=srcField, dstField=dstField, & + routeHandle=rh, rc=status) + VERIFY_(STATUS) + + RETURN_(ESMF_SUCCESS) + end subroutine DO_W2O + end subroutine Run +!ALT we could have a finalize method to release memory +! for example call ESMF_FieldRegridRelease(routeHandle, rc=status) + end module GEOS_GcmGridCompMod diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 index 1d41efc72..36c2efe65 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOS_PhysicsGridComp.F90 @@ -112,6 +112,7 @@ subroutine SetServices ( GC, RC ) type (ESMF_Config) :: CF integer :: DO_OBIO, DO_CO2CNNEE, ATM_CO2, nCols, NQ + integer :: DO_WAVES, DO_SEA_SPRAY real :: SYNCTQ character(len=ESMF_MAXSTR), allocatable :: NAMES(:) @@ -168,6 +169,11 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:",DEFAULT=0, RC=STATUS) VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:",DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetResource ( MAPL, DO_SEA_SPRAY, Label="USE_SEA_SPRAY:",DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SURFRC, label = 'SURFRC:', default = 'GEOS_SurfaceGridComp.rc', RC=STATUS) ; VERIFY_(STATUS) SCF = ESMF_ConfigCreate(rc=status) ; VERIFY_(STATUS) call ESMF_ConfigLoadFile(SCF,SURFRC,rc=status) ; VERIFY_(STATUS) @@ -566,7 +572,7 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'MCHEMTRI', & + SHORT_NAME = 'MCHEMTRI', & LONG_NAME = 'moist_quantities', & UNITS = 'UNITS s-1', & DATATYPE = MAPL_BundleItem, & @@ -1410,6 +1416,22 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) endif + if (DO_WAVES/=0) then + call MAPL_TerminateImport ( GC, & + SHORT_NAME = (/ 'CHARNOCK'/), & + CHILD = SURF, & + RC=STATUS ) + VERIFY_(STATUS) + endif + + if (DO_WAVES/=0 .and. DO_SEA_SPRAY/=0) then + call MAPL_TerminateImport ( GC, & + SHORT_NAME = (/ 'SHFX_SPRAY', 'LHFX_SPRAY'/), & + CHILD = TURBL, & + RC=STATUS ) + VERIFY_(STATUS) + endif + call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'TR ','TRG','DTG' /), & CHILD = TURBL, & @@ -1951,13 +1973,30 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end do deallocate ( NAMES ) -! Fill the moist increments bundle -!--------------------------------- +! Fill the moist increments bundles +!---------------------------------- + +! The original 3D increments: + + call Initialize_IncBundle_init(GC, GIM(MOIST), EXPORT, MTRIinc, __RC__) + +#ifdef PRINT_STATES + call ESMF_StateGet(EXPORT, 'MTRI', iBUNDLE, rc=STATUS) + VERIFY_(STATUS) + + call WRITE_PARALLEL ( trim(Iam)//": MTRI - Convective Transport and Scavenging 3D Tendency Bundle" ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( iBUNDLE, rc=STATUS ) +#endif + +! The 2D vertically summed, mass weighted increments: call Initialize_IncMBundle_init(GC, GIM(MOIST), EXPORT, __RC__) #ifdef PRINT_STATES - call WRITE_PARALLEL ( trim(Iam)//": Convective Transport Tendency Bundle" ) + call ESMF_StateGet(EXPORT, 'MCHEMTRI', iBUNDLE, rc=STATUS) + VERIFY_(STATUS) + + call WRITE_PARALLEL ( trim(Iam)//": MCHEMTRI - Convective Transport and Scavenging 2D Tendency Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( iBUNDLE, rc=STATUS ) #endif @@ -2443,7 +2482,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Moist Processes !---------------- - call Initialize_IncMBundle_run(GIM(MOIST), EXPORT, DM=DM,__RC__) + call Initialize_IncBundle_run( GIM(MOIST), EXPORT, MTRIinc, __RC__) ! 3D non-weighted + call Initialize_IncMBundle_run(GIM(MOIST), EXPORT, DM=DM, __RC__) ! 2D mass-weighted I=MOIST @@ -2454,7 +2494,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetObjectFromGC ( GCS(I), CMETA, _RC) - call Compute_IncMBundle(GIM(MOIST), EXPORT, CMETA, DM=DM,__RC__) + call Compute_IncBundle( GIM(MOIST), EXPORT, MTRIinc, STATE, __RC__) ! 3D non-weighted + call Compute_IncMBundle(GIM(MOIST), EXPORT, CMETA, DM=DM, __RC__) ! 2D mass-weighted call MAPL_GetPointer(GIM(MOIST), DTDT_BL, 'DTDT_BL', alloc = .true. ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(GIM(MOIST), DQDT_BL, 'DQDT_BL', alloc = .true. ,RC=STATUS); VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 index 9d3bc399f..c3f9fff23 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSmoist_GridComp/Process_Library.F90 @@ -1784,18 +1784,18 @@ subroutine partition_dblgss( dt, & ! IN ! Partition based on temperature for the first plume - IF (Tl1_1 >= tbgmax) THEN - esval1_1 = MAPL_EQsat(Tl1_1) - lstarn1 = lcond - ELSE IF (Tl1_1 < tbgmin) THEN - esval1_1 = MAPL_EQsat(Tl1_1,OverIce=.TRUE.) - lstarn1 = lsub - ELSE +! IF (Tl1_1 >= tbgmax) THEN +! esval1_1 = MAPL_EQsat(Tl1_1) +! lstarn1 = lcond +! ELSE IF (Tl1_1 < tbgmin) THEN +! esval1_1 = MAPL_EQsat(Tl1_1,OverIce=.TRUE.) +! lstarn1 = lsub +! ELSE esval1_1 = MAPL_EQsat(Tl1_1) esval2_1 = MAPL_EQsat(Tl1_1,OverIce=.TRUE.) - om1 = 1.-fQi !max(0.,min(1.,a_bg*(Tl1_1-tbgmin))) ! may be inconsistent with hystpdf ice fraction + om1 = max(0.,min(1.,1.-fQi)) !max(0.,min(1.,a_bg*(Tl1_1-tbgmin))) ! may be inconsistent with hystpdf ice fraction lstarn1 = lcond + (1.-om1)*lfus - ENDIF +! ENDIF ! this is qs evaluated at Tl qs1 = om1 * (0.622*esval1_1/max(esval1_1,pval-0.378*esval1_1)) & @@ -1811,18 +1811,18 @@ subroutine partition_dblgss( dt, & ! IN beta2 = beta1 ELSE - IF (Tl1_2 < tbgmin) THEN - esval1_2 = MAPL_EQsat(Tl1_2,OverIce=.TRUE.) - lstarn2 = lsub - ELSE IF (Tl1_2 >= tbgmax) THEN - esval1_2 = MAPL_EQsat(Tl1_2) - lstarn2 = lcond - ELSE +! IF (Tl1_2 < tbgmin) THEN +! esval1_2 = MAPL_EQsat(Tl1_2,OverIce=.TRUE.) +! lstarn2 = lsub +! ELSE IF (Tl1_2 >= tbgmax) THEN +! esval1_2 = MAPL_EQsat(Tl1_2) +! lstarn2 = lcond +! ELSE esval1_2 = MAPL_EQsat(Tl1_2) esval2_2 = MAPL_EQsat(Tl1_2,OverIce=.TRUE.) - om2 = 1.-fQi !max(0.,min(1.,a_bg*(Tl1_2-tbgmin))) + om2 = max(0.,min(1.,1.-fQi)) !max(0.,min(1.,a_bg*(Tl1_2-tbgmin))) lstarn2 = lcond + (1.-om2)*lfus - ENDIF +! ENDIF qs2 = om2 * (0.622*esval1_2/max(esval1_2,pval-0.378*esval1_2)) & + (1.-om2) * (0.622*esval2_2/max(esval2_2,pval-0.378*esval2_2)) @@ -1902,11 +1902,11 @@ subroutine partition_dblgss( dt, & ! IN qn1 = min(qn1,qw1_1) qn2 = min(qn2,qw1_2) -! ql1 = qn1*om1 -! ql2 = qn2*om2 + ql1 = qn1*om1 + ql2 = qn2*om2 -! qi1 = qn1 - ql1 -! qi2 = qn2 - ql2 + qi1 = qn1 - ql1 + qi2 = qn2 - ql2 qc = min(max(0.0, aterm*qn1 + onema*qn2), total_water) ! diag_ql = min(max(0.0, aterm*ql1 + onema*ql2), diag_qn) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 index dc4bba86b..2d84c4707 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOS_SurfaceGridComp.F90 @@ -97,6 +97,7 @@ module GEOS_SurfaceGridCompMod character(len=ESMF_MAXSTR), pointer :: GCNames(:) integer :: CHILD_MASK(NUM_CHILDREN) integer :: DO_OBIO, ATM_CO2 + integer :: DO_WAVES integer :: CHOOSEMOSFC logical :: DO_GOSWIM logical :: DO_FIRE_DANGER @@ -244,6 +245,7 @@ subroutine SetServices ( GC, RC ) ! ------------------------------------------------------- call MAPL_GetResource (MAPL, LSM_CHOICE, label="LSM_CHOICE:", DEFAULT=1, RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (MAPL, DO_OBIO, label="USE_OCEANOBIOGEOCHEM:", DEFAULT=0, RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, DO_WAVES, label="USE_WAVES:", DEFAULT=0, RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (SCF, ATM_CO2, label='ATM_CO2:', DEFAULT=2, __RC__ ) call MAPL_GetResource (SCF, catchswim, label='N_CONST_LAND4SNWALB:', DEFAULT=0, __RC__ ) @@ -653,6 +655,19 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CHARNOCK', & + LONG_NAME = 'charnock_coefficient', & + UNITS = '1', & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0185, & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + end if + if (DO_DATA_ATM4OCN /= 0) then call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'DISCHARGE', & @@ -2980,6 +2995,17 @@ subroutine SetServices ( GC, RC ) END IF + if (DO_WAVES /= 0) then + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'surface_pressure', & + UNITS = 'Pa', & + SHORT_NAME = 'PS', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + end if + if (DO_FIRE_DANGER) then ! hourly @@ -4139,6 +4165,9 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: PCU => NULL() real, pointer, dimension(:,:) :: PHIS => NULL() + real, pointer, dimension(:,:) :: CHARNOCK => NULL() + + ! Pointers to gridded internals real, pointer, dimension(:,:) :: CT => NULL() @@ -4200,6 +4229,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: VWINDLMTILE => NULL() real, pointer, dimension(:) :: PCUTILE => NULL() + real, pointer, dimension(:) :: CHARNOCKTILE=> NULL() + ! Pointers to tiled versions of internals real, pointer, dimension(:) :: CTTILE => NULL() @@ -4316,6 +4347,10 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(IMPORT , PCU , 'PCU' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , PHIS , 'PHIS' , RC=STATUS); VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call MAPL_GetPointer(IMPORT , CHARNOCK , 'CHARNOCK', RC=STATUS); VERIFY_(STATUS) + end if + ! Pointers to grid outputs !------------------------- @@ -4339,14 +4374,14 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , MOQ2M , 'Q2M' , ALLOC = .true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOU2M , 'U2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOV2M , 'V2M' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , MOT10M , 'T10M' ,RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , MOQ10M , 'Q10M' ,RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , MOT10M , 'T10M' ,ALLOC = .true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , MOQ10M , 'Q10M' ,ALLOC = .true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOU10M , 'U10M' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOV10M , 'V10M' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOU50M , 'U50M' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOV50M , 'V50M' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , UU10M , 'UU10M' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , RH2M , 'RH2M' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , RH2M , 'RH2M' , ALLOC = .true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , T2MDEW , 'T2MDEW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , T2MWET , 'T2MWET' , RC=STATUS); VERIFY_(STATUS) else @@ -4416,6 +4451,10 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) allocate( PCUTILE(NT), STAT=STATUS) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + allocate(CHARNOCKTILE(NT), STAT=STATUS) + VERIFY_(STATUS) + end if ! Imports at the tiles !--------------------- @@ -4434,6 +4473,10 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_LocStreamTransform( LOCSTREAM, VWINDLMTILE, VWINDLM, INTERP=useInterp, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, PCUTILE, PCU, RC=STATUS); VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call MAPL_LocStreamTransform( LOCSTREAM, CHARNOCKTILE, CHARNOCK, RC=STATUS); VERIFY_(STATUS) + end if + ! Allocate tile versions of internal !------------------------------------ @@ -4762,6 +4805,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) if(associated( UWINDLMTILE)) deallocate( UWINDLMTILE) if(associated( VWINDLMTILE)) deallocate( VWINDLMTILE) + if(associated(CHARNOCKTILE)) deallocate(CHARNOCKTILE) + ! All done !----------- @@ -4818,6 +4863,11 @@ subroutine DOCDS(type, NT, RC) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'PCU', PCUTILE, XFORM, RC=STATUS) VERIFY_(STATUS) + if (DO_WAVES /= 0) then + call FILLIN_TILE(GIM(type), 'CHARNOCK', CHARNOCKTILE, XFORM, RC=STATUS) + VERIFY_(STATUS) + end if + ! Allocate the child's needed exports !------------------------------------ @@ -5259,6 +5309,9 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: FRLAND => NULL() real, pointer, dimension(:,:) :: FRLANDICE => NULL() real, pointer, dimension(:,:) :: HLATN => NULL() + real, pointer, dimension(:,:) :: PS_ => NULL() + + real, pointer, dimension(:,:) :: HLATWTR => NULL() real, pointer, dimension(:,:) :: HLATICE => NULL() @@ -6448,9 +6501,9 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) endif - call MAPL_GetPointer(EXPORT , HLATWTR , 'HLATWTR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , HLATWTR , 'HLATWTR' , alloc=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , HLATICE , 'HLATICE' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , SHWTR , 'SHWTR' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , SHWTR , 'SHWTR' , alloc=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SHICE , 'SHICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUXW , 'TAUXW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUXI , 'TAUXI' , RC=STATUS); VERIFY_(STATUS) @@ -6462,7 +6515,7 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , SWNDICE , 'SWNDICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SNOWOCN , 'SNOWOCN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RAINOCN , 'RAINOCN' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , TSKINW , 'TSKINW' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , TSKINW , 'TSKINW' , alloc=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TSKINICE , 'TSKINICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , HICE , 'HICE' , RC=STATUS); VERIFY_(STATUS) @@ -6493,8 +6546,8 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , EVAPOU , 'EVAPOUT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SUBLIM , 'SUBLIM' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , SHOU , 'SHOUT' , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetPointer(EXPORT , HLWUP , 'HLWUP' , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , SHOU , 'SHOUT' , alloc=.true., RC=STATUS); VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT , HLWUP , 'HLWUP' , alloc=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LWNDSRF , 'LWNDSRF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SWNDSRF , 'SWNDSRF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RUNOFF , 'RUNOFF' , RC=STATUS); VERIFY_(STATUS) @@ -6590,6 +6643,11 @@ subroutine RUN2 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(EXPORT , CNFSEL , 'CNFSEL' , RC=STATUS); VERIFY_(STATUS) END IF + if (DO_WAVES /= 0) then + call MAPL_GetPointer(EXPORT , PS_ , 'PS', alloc=.true., RC=STATUS); VERIFY_(STATUS) + PS_ = PS + end if + if (DO_FIRE_DANGER) then call MAPL_GetPointer(EXPORT , FFMC , 'FFMC' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , GFMC , 'GFMC' , RC=STATUS); VERIFY_(STATUS) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 index cd9a4b974..436045ac7 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_OpenWaterGridComp.F90 @@ -140,6 +140,8 @@ subroutine SetServices ( GC, RC ) type (MAPL_MetaComp), pointer :: MAPL type (ESMF_Config) :: CF + integer :: DO_WAVES + type(openwater_state_wrap) :: wrap type(openwater_state), pointer :: mystate character(len=ESMF_MAXSTR) :: SURFRC @@ -171,6 +173,9 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource ( MAPL, DO_SKIN_LAYER, Label="USE_SKIN_LAYER:" , DEFAULT=0, _RC) + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:" , DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + ! Set the state variable specs. ! ----------------------------- @@ -1305,6 +1310,18 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartSkip, & _RC) + if (DO_WAVES /= 0) then + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CHARNOCK', & + LONG_NAME = 'charnock_coefficient', & + UNITS = '1', & + RESTART = MAPL_RestartSkip, & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + end if + !EOS allocate(mystate,_STAT) @@ -1427,6 +1444,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:) :: FI => null() real, pointer, dimension(:) :: TF => null() real, pointer, dimension(:) :: TS_FOUNDi => null() + real, pointer, dimension(:) :: CHARNOCK => null() + integer :: N integer :: NT @@ -1491,6 +1510,9 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=100) :: WHICH_T_TO_SFCLAYER ! what temperature does the sfclayer get from AOIL? real :: DEPTH_T_TO_SFCLAYER ! temperature (at what depth) does the sfclayer get from AOIL? + integer :: DO_WAVES + real, allocatable :: CHARNOCK_(:) + !============================================================================= ! Begin... @@ -1562,6 +1584,11 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) epsilon_d = 0.0 end if +! Is the wave model enabled +! ------------------------- + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + ! Pointers to inputs !------------------- @@ -1579,6 +1606,23 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer(IMPORT,TF , 'TFREEZE', _RC) call MAPL_GetPointer(IMPORT,TS_FOUNDi, 'TS_FOUND', _RC) + NT = size(TA) + allocate(CHARNOCK_(NT), STAT=STATUS) + VERIFY_(STATUS) + + if (DO_WAVES /= 0) then + call MAPL_GetPointer(IMPORT,CHARNOCK, 'CHARNOCK', RC=STATUS) + VERIFY_(STATUS) + + where (CHARNOCK > 0 .and. CHARNOCK < 1.0) + CHARNOCK_ = CHARNOCK + elsewhere + CHARNOCK_ = 0.0185 + end where + else + CHARNOCK_ = 0.0185 + end if + ! Pointers to internals !---------------------- @@ -1744,7 +1788,7 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) call helfsurface( UWINDLMTILE,VWINDLMTILE,TA,TS(:,N),QA,QS(:,N),PSL,PSMB,Z0(:,N), & fakelai,IWATER,DZ,niter,nt,RHO,VKH,VKM,USTAR,XX,YY,CU,CT,RIB,ZETA,WS, & - t2m,q2m,u2m,v2m,t10m,q10m,u10m,v10m,u50m,v50m,CHOOSEZ0) + t2m,q2m,u2m,v2m,t10m,q10m,u10m,v10m,u50m,v50m,CHOOSEZ0,CHARNOCK_) CM(:,N) = VKM CH(:,N) = VKH @@ -1842,6 +1886,8 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) deallocate(PSMB) deallocate(PSL) + deallocate(CHARNOCK_) + ! All done !----------- diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 index 7f9822832..a5ba05041 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/GEOSsaltwater_GridComp/GEOS_SaltWaterGridComp.F90 @@ -100,6 +100,7 @@ subroutine SetServices ( GC, RC ) integer :: I, k integer :: DO_OBIO ! default (=0) is to run saltwater, with no ocean bio and chem integer :: DO_CICE_THERMO ! default (=0) is to run saltwater, with no LANL CICE Thermodynamics + integer :: DO_WAVES logical :: seaIceT_extData ! default (=.FALSE.) is to NOT use data sea ice thickness from ExtData character(len = 2) :: suffix @@ -129,6 +130,11 @@ subroutine SetServices ( GC, RC ) call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:", DEFAULT=0, _RC) +! Waves: active or disabled? +!------------------------------------------------ + + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:", DEFAULT=0, _RC) + ! Data sea ice thickness from ExtData or not? !-------------------------------------------- @@ -647,6 +653,17 @@ subroutine SetServices ( GC, RC ) RESTART = MAPL_RestartSkip ,& _RC ) + if (DO_WAVES /= 0) then + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CHARNOCK', & + LONG_NAME = 'charnock_coefficient', & + UNITS = '1', & + RESTART = MAPL_RestartSkip, & + DIMS = MAPL_DimsTileOnly, & + VLOCATION = MAPL_VLocationNone, & + _RC ) + end if + call MAPL_AddExportSpec(GC, SHORT_NAME = 'TSKINW' , CHILD_ID = WATER, _RC) call MAPL_AddExportSpec(GC, SHORT_NAME = 'HSKINW' , CHILD_ID = WATER, _RC) call MAPL_AddExportSpec(GC, SHORT_NAME = 'SSKINW' , CHILD_ID = WATER, _RC) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt index d7b221423..7a29c9a6f 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/Raster/makebcs/CMakeLists.txt @@ -33,6 +33,9 @@ if (Baselibs_FOUND) else () find_package(ZLIB) target_link_libraries(${this} PRIVATE ZLIB::zlib) + # Spack testing shows we need stdlib.h, so this ifdef will + # enable it in zip.c + target_compile_definitions(${this} PRIVATE STDC) endif () ecbuild_add_executable (TARGET CombineRasters.x SOURCES CombineRasters.F90 LIBS MAPL ${this}) diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 index 2e202a45b..117b54731 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_catchANDcnRestarts.F90 @@ -112,7 +112,7 @@ subroutine process_cmd() call getarg(nxt,arg) end do if (index(model, 'catchcn') /=0 ) then - if((INDEX(out_bcsdir, 'NL') == 0).AND.(INDEX(out_bcsdir, 'OutData') == 0)) then + if((INDEX(out_bcsdir, '/ICA/') /= 0) .or. (INDEX(out_bcsdir, '/GM4/') /= 0)) then print *,'Land BCs in : ',trim(out_bcsdir) print *,'do not support ',trim (model) stop diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 index 8e7f233e2..1692a6cf6 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/GEOS_TurbulenceGridComp.F90 @@ -230,6 +230,11 @@ subroutine SetServices ( GC, RC ) character(len=ESMF_MAXSTR) :: FRIENDLIES_SHOC + type (MAPL_MetaComp), pointer :: MAPL + + integer :: DO_WAVES + integer :: DO_SEA_SPRAY + !============================================================================= ! Begin... @@ -242,6 +247,17 @@ subroutine SetServices ( GC, RC ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // Iam +! Get my MAPL_Generic state +!-------------------------- + call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetResource ( MAPL, DO_SEA_SPRAY, Label="USE_SEA_SPRAY:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + ! Set the Run entry points ! ------------------------ @@ -583,6 +599,30 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + if (DO_WAVES/=0 .and. DO_SEA_SPRAY/=0) then + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'SHFX_SPRAY', & + LONG_NAME = 'sensible_heat_contribution_from_sea_spray', & + UNITS = '1', & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0, & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'LHFX_SPRAY', & + LONG_NAME = 'latent_heat_contribution_from_sea_spray', & + UNITS = '1', & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0, & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RC=STATUS ) + VERIFY_(STATUS) + end if + call MAPL_AddImportSpec(GC, & SHORT_NAME = 'WTHV2', & LONG_NAME = 'Buoyancy_flux_for_SHOC_TKE', & @@ -628,6 +668,24 @@ subroutine SetServices ( GC, RC ) ! mass-flux export states ! + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'EDMF_rain_tendency', & + UNITS = 'kg kg-1 s-1', & + SHORT_NAME = 'EDMF_DQRDT', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, & + RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'EDMF_snow_tendency', & + UNITS = 'kg kg-1 s-1', & + SHORT_NAME = 'EDMF_DQSDT', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, & + RC=STATUS ) + VERIFY_(STATUS) + call MAPL_AddExportSpec(GC, & LONG_NAME = 'Vertical_velocity_of_individual_EDMF_plumes', & UNITS = 'm s-1', & @@ -1872,6 +1930,22 @@ subroutine SetServices ( GC, RC ) RC=STATUS ) VERIFY_(STATUS) + if (DO_WAVES/=0 .and. DO_SEA_SPRAY/=0) then + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SHFX_SPRAY', & + LONG_NAME = 'sensible_heat_contribution_from_sea_spray', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LHFX_SPRAY', & + LONG_NAME = 'latent_heat_contribution_from_sea_spray', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + end if + ! !INTERNAL STATE: ! @@ -2478,6 +2552,15 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Idealized SCM surface layer variables real, dimension(:,:), pointer :: cu_scm, ct_scm, ssurf_scm, qsurf_scm +! Sea spray + integer :: DO_WAVES + integer :: DO_SEA_SPRAY + real, dimension(:,:), pointer :: SH_SPR => null() + real, dimension(:,:), pointer :: LH_SPR => null() + real, dimension(:,:), pointer :: SH_SPRX => null() + real, dimension(:,:), pointer :: LH_SPRX => null() + + ! Begin... !--------- @@ -2513,6 +2596,28 @@ subroutine RUN1 ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompGet( GC, CONFIG = CF, RC=STATUS ) VERIFY_(STATUS) +! Sea spray + call MAPL_GetResource ( MAPL, DO_WAVES, Label="USE_WAVES:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetResource ( MAPL, DO_SEA_SPRAY, Label="USE_SEA_SPRAY:", DEFAULT=0, RC=STATUS) + VERIFY_(STATUS) + + if (DO_WAVES/=0 .and. DO_SEA_SPRAY/=0) then + call MAPL_GetPointer(IMPORT, SH_SPR, 'SHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(IMPORT, LH_SPR, 'LHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetPointer(EXPORT, SH_SPRX, 'SHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, LH_SPRX, 'LHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + + if (associated(SH_SPRX)) SH_SPRX = SH_SPR + if (associated(LH_SPRX)) LH_SPRX = LH_SPR + end if + ! Get all pointers that are needed by both REFRESH and DIFFUSE !------------------------------------------------------------- @@ -2829,7 +2934,7 @@ subroutine REFRESH(IM,JM,LM,RC) edmf_w3, edmf_wqt, edmf_slqt, & edmf_wsl, edmf_qt3, edmf_sl3, & edmf_entx, edmf_tke, slflxmf, & - qtflxmf, mfaw + qtflxmf, mfaw, edmf_dqrdt, edmf_dqsdt real, dimension(IM,JM,0:LM) :: ae3,aw3,aws3,awqv3,awql3,awqi3,awu3,awv3 @@ -3053,19 +3158,19 @@ subroutine REFRESH(IM,JM,LM,RC) call MAPL_GetResource (MAPL, SHOCPARAMS%CEFAC, trim(COMP_NAME)//"_SHC_CEFAC:", default=1.0, RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (MAPL, SHOCPARAMS%CESFAC, trim(COMP_NAME)//"_SHC_CESFAC:", default=4., RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (MAPL, SHOCPARAMS%LENOPT, trim(COMP_NAME)//"_SHC_LENOPT:", default=3, RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SHOCPARAMS%LENFAC1, trim(COMP_NAME)//"_SHC_LENFAC1:", default=4.0, RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SHOCPARAMS%LENFAC2, trim(COMP_NAME)//"_SHC_LENFAC2:", default=1.0, RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SHOCPARAMS%LENFAC3, trim(COMP_NAME)//"_SHC_LENFAC3:", default=2.0, RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SHOCPARAMS%LENFAC1, trim(COMP_NAME)//"_SHC_LENFAC1:", default=10.0, RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SHOCPARAMS%LENFAC2, trim(COMP_NAME)//"_SHC_LENFAC2:", default=2.0, RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SHOCPARAMS%LENFAC3, trim(COMP_NAME)//"_SHC_LENFAC3:", default=1.5, RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (MAPL, SHOCPARAMS%BUOYOPT, trim(COMP_NAME)//"_SHC_BUOY_OPTION:", default=2, RC=STATUS); VERIFY_(STATUS) end if call MAPL_GetResource (MAPL, PDFSHAPE, 'PDFSHAPE:', DEFAULT = 1.0 , RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (MAPL, DOPROGQT2, 'DOPROGQT2:', DEFAULT = 1 , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SL2TUNE, 'SL2TUNE:', DEFAULT = 3.0 , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, QT2TUNE, 'QT2TUNE:', DEFAULT = 6.0 , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, SLQT2TUNE, 'SLQT2TUNE:', DEFAULT = 6.0 , RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, QT3_TSCALE, 'QT3_TSCALE:', DEFAULT = 2400.0, RC=STATUS); VERIFY_(STATUS) - call MAPL_GetResource (MAPL, AFRC_TSCALE,'AFRC_TSCALE:',DEFAULT = 1800.0, RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SL2TUNE, 'SL2TUNE:', DEFAULT = 4.0 , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, QT2TUNE, 'QT2TUNE:', DEFAULT = 7.0 , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, SLQT2TUNE, 'SLQT2TUNE:', DEFAULT = 7.0 , RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, QT3_TSCALE, 'QT3_TSCALE:', DEFAULT = 1400.0, RC=STATUS); VERIFY_(STATUS) + call MAPL_GetResource (MAPL, AFRC_TSCALE,'AFRC_TSCALE:',DEFAULT = 1400.0, RC=STATUS); VERIFY_(STATUS) call MAPL_GetResource (MAPL, DOCANUTO, 'DOCANUTO:', DEFAULT = 0, RC=STATUS); VERIFY_(STATUS) ! Get pointers from export state... @@ -3183,6 +3288,16 @@ subroutine REFRESH(IM,JM,LM,RC) VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, ZLES, 'ZLES', RC=STATUS) VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, EDMF_PLUMES_W, 'EDMF_PLUMES_W', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, EDMF_PLUMES_QT, 'EDMF_PLUMES_QT', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, EDMF_PLUMES_THL, 'EDMF_PLUMES_THL', RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, edmf_dqrdt, 'EDMF_DQRDT', ALLOC=.true., RC=STATUS) + VERIFY_(STATUS) + call MAPL_GetPointer(EXPORT, edmf_dqsdt, 'EDMF_DQSDT', ALLOC=.true., RC=STATUS) + VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, edmf_buoyf, 'EDMF_BUOYF', RC=STATUS) VERIFY_(STATUS) ! call MAPL_GetPointer(EXPORT, edmf_sl2, 'EDMF_SL2', RC=STATUS) @@ -3431,10 +3546,12 @@ subroutine REFRESH(IM,JM,LM,RC) ! number of updrafts call MAPL_GetResource (MAPL, MFPARAMS%NUP, "EDMF_NUMUP:", default=10, RC=STATUS) ! boundaries for the updraft area (min/max sigma of w pdf) - call MAPL_GetResource (MAPL, MFPARAMS%PWMIN, "EDMF_PWMIN:", default=1.3, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%PWMIN, "EDMF_PWMIN:", default=1., RC=STATUS) call MAPL_GetResource (MAPL, MFPARAMS%PWMAX, "EDMF_PWMAX:", default=3., RC=STATUS) ! - call MAPL_GetResource (MAPL, MFPARAMS%ENTWFAC, "EDMF_ENTWFAC:", default=0.333, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%ENTUFAC, "EDMF_ENTUFAC:", default=1.2, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%WA, "EDMF_WA:", default=1.0, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%WB, "EDMF_WB:", default=1.5, RC=STATUS) ! coefficients for surface forcing, appropriate for L137 call MAPL_GetResource (MAPL, MFPARAMS%AlphaW, "EDMF_ALPHAW:", default=0.05, RC=STATUS) call MAPL_GetResource (MAPL, MFPARAMS%AlphaQT, "EDMF_ALPHAQT:", default=0.5, RC=STATUS) @@ -3443,20 +3560,22 @@ subroutine REFRESH(IM,JM,LM,RC) call MAPL_GetResource (MAPL, MFPARAMS%ET, "EDMF_ET:", default=2, RC=STATUS) ! constant entrainment rate call MAPL_GetResource (MAPL, MFPARAMS%ENT0, "EDMF_ENT0:", default=0.25, RC=STATUS) - call MAPL_GetResource (MAPL, MFPARAMS%ENT0LTS, "EDMF_ENT0LTS:", default=0.75, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%ENT0LTS, "EDMF_ENT0LTS:", default=1.5, RC=STATUS) ! L0 if ET==1 call MAPL_GetResource (MAPL, MFPARAMS%L0, "EDMF_L0:", default=100., RC=STATUS) ! L0fac if ET==2 call MAPL_GetResource (MAPL, MFPARAMS%L0fac, "EDMF_L0FAC:", default=10., RC=STATUS) - call MAPL_GetResource (MAPL, MFPARAMS%MFLIMFAC, "EDMF_MFLIMFAC:", default=3.5, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%MFLIMFAC, "EDMF_MFLIMFAC:", default=2.5, RC=STATUS) ! factor to multiply the eddy-diffusivity with call MAPL_GetResource (MAPL, MFPARAMS%EDfac, "EDMF_EDFAC:", default=1., RC=STATUS) call MAPL_GetResource (MAPL, MFPARAMS%DOCLASP, "EDMF_DOCLASP:", default=0, RC=STATUS) call MAPL_GetResource (MAPL, MFPARAMS%ICE_RAMP, "EDMF_ICE_RAMP:", default=-40.0, RC=STATUS ) call MAPL_GetResource (MAPL, MFPARAMS%ENTRAIN, "EDMF_ENTRAIN:", default=0, RC=STATUS) call MAPL_GetResource (MAPL, MFPARAMS%STOCHFRAC, "EDMF_STOCHASTIC:", default=0.5, RC=STATUS) - call MAPL_GetResource (MAPL, MFPARAMS%DISCRETE, "EDMF_DISCRETE_TYPE:", default=0, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%DISCRETE, "EDMF_DISCRETE_TYPE:", default=1, RC=STATUS) call MAPL_GetResource (MAPL, MFPARAMS%IMPLICIT, "EDMF_IMPLICIT:", default=1, RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%PRCPCRIT, "EDMF_PRCPCRIT:", default=-1., RC=STATUS) + call MAPL_GetResource (MAPL, MFPARAMS%UPABUOYDEP,"EDMF_UPABUOYDEP:", default=1, RC=STATUS) ! Future options ! call MAPL_GetResource (MAPL, EDMF_THERMAL_PLUME, "EDMF_THERMAL_PLUME:", default=0, RC=STATUS) @@ -3529,7 +3648,7 @@ subroutine REFRESH(IM,JM,LM,RC) ! bstar_scm = (MAPL_GRAV/(RHOS*sqrt(CM*max(UU,1.e-30)/RHOS))) * & ! (CT*(TH-TA-(MAPL_GRAV/MAPL_CP)*DZ)/TA + MAPL_VIREPS*CQ*(QH-QA)) - ustar => ustar_scm +! ustar => ustar_scm sh => sh_scm evap => evap_scm @@ -3604,6 +3723,7 @@ subroutine REFRESH(IM,JM,LM,RC) buoyf, & edmf_mf, & ! needed for ADG PDF edmfdrya, edmfmoista, & ! outputs for ADG PDF + edmf_dqrdt, edmf_dqsdt, & ! output for micro !== Diagnostics, not used elsewhere == edmf_dry_w, & edmf_moist_w, & @@ -4908,6 +5028,18 @@ subroutine DIFFUSE(IM,JM,LM,RC) real, dimension(:,:), pointer :: SHOBS, LHOBS +! Sea Spray + real, dimension(:,:), pointer :: SH_SPRAY_ => NULL() + real, dimension(:,:), pointer :: LH_SPRAY_ => NULL() + real, dimension(IM,JM) :: SH_SPRAY + real, dimension(IM,JM) :: LH_SPRAY + + real, parameter :: SH_SPRAY_MIN = -500.0 + real, parameter :: SH_SPRAY_MAX = 500.0 + real, parameter :: LH_SPRAY_MIN = -500.0 + real, parameter :: LH_SPRAY_MAX = 500.0 + + ! Get info for idealized SCM surface layer call MAPL_GetResource(MAPL, SCM_SL, 'SCM_SL:', default=0, RC=STATUS) VERIFY_(STATUS) @@ -4942,6 +5074,23 @@ subroutine DIFFUSE(IM,JM,LM,RC) call ESMF_StateGet(IMPORT, 'TR' , TR, RC=STATUS); VERIFY_(STATUS) call ESMF_StateGet(IMPORT, 'TRG', TRG, RC=STATUS); VERIFY_(STATUS) + if (DO_WAVES/=0 .and. DO_SEA_SPRAY/=0) then + call MAPL_GetPointer(IMPORT, SH_SPRAY_, 'SHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + + call MAPL_GetPointer(IMPORT, LH_SPRAY_, 'LHFX_SPRAY', RC=STATUS) + VERIFY_(STATUS) + + SH_SPRAY = SH_SPRAY_ + LH_SPRAY = LH_SPRAY_ + + where (SH_SPRAY < SH_SPRAY_MIN) SH_SPRAY = SH_SPRAY_MIN + where (SH_SPRAY > SH_SPRAY_MAX) SH_SPRAY = SH_SPRAY_MAX + + where (LH_SPRAY < LH_SPRAY_MIN) LH_SPRAY = LH_SPRAY_MIN + where (LH_SPRAY > LH_SPRAY_MAX) LH_SPRAY = LH_SPRAY_MAX + end if + call ESMF_StateGet(EXPORT, 'TRI', TRI, RC=STATUS); VERIFY_(STATUS) call ESMF_StateGet(EXPORT, 'FSTAR', FSTAR, RC=STATUS); VERIFY_(STATUS) call ESMF_StateGet(EXPORT, 'DFSTAR', DFSTAR, RC=STATUS); VERIFY_(STATUS) @@ -5147,6 +5296,16 @@ subroutine DIFFUSE(IM,JM,LM,RC) end if end if + if (DO_WAVES /= 0 .and. DO_SEA_SPRAY /= 0) then + if (NAME == 'S') then + SF = SF + SH_SPRAY + end if + + if (NAME == 'Q') then + SF = SF + LH_SPRAY/MAPL_ALHL + end if + end if + ! Create tendencies !------------------ @@ -5158,6 +5317,16 @@ subroutine DIFFUSE(IM,JM,LM,RC) endif end if + if (DO_WAVES /= 0 .and. DO_SEA_SPRAY /= 0) then + if (NAME == 'S') then + SX(:,:,LM) = SX(:,:,LM) + (SH_SPRAY/(DP(:,:,LM)/MAPL_GRAV))*DT + end if + + if (NAME == 'Q') then + SX(:,:,LM) = SX(:,:,LM) + (LH_SPRAY/(MAPL_ALHL*DP(:,:,LM)/MAPL_GRAV))*DT + end if + end if + if( NAME=='S' ) then SINC = ( (SX - S)/DT ) end if @@ -5991,7 +6160,7 @@ subroutine UPDATE(IM,JM,LM,LATS,RC) tmp3d(:,:,1:LM-1) = -1.*TKH(:,:,1:LM-1)*tmp3d(:,:,1:LM-1) tmp3d(:,:,LM) = tmp3d(:,:,LM-1) tmp3d(:,:,0) = 0.0 - if (associated(QTFLXMF)) then + if (associated(QTFLXMF).and.MFPARAMS%IMPLICIT.eq.1) then QTFLXMF(:,:,1:LM-1) = QTFLXMF(:,:,1:LM-1)-MFAW(:,:,1:LM-1)*QT(:,:,1:LM-1) QTFLXMF(:,:,LM) = QTFLXMF(:,:,LM-1) QTFLXMF(:,:,0) = 0. @@ -6004,9 +6173,9 @@ subroutine UPDATE(IM,JM,LM,LATS,RC) tmp3d(:,:,1:LM-1) = -1.*TKH(:,:,1:LM-1)*tmp3d(:,:,1:LM-1) tmp3d(:,:,LM) = tmp3d(:,:,LM-1) tmp3d(:,:,0) = 0.0 - if (associated(SLFLXMF)) then + if (associated(SLFLXMF).and.MFPARAMS%IMPLICIT.eq.1) then SLFLXMF(:,:,1:LM-1) = SLFLXMF(:,:,1:LM-1)-MFAW(:,:,1:LM-1)*SL(:,:,1:LM-1)/MAPL_CP - SLFLXMF(:,:,LM) = 0. + SLFLXMF(:,:,LM) = SLFLXMF(:,:,LM-1) SLFLXMF(:,:,0) = 0. end if if (associated(SLFLXTRB)) SLFLXTRB = tmp3d/MAPL_CP + SLFLXMF diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 index 5c3260617..5063baa04 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/edmf.F90 @@ -32,10 +32,11 @@ module edmf_mod integer :: TEST integer :: DEBUG integer :: ET + integer :: UPABUOYDEP real :: L0 real :: L0fac real :: STOCHFRAC - real :: ENTWFAC + real :: ENTUFAC real :: EDFAC real :: ENT0 real :: ENT0LTS @@ -53,6 +54,7 @@ module edmf_mod real :: C_KH_MF real :: MFLIMFAC real :: ICE_RAMP + real :: PRCPCRIT endtype EDMFPARAMS_TYPE type (EDMFPARAMS_TYPE) :: MFPARAMS @@ -104,6 +106,8 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs edmfmf, & dry_a3, & moist_a3, & + dqrdt, & + dqsdt, & ! Diagnostic outputs - updraft properties dry_w3, & moist_w3, & @@ -166,7 +170,7 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs mftke REAL,DIMENSION(ITS:ITE,JTS:JTE,KTS:KTE), INTENT(OUT) :: buoyf,mfw2,mfw3,mfqt3,mfhl3,&!mfqt2,mfhl2,& - mfhlqt + mfhlqt,dqrdt,dqsdt ! Diagnostic outputs @@ -195,10 +199,10 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs INTEGER :: K,I,IH,JH,NUP2 REAL :: wthv,wstar,qstar,thstar,sigmaW,sigmaQT,sigmaTH,z0, & wmin,wmax,wlv,wtv,wp - REAL :: B,QTn,THLn,THVn,QCn,Un,Vn,Wn2,EntEXP,EntEXPU,EntW,wf + REAL :: B,QTn,THLn,THVn,QCn,QP,Un,Vn,Wn2,EntEXP,EntEXPU,EntW,wf ! internal flipped variables (GEOS5) - REAL,DIMENSION(KTS:KTE) :: U,V,THL,QT,THV,QV,QL,QI,ZLO + REAL,DIMENSION(KTS:KTE) :: U,V,THL,QT,THV,QV,QL,QI,ZLO,QR,QS REAL,DIMENSION(KTS-1:KTE) :: ZW,P,THLI,QTI REAL,DIMENSION(KTS-1:KTE) :: UI, VI, QVI, QLI, QII @@ -216,14 +220,14 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs REAL,DIMENSION(KTS-1:KTE) :: exfh,tmp1d REAL,DIMENSION(KTS-1:KTE) :: rhoe - REAL :: L0,ztop,tmp,ltm,MFsrf,QTsrfF,THVsrfF,mft,mfthvt,mf,factor,lts + REAL :: L0,ztop,tmp,tmp2,ltm,MFsrf,QTsrfF,THVsrfF,mft,mfthvt,mf,factor,lts INTEGER, DIMENSION(2) :: seedmf,the_seed LOGICAL :: calc_avg_diag ! velocity equation parameters - REAL,PARAMETER :: Wa=1., & ! buoyancy term - Wb=1.5 ! entrainment term +! REAL,PARAMETER :: Wa=1., & ! buoyancy term +! Wb=1.5 ! entrainment term ! Wa=1., & ! original ! Wb=1.5 @@ -284,6 +288,8 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs mfwhl =0. mftke =0. edmfmf=0. + dqrdt =0. + dqsdt =0. ! mfqt2 =0. ! mfhl2 =0. @@ -307,7 +313,8 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs ! if CLASP enabled: mass flux is input ! if CLASP disabled: mass-flux if positive surface buoyancy flux and ! TKE at 2nd model level above threshold - IF ( (wthv > 0.0 .and. TKE3(IH,JH,kte-1)>0.01 .and. MFPARAMS%doclasp==0 .and. phis(IH,JH).lt.2e4) & +! IF ( (wthv > 0.0 .and. TKE3(IH,JH,kte-1)>0.01 .and. MFPARAMS%doclasp==0 .and. phis(IH,JH).lt.2e4) & + IF ( (wthv > 0.0 .and. MFPARAMS%doclasp==0 .and. phis(IH,JH).lt.2e4) & .or. (any(mfsrcthl(IH,JH,1:MFPARAMS%NUP) >= -2.0) .and. MFPARAMS%doclasp/=0)) then ! print *,'wthv=',wthv,' wqt=',wqt,' wthl=',wthl,' edmfdepth=',edmfdepth(IH,JH) @@ -328,6 +335,8 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs UPQI=0. UPQL=0. ENT=0. + QR = 0. + QS = 0. ! Estimate scale height for entrainment calculation if (mfparams%ET == 2 ) then @@ -433,6 +442,8 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs do k=kts,kte ENT(k,i) = (1.-MFPARAMS%STOCHFRAC) * MFPARAMS%Ent0/L0 & + MFPARAMS%STOCHFRAC * real(ENTi(k,i))*MFPARAMS%Ent0/(ZW(k)-ZW(k-1)) + ! Increase ent above 2000m to limit deepest plumes + if (ZW(k).gt.2500.) ENT(k,i) = ENT(k,i)*(1.+(ZW(k)-2500.)/500.) enddo enddo else if (MFPARAMS%ENTRAIN==1 ) then @@ -464,7 +475,7 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs ! wstar=max(wstarmin,(mapl_grav*wthv*pblh/300.)**(1./3.)) ! convective velocity scale qstar=max(0.,wqt)/wstar - thstar=max(0.01,wthv)/wstar + thstar=max(0.,wthl)/wstar sigmaW=MFPARAMS%AlphaW*wstar sigmaQT=MFPARAMS%AlphaQT*qstar @@ -489,7 +500,12 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs UPA(kts-1,I)=MFAREA(IH,JH,I) !0.5*(ERF(3.0/sqrt(2.))-ERF(1.0/sqrt(2.)))/real(NUP) ! assume equal size for now else UPW(kts-1,I)=min(0.5*(wlv+wtv), 5.) - UPA(kts-1,I)=MIN(1.0,0.5+wthv/0.2)*(0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW))) + if (MFPARAMS%UPABUOYDEP/=0) then +! UPA(kts-1,I)=MIN(1.0,0.5+wthv/0.2)*(0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW))) + UPA(kts-1,I)=(0.5+0.5*TANH((wthv-0.02)/0.09))*(0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW))) + else + UPA(kts-1,I)=(0.5*ERF(wtv/(sqrt(2.)*sigmaW))-0.5*ERF(wlv/(sqrt(2.)*sigmaW))) + end if end if UPU(kts-1,I)=U(kts) @@ -499,12 +515,12 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs UPQT(kts-1,I)=QT(kts)+MFSRCQT(IH,JH,I) UPTHV(kts-1,I)=THV(kts)+MFSRCTHL(IH,JH,I) else - UPQT(kts-1,I)=QT(kts)-(-1.**I)*0.32*UPW(kts-1,I)*sigmaQT/sigmaW -! UPQT(kts-1,I)=QT(kts)+0.32*UPW(kts-1,I)*sigmaQT/sigmaW +! UPQT(kts-1,I)=QT(kts)-(-1.**I)*0.32*UPW(kts-1,I)*sigmaQT/sigmaW + UPQT(kts-1,I)=QT(kts)+0.32*UPW(kts-1,I)*sigmaQT/sigmaW UPTHV(kts-1,I)=THV(kts)+0.58*UPW(kts-1,I)*sigmaTH/sigmaW end if - ENDDO + ENDDO ! NUP ! ! If needed, rescale UPW to ensure that the mass-flux does not exceed layer mass @@ -568,7 +584,7 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs end if EntExp = exp(-ENT(K,I)*(ZW(k)-ZW(k-1))) - EntExpU = exp(-ENT(K,I)*(ZW(k)-ZW(k-1))*MFPARAMS%EntWFac) + EntExpU = exp(-ENT(K,I)*(ZW(k)-ZW(k-1))*MFPARAMS%EntUFac) ! Effect of mixing on thermodynamic variables in updraft QTn = QT(K)*(1-EntExp)+UPQT(K-1,I)*EntExp @@ -579,14 +595,24 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs ! Calculate condensation call condensation_edmf(QTn,THLn,P(K),THVn,QCn,wf,mfparams%ice_ramp) + ! Calculate and remove precipitation + if (MFPARAMS%PRCPCRIT.gt.0.) then + QP = max(0.,QCn-MFPARAMS%PRCPCRIT) + QCn = QCn - QP + QTn = QTn - QP + THLn = THLn + (MAPL_ALHL*wf+(1.-wf)*MAPL_ALHS)/mapl_cp*QP/EXFH(k) + QR(K) = QR(K) + UPA(K-1,I)*QP*wf + QS(K) = QS(K) + UPA(K-1,I)*QP*(1.-wf) + end if + ! vertical velocity B=mapl_grav*(0.5*(THVn+UPTHV(k-1,I))/THV(k)-1.) - WP=Wb*ENT(K,I) + WP=MFPARAMS%WB*ENT(K,I) IF (WP==0.) THEN - Wn2=UPW(K-1,I)**2+2.*Wa*B*(ZW(k)-ZW(k-1)) + Wn2=UPW(K-1,I)**2+2.*MFPARAMS%WA*B*(ZW(k)-ZW(k-1)) ELSE EntW=exp(-2.*WP*(ZW(k)-ZW(k-1))) - Wn2=EntW*UPW(k-1,I)**2+Wa*B/WP*(1.-EntW) + Wn2=EntW*UPW(k-1,I)**2+MFPARAMS%WA*B/WP*(1.-EntW) END IF IF (Wn2>0.) THEN @@ -609,14 +635,23 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs ! Near-surface CFL: To prevent instability, rescale updraft velocities ! if mass flux exceeds MFLIMFAC times the layer mass - if (ZW(k)<300.) then - mf = SUM(RHOE(k)*UPA(k,:)*UPW(k,:)) - factor = (1.+(MFPARAMS%MFLIMFAC-1.)*(ZW(k)/300.))*dp(K)/(1e-8+mf*MAPL_GRAV*dt) - if (factor .lt. 1.0) then - UPW(k,:) = UPW(k,:)*factor - ! print *,'rescaling UPW by factor: ',factor - end if - end if +! if (ZW(k)<300.) then +! mf = SUM(RHOE(k)*UPA(k,:)*UPW(k,:)) +! factor = (2.+(MFPARAMS%MFLIMFAC-2.)*(ZW(k)/300.))*dp(K)/(1e-8+mf*MAPL_GRAV*dt) +! if (factor .lt. 1.0) then +! UPW(k,:) = UPW(k,:)*factor +! ! print *,'rescaling UPW by factor: ',factor +! end if +! end if + +! if (ZW(k)<100.) then +! mf = SUM(RHOE(k)*UPA(k,:)*UPW(k,:)) +! factor = (1.5+(MFPARAMS%MFLIMFAC-1.5)*(ZW(k)/100.))*dp(K)/(1e-8+mf*MAPL_GRAV*dt) +! if (factor .lt. 1.0) then +! UPW(k,:) = UPW(k,:)*factor +! ! print *,'rescaling UPW by factor: ',factor +! end if +! end if ! loop over vertical ENDDO vertint @@ -646,20 +681,36 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs ENDDO ! if (factor.ne.1.0) print *,'*** CFL rescale by factor: ',factor UPA = factor*UPA + QR = factor*QR + QS = factor*QS + + ! Rescale UPA if MF TKE more than half of prognostic TKE near surface + ! Prevents instability due to MF without KH + K = KTS + tmp = 0. + tmp2 = 0. + DO WHILE (ZW(K).lt.70. .and. K.lt.KTE) + tmp = tmp + 0.5*SUM(UPA(K,:)*UPW(K,:)*UPW(K,:)) + tmp2 = tmp2 + TKE3(IH,JH,KTE-K+KTS) +! UPW(K,:) = UPW(K,:)*exp(-(100.-ZW(K))**2/1e4) + K = K+1 + END DO + if (tmp.gt.0.5*tmp2) then + UPA = UPA*(0.5*tmp2/tmp) + QR = QR*(0.5*tmp2/tmp) + QS = QS*(0.5*tmp2/tmp) + end if DO k=KTS,KTE edmfmf(IH,JH,KTE-k+KTS-1) = rhoe(K)*SUM(upa(K,:)*upw(K,:)) ENDDO - + DQRDT(IH,JH,KTS:KTE) = QR(KTE:KTS:-1)/DT + DQSDT(IH,JH,KTS:KTE) = QS(KTE:KTS:-1)/DT ! ! writing updraft properties for output ! all variables, except Areas are now multipled by the area ! - if (associated(EDMF_PLUMES_W)) EDMF_PLUMES_W(IH,JH,KTS-1:KTE,:) = upw(KTE:KTS-1:-1,:) - if (associated(EDMF_PLUMES_THL)) EDMF_PLUMES_THL(IH,JH,KTS-1:KTE,:) = upthl(KTE:KTS-1:-1,:) - if (associated(EDMF_PLUMES_QT)) EDMF_PLUMES_QT(IH,JH,KTS-1:KTE,:) = upqt(KTE:KTS-1:-1,:) - dry_a = 0. moist_a = 0. @@ -856,12 +907,22 @@ SUBROUTINE RUN_EDMF(its,ite, jts,jte, kts,kte, dt, & ! Inputs ! mfqt2(IH,JH,K)=0.5*(s_aqt2(KTE+KTS-K-1)+s_aqt2(KTE+KTS-K)) ! no longer needed ENDDO + + where (UPA.eq.0.) + UPW = MAPL_UNDEF + UPTHL = MAPL_UNDEF + UPQT = MAPL_UNDEF + end where + if (associated(EDMF_PLUMES_W)) EDMF_PLUMES_W(IH,JH,KTS-1:KTE,:) = upw(KTE:KTS-1:-1,:) + if (associated(EDMF_PLUMES_THL)) EDMF_PLUMES_THL(IH,JH,KTS-1:KTE,:) = upthl(KTE:KTS-1:-1,:) + if (associated(EDMF_PLUMES_QT)) EDMF_PLUMES_QT(IH,JH,KTS-1:KTE,:) = upqt(KTE:KTS-1:-1,:) + + END IF ! IF ( wthv > 0.0 ) ENDDO ! JH loop over horizontal area ENDDO ! IH - END SUBROUTINE run_edmf diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 index 438fea430..3f3e1d0bd 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSturbulence_GridComp/shoc.F90 @@ -59,7 +59,8 @@ subroutine run_shoc( nx, ny, nzm, nz, dtn, & ! in tkesbshear_inv, & ! out smixt_inv, lmix_out, smixt1_inv, & ! out smixt2_inv,smixt3_inv, & ! out - bruntmst_inv, ri_inv, prnum_inv, & ! out +! bruntmst_inv, bruntedg_inv, ri_inv, prnum_inv, & ! out + bruntmst_inv, ri_inv, prnum_inv, & ! out shocparams ) @@ -117,6 +118,7 @@ subroutine run_shoc( nx, ny, nzm, nz, dtn, & ! in real, dimension(:,:,:), pointer :: smixt2_inv ! length scale, term 2 real, dimension(:,:,:), pointer :: smixt3_inv ! length scale, term 3 real, dimension(:,:,:), pointer :: bruntmst_inv ! moist Brunt vaisala frequency +! real, dimension(:,:,:), pointer :: bruntedg_inv ! Brunt vaisala frequency on edges real, dimension(:,:,:), pointer :: ri_inv real, dimension(:,:,:), pointer :: prnum_inv @@ -183,16 +185,17 @@ subroutine run_shoc( nx, ny, nzm, nz, dtn, & ! in real, dimension(nx,ny,nzm) :: total_water, brunt2, def2, thv, brunt_smooth real, dimension(nx,ny,nz) :: brunt_edge - real, dimension(nx,ny) :: l_inf, l_mix, zcb, l_par!, denom, numer, cldarr + real, dimension(nx,ny) :: l_inf, l_mix, zcb, lts!, l_par!, denom, numer, cldarr - real lstarn, depth, omn, betdz, bbb, & + real lstarn, depth, omn, betdz, betdze, bbb, & term, qsatt, dqsat, thedz, conv_var, & tkes, pval, pkap, thlsec, qwsec, & qwthlsec, wqwsec, wthlsec, dum, sm, & prespot, wrk, wrk1, wrk2, wrk3, & - tkeavg, dtqw, dtqi + tkeavg, dtqw, dtqi, l_par integer i,j,k,km1,ku,kd,ka,kb,kinv,strt,fnsh,cnvl + integer, dimension(nx,ny) :: cldbasek real, parameter :: bruntmin = 1e-7 real, parameter :: vonk = 0.4 @@ -303,7 +306,8 @@ subroutine run_shoc( nx, ny, nzm, nz, dtn, & ! in if (associated(smixt2_inv)) smixt2_inv(:,:,1:nzm) = smixt2(:,:,nzm:1:-1) if (associated(smixt3_inv)) smixt3_inv(:,:,1:nzm) = smixt3(:,:,nzm:1:-1) - if (associated(bruntmst_inv)) bruntmst_inv(:,:,1:nzm) = brunt_edge(:,:,nzm:1:-1) +! if (associated(bruntedg_inv)) bruntedg_inv(:,:,0:nzm) = brunt_edge(:,:,nz:1:-1) + if (associated(bruntmst_inv)) bruntmst_inv(:,:,1:nzm) = brunt(:,:,nzm:1:-1) if (associated(prnum_inv)) prnum_inv(:,:,0:nz-1) = prnum(:,:,nz:1:-1) if (associated(ri_inv)) ri_inv(:,:,0:nz-1) = ri(:,:,nz:1:-1) @@ -317,7 +321,7 @@ subroutine tke_shoc() ! This subroutine solves the TKE equation, ! Heavily based on SAM's tke_full.f90 by Marat Khairoutdinov - real grd,betdz,Cek,Cee,lstarn, bbb, omn, omp,qsatt,dqsat, smix, & + real grd,betdz,betdze,Cek,Cee,lstarn, bbb, omn, omp,qsatt,dqsat, smix, & buoy_sgs,a_prod_sh,a_prod_bu,a_diss,a_prod_bu_debug, buoy_sgs_debug, & wrk, wrk1, wtke, wtk2, rdtn, tke_env integer i,j,k,ku,kd,itr @@ -385,7 +389,11 @@ subroutine tke_shoc() Cee = Cek* (pt19 + pt51*smix/grd) wrk = 0.5 * wrk * (prnum(i,j,ku) + prnum(i,j,kd)) - a_prod_sh = min(min(tkhmax,(wrk+0.0001))*def2(i,j,k),0.1) ! TKE shear production term + if (nx.eq.1) then + a_prod_sh = min(min(tkhmax,wrk)*def2(i,j,k),0.0001) ! TKE shear production term + else + a_prod_sh = min(min(tkhmax,wrk)*def2(i,j,k),0.01) ! TKE shear production term + end if ! Semi-implicitly integrate TKE equation forward in time wtke = tke(i,j,k) @@ -438,6 +446,9 @@ subroutine tke_shoc() isotropy(i,j,k) = max(30.,min(max_eddy_dissipation_time_scale,wrk/(1.0+lambda*brunt_edge(i,j,k)*wrk*wrk))) ! isotropy(i,j,k) = max(30.,min(max_eddy_dissipation_time_scale,wrk/(1.0+lambda*0.5*(brunt(i,j,k)+brunt(i,j,k-1))*wrk*wrk))) endif +! if (k.ge.cldbasek(i,j)) then +! isotropy(i,j,k) = min(200.+(0.5+0.5*tanh(0.3*(lts(i,j)-19.)))*(max_eddy_dissipation_time_scale-200.),isotropy(i,j,k)) +! end if if (tke(i,j,k).lt.2e-4) isotropy(i,j,k) = 30. wrk1 = ck / prnum(i,j,k) @@ -446,15 +457,8 @@ subroutine tke_shoc() ! + smixt(i,j,k-1)*sqrt(tke(i,j,k-1)) ) tke_env = max(min_tke,0.5*(tke(i,j,k)+tke(i,j,k-1))-tke_mf(i,j,nz-k+1)) -! if (brunt(i,j,k).gt.2e-4) then -! tkh(i,j,k) = wrk1*min(isotropy(i,j,k),isotropy(i,j,k-1)) & - tkh(i,j,k) = wrk1*isotropy(i,j,k) & + tkh(i,j,k) = wrk1*isotropy(i,j,k) & * 1.*(tke_env) ! remove MF TKE -! else -! tkh(i,j,k) = 0.5*wrk1*(isotropy(i,j,k) + isotropy(i,j,k-1)) & -! *(tke_env) ! remove MF TKE -! * (tke(i,j,k)+tke(i,j,k-1)) ! use total TKE -! end if tkh(i,j,k) = min(tkh(i,j,k),tkhmax) end do ! i end do ! j @@ -487,7 +491,7 @@ subroutine calc_numbers() DU = (U(:,:,1:nzm-1) - U(:,:,2:nzm))**2 + & ! shear on edges (V(:,:,1:nzm-1) - V(:,:,2:nzm))**2 - DU = MAX( SQRT(DU) / adzi(:,:,1:nzm-1), 0.003 ) + DU = MAX( SQRT(DU) / adzi(:,:,1:nzm-1), 0.005 ) RI = 0.0 RI(:,:,2:nz-1) = ggr*( (THV(:,:,2:nzm) - THV(:,:,1:nzm-1)) / adzi(:,:,1:nzm-1) ) & @@ -495,14 +499,14 @@ subroutine calc_numbers() if (SHOCPARAMS%PRNUM.lt.0.) then ! where (RI.le.0. .or. tke_mf(:,:,nz:1:-1).gt.1e-6) - where (RI.le.0. .or. tke_mf(:,:,nz:1:-1).gt.0.01) - PRNUM = 0.9 + where (RI.le.0. .or. tke_mf(:,:,nz:1:-1).gt.1e-4) + PRNUM = -1.*SHOCPARAMS%PRNUM elsewhere ! He et al 2019 ! tmp3de = RI*(1.+6.*RI) ! PRNUM = (0.9+4.*tmp3de*SQRT(1.-SHOCPARAMS%PRNUM*8.*tmp3de/3.))/(1.+4.*tmp3de) ! Han and Bretherton 2019 - PRNUM = 0.9+2.1*MIN(10.,RI) ! limit RI to avoid instability + PRNUM = -1.*SHOCPARAMS%PRNUM+2.1*MIN(10.,RI) ! limit RI to avoid instability end where else PRNUM = SHOCPARAMS%PRNUM @@ -619,7 +623,8 @@ subroutine eddy_length() endif betdz = bet(i,j,k) / thedz - brunt_edge(i,j,k) = (2.*ggr/(thv(i,j,k)+thv(i,j,kb)))*(thv(i,j,k)-thv(i,j,kb))/adzi(i,j,k) !g/thv/dz *(thv-thv) + +! brunt_edge(i,j,k) = (2.*ggr/(thv(i,j,k)+thv(i,j,kb)))*(thv(i,j,k)-thv(i,j,kb))/adzi(i,j,k) !g/thv/dz *(thv-thv) ! Reinitialize the mixing length related arrays to zero smixt(i,j,k) = 1.0 ! shoc_mod module variable smixt @@ -641,10 +646,10 @@ subroutine eddy_length() enddo enddo enddo - - +! brunt_edge(:,:,nz) = brunt_edge(:,:,nzm) ! Calculate the measure of PBL depth, Eq. 11 in BK13 (Is this really PBL depth?) + cldbasek(:,:) = 1 do j=1,ny do i=1,nx @@ -664,18 +669,30 @@ subroutine eddy_length() ! Identify mixed layer top as level where THV exceeds THV(3) + 0.4 K ! Interpolate for final height based on gradient + ! Ignore single isolated levels kk = 4 - do while (thv(i,j,3)+0.4 .gt. thv(i,j,kk)) + do while (thv(i,j,3)+0.4 .gt. thv(i,j,kk) .or. thv(i,j,3)+0.4 .gt. thv(i,j,kk+1)) kk = kk+1 end do dum = (thv(i,j,kk-1)-thv(i,j,kk-2)) if (abs(dum) .gt. 1e-3) then - l_mix(i,j) = min(max(zl(i,j,kk-1)+(thv(i,j,3)+0.4-thv(i,j,kk-1))*(zl(i,j,kk-1)-zl(i,j,kk-2))/dum,100.),1200.) + l_mix(i,j) = max(zl(i,j,kk-1)+(thv(i,j,3)+0.4-thv(i,j,kk-1))*(zl(i,j,kk-1)-zl(i,j,kk-2))/dum,100.) else - l_mix(i,j) = min(max(zl(i,j,kk-1),100.),1200.) + l_mix(i,j) = max(zl(i,j,kk-1),100.) end if + do while ((zl(i,j,cldbasek(i,j)).lt.300.) .or. (cld_sgs(i,j,cldbasek(i,j)).lt.0.001 .and. cldbasek(i,j).lt.nzm)) + cldbasek(i,j) = cldbasek(i,j) + 1 + end do +! print *,'cldbase=',zl(i,j,cldbasek(i,j)) + + kk = 1 + do while (zl(i,j,kk) .lt. 3000. .or. kk.eq.nzm) + kk = kk + 1 + end do + lts(i,j) = thv(i,j,kk) - thv(i,j,1) +! Alternate cloud base calculation ! tep = tabs(i,j,1) ! qsp = MAPL_EQsat(tabs(i,j,1),prsl(i,j,1),dtqw) ! kk = 1 @@ -709,13 +726,14 @@ subroutine eddy_length() kb = nzm-1 kc = nzm thedz = adzi(i,j,k) + betdze = 0.5*(bet(i,j,k)-bet(i,j,kb)) / adzi(i,j,k) else thedz = (adzi(i,j,kc)+adzi(i,j,k)) ! = (z(k+1)-z(k-1)) + betdze = 0.5*(bet(i,j,k)-bet(i,j,kb)) / adzi(i,j,k) endif betdz = bet(i,j,k) / thedz - ! Compute local Brunt-Vaisalla frequency wrk = qcl(i,j,k) + qci(i,j,k) @@ -753,6 +771,16 @@ subroutine eddy_length() + (bbb*fac_cond - (1.+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & + (bbb*fac_sub - (1.+fac_sub*dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) + bbb = 0.5*(bbb + (1. + epsv*qsatt-wrk-qpl(i,j,k-1)-qpi(i,j,k-1) & + + 1.61*tabs(i,j,k-1)*dqsat) / (1.+lstarn*dqsat) ) + if (k.gt.1) then + brunt_edge(i,j,k) = 0.5*(cld_sgs(i,j,k)+cld_sgs(i,j,k-1))*betdz*(bbb*(hl(i,j,k)-hl(i,j,k-1)) & + + (bbb*lstarn - (1.+lstarn*dqsat)*tabs(i,j,k)) & + * (total_water(i,j,k)-total_water(i,j,k-1)) & + + (bbb*fac_cond - (1.+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,k)-qpl(i,j,k-1)) & + + (bbb*fac_sub - (1.+fac_sub*dqsat)*tabs(i,j,k))*(qpi(i,j,k)-qpi(i,j,k-1)) ) + end if + ! Find outside-of-cloud Brunt-Vaisalla frequency ! Only unsaturated air, rain and snow contribute to virt. pot. temp. ! liquid/ice moist static energy divided by cp? @@ -763,6 +791,14 @@ subroutine eddy_length() + (bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & + (bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) + bbb = 0.5*(bbb + 1. + epsv*qv(i,j,k-1) - qpl(i,j,k-1) - qpi(i,j,k-1)) + if (k.gt.1) then + brunt_edge(i,j,k) = brunt_edge(i,j,k) + (1.-0.5*(cld_sgs(i,j,k)+cld_sgs(i,j,k-1)))*betdz*( bbb*(hl(i,j,k)-hl(i,j,k-1)) & + + epsv*tabs(i,j,k)*(total_water(i,j,k)-total_water(i,j,k-1)) & + + (bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,k)-qpl(i,j,k-1)) & + + (bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,k)-qpi(i,j,k-1)) ) + end if + ! Reduction of mixing length in the stable regions (where B.-V. freq. > 0) is required. ! Here we find regions of Brunt-Vaisalla freq. > 0 for later use. @@ -776,23 +812,15 @@ subroutine eddy_length() end do end do + brunt_edge(:,:,1) = brunt_edge(:,:,2) + brunt_edge(:,:,nz) = brunt_edge(:,:,nzm) ! brunt_dry = max( bruntmin, brunt_dry ) brunt_smooth = brunt brunt_smooth(:,:,nzm) = brunt(:,:,nzm-1) - brunt_smooth(:,:,1) = 0.333*(brunt(:,:,1)+brunt(:,:,2)+brunt(:,:,3)) ! use avg of lowest 3 levs - brunt_smooth(:,:,2) = brunt_smooth(:,:,1) - brunt_smooth(:,:,3) = brunt_smooth(:,:,1) - do kk = 2,nzm-1 ! smooth 3-layers of brunt freq to reduce influence of single layers -! brunt_smooth(:,:,kk) = brunt2(:,:,kk) -! where (brunt(:,:,kk+1).lt.1e-4) - brunt_smooth(:,:,kk) = 0.333*(brunt(:,:,kk-1)+brunt(:,:,kk)+brunt(:,:,kk+1)) -! brunt_smooth(:,:,kk) = 0.5*(brunt(:,:,kk)+brunt(:,:,kk+1)) ! smooth up only -! end where -! brunt_smooth(:,:,kk) = 0.333*brunt2(:,:,kk)+0.333*brunt2(:,:,kk+1)+0.334*brunt2(:,:,kk+2) ! level above, kk+1 - end do + brunt_smooth(:,:,1) = brunt(:,:,1) brunt_smooth = max( bruntmin, brunt_smooth ) @@ -808,43 +836,6 @@ subroutine eddy_length() ! Calculate turbulent length scale in the boundary layer. ! See Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) -! Keep the length scale adequately small near the surface following Blackadar (1984) -! Note that this is not documented in BK13 and was added later for SP-CAM runs - -! if (k == 1) then -! term = 600.*tkes -! smixt(i,j,k) = term + (0.4*zl(i,j,k)-term)*exp(-zl(i,j,k)*0.01) -! else - -! tscale is the eddy turnover time scale in the boundary layer and is -! an empirically derived constant - -! if ( shocparams%LENOPT==0 ) then -! wrk2 = (tscale*tkes*0.1*l_inf(i,j)) -! end if - -! if (shocparams%LENOPT==1 ) then -! kk=k -! if (brunt_smooth(i,j,k).le.1.e-6 ) then -! do while (brunt_smooth(i,j,kk).le.1.e-6 .and. kk.lt.nzm) -! kk=kk+1 -! end do -! ktop=kk -! kk=k -! do while (brunt_smooth(i,j,kk).le.1.e-6 .and. kk.gt.1) -! kk=kk-1 -! end do -! l_inf(i,j) = max(50.,min(1000.,zl(i,j,ktop)-zl(i,j,kk) )) -! else -! l_inf(i,j) = 50. -! end if -! -! if (zl(i,j,k).lt.zcb(i,j)) then -! wrk2 = (tscale*tkes*0.2*zcb(i,j)) -! else -! wrk2 = (tscale*tkes*0.05*l_inf(i,j)) -! end if -! end if !---------------------------------- ! calculate parcel mixing length @@ -868,35 +859,44 @@ subroutine eddy_length() ! if (brunt_smooth(i,j,k).gt.1e-5) l_par(i,j) = max(25.,l_par(i,j)/2.) ! wrk2 = (tscale*tkes*0.1*l_par(i,j)) - !------------------------- - ! combine SHOC length scales - !------------------------- - if ( shocparams%LENOPT .eq. 0 ) then ! SHOC classic length scale - - else if ( shocparams%LENOPT .lt. 4 ) then ! SHOC-MF length scale - - smixt1(i,j,k) = vonk*zl(i,j,k)*exp(MIN(1000.,zl(i,j,k))**2/4e4)*shocparams%LENFAC1 + !---------------------------------- + ! calculate 'TKE' mixing length + !---------------------------------- +! l_mix(i,j) = 0. +! kinv = k +! do while (tke(i,j,kinv).gt.0.02) +! l_mix(i,j) = l_mix(i,j) + adzl(i,j,kinv) +! kinv = kinv+1 +! end do +! kinv = k-1 +! do while (tke(i,j,kinv).gt.0.02) +! l_mix(i,j) = l_mix(i,j) + adzl(i,j,kinv) +! kinv = kinv-1 +! end do +! l_mix(i,j) = 0.1*l_mix(i,j) + + + if ( shocparams%LENOPT .lt. 4 ) then ! SHOC-MF length scale + + ! Surface length scale +! smixt1(i,j,k) = vonk*zl(i,j,k)*exp(MIN(1000.,zl(i,j,k))**2/4e4)*shocparams%LENFAC1 + smixt1(i,j,k) = vonk*zl(i,j,k)*shocparams%LENFAC1 ! smixt1(i,j,k) = sqrt(400.*tkes*vonk*zl(i,j,k))*shocparams%LENFAC1 - if (zl(i,j,k).lt.min(1200.,zpbl(i,j))) then -! if (zl(i,j,k).lt.l_mix(i,j)) then - smixt2(i,j,k) = sqrt(min(1200.,zpbl(i,j))*400.*tkes)*shocparams%LENFAC2 -! smixt2(i,j,k) = sqrt(min(1200.,l_mix(i,j))*400.*tkes)*shocparams%LENFAC2 + ! Turbulent length scale + if (zl(i,j,k).lt.l_mix(i,j)) then +! smixt2(i,j,k) = sqrt(0.1*zpbl(i,j)*400.*tkes)*shocparams%LENFAC2 + smixt2(i,j,k) = sqrt(min(1000.,l_mix(i,j))*400.*tkes)*(shocparams%LENFAC2) else smixt2(i,j,k) = 400.*tkes*shocparams%LENFAC2 end if - ! Kludgey adjustment to increase StCu by reducing L3 at cloud top -! if (zl(i,j,k).gt.200. .and. zl(i,j,k).lt.1700. .and. (cld_sgs(i,j,k).gt.0.2.or.cld_sgs(i,j,k-1).gt.0.2) .and. brunt(i,j,k+1).gt.2e-4) then -! if (zl(i,j,k).gt.200. .and. zl(i,j,k).lt.1700. .and. cld_sgs(i,j,k).gt.0.2 .and. brunt(i,j,k).gt.2e-4) then -! smixt3(i,j,k) = (0.25+(1-0.25)*(zl(i,j,k)-200.)/1500.)*tkes*shocparams%LENFAC3/(sqrt(brunt_smooth(i,j,k))) -! else - smixt3(i,j,k) = max(0.1,tkes)*shocparams%LENFAC3/(sqrt(brunt_smooth(i,j,k))) -! smixt3(i,j,k) = tkes*shocparams%LENFAC3/(sqrt(brunt_smooth(i,j,k))) -! end if + ! Stability length scale + smixt3(i,j,k) = max(0.1,tkes)*shocparams%LENFAC3/(sqrt(brunt_smooth(i,j,k))) + !=== Combine component length scales === - if (shocparams%LENOPT .eq. 1) then ! JPL blending approach + if (shocparams%LENOPT .eq. 1) then ! JPL blending approach (w/SHOC length scales) wrk1 = 2./(1./smixt2(i,j,k)+1./smixt3(i,j,k)) if (zl(i,j,k).lt.300.) then smixt(i,j,k) = wrk1 + (smixt1(i,j,k)-wrk1)*exp(-(zl(i,j,k)/100.)**2) @@ -906,7 +906,7 @@ subroutine eddy_length() else if (shocparams%LENOPT .eq. 2) then ! Geometric average smixt(i,j,k) = min(max_eddy_length_scale, 3./(1./smixt1(i,j,k)+1./smixt2(i,j,k)+1./smixt3(i,j,k)) ) else if (shocparams%LENOPT .eq. 3) then ! SHOC classic approach - smixt(i,j,k) = min(max_eddy_length_scale, 3./SQRT(1./smixt1(i,j,k)**2+1./smixt2(i,j,k)**2+1./smixt3(i,j,k)**2) ) + smixt(i,j,k) = min(max_eddy_length_scale, SQRT(3.)/SQRT(1./smixt1(i,j,k)**2+1./smixt2(i,j,k)**2+1./smixt3(i,j,k)**2) ) end if else if (shocparams%LENOPT .eq. 4) then ! JPL Length scale (Suselj et al 2012) wrk2 = 1.0/(400.*tkes) @@ -920,8 +920,13 @@ subroutine eddy_length() ! Enforce minimum and maximum length scales wrk = 0.1*min(200.,adzl(i,j,k)) ! Minimum 0.1 of local dz (up to 200 m) - smixt(i,j,k) = max(wrk, min(max_eddy_length_scale*(zl(i,j,nzm)-zl(i,j,k))/zl(i,j,nzm),smixt(i,j,k))) - + if (zl(i,j,k) .lt. 5000.) then + smixt(i,j,k) = max(wrk, smixt(i,j,k)) + else if (zl(i,j,k) .lt. 9500) then ! Between 5-10 km the max length scale reduces with height + smixt(i,j,k) = max(wrk, min(max_eddy_length_scale*(1e4-zl(i,j,k))/5e3,smixt(i,j,k))) + else + smixt(i,j,k) = max(wrk, min(max_eddy_length_scale*0.1,smixt(i,j,k))) + end if end do end do end do @@ -1116,7 +1121,6 @@ subroutine update_moments( IM, JM, LM, & ! in wrk1 = 1.0 / (ZL(:,:,k)-ZL(:,:,k+1)) wrk3 = KH(:,:,k) * wrk1 -! sm = 0.5*(ISOTROPY(:,:,k)+ISOTROPY(:,:,k+1))*wrk1*wrk3 !Tau*Kh/dz^2 sm = 0.5*ISOTROPY(:,:,k)*wrk1*wrk3 !Tau*Kh/dz^2 ! SGS vertical flux liquid/ice water static energy. Eq 1 in BK13 @@ -1129,7 +1133,6 @@ subroutine update_moments( IM, JM, LM, & ! in ! Second moment of liquid/ice water static energy. Eq 4 in BK13 hl2_edge_nomf(:,:,k) = HL2TUNE * sm * wrk1 * wrk1 -! hl2_edge(:,:,k) = HL2TUNE * 0.5*(ISOTROPY(:,:,k)+ISOTROPY(:,:,k+1)) * & hl2_edge(:,:,k) = HL2TUNE * 0.5*ISOTROPY(:,:,k) * & (wrk3*wrk1-MFWHL(:,:,k)) * wrk1/(ZL(:,:,k)-ZL(:,:,k+1)) @@ -1155,7 +1158,14 @@ subroutine update_moments( IM, JM, LM, & ! in ! Update PDF_A - pdf_a = (pdf_a+mffrc)/(1.+DT/AFRC_TSCALE) + if (AFRC_TSCALE.gt.0.) then + pdf_a = (pdf_a+mffrc)/(1.+DT/AFRC_TSCALE) + else + pdf_a = pdf_a/(1.-DT/AFRC_TSCALE) + end if + where (mffrc.gt.pdf_a) + pdf_a = mffrc + end where pdf_a = min(0.5,max(0.,pdf_a)) diff --git a/GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 b/GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 index 626b71808..c5bba9e52 100644 --- a/GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 +++ b/GEOSogcm_GridComp/GEOS_OgcmGridComp.F90 @@ -855,7 +855,7 @@ subroutine SetServices ( GC, RC ) call MAPL_TerminateImport ( GC, ["DATA_KPAR "], [orad], RC=STATUS ) ! need to terminate others as well: cosz, discharge, frocean, pice, taux, tauy endif else - call MAPL_TerminateImport ( GC, ALL=.true., __RC__) + call MAPL_TerminateImport(GC, ['DATA_UW', 'DATA_VW'], [OCEAN, OCEAN], _RC) endif ! Set the Profiling timers diff --git a/GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt b/GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt index 1d232113c..f222976bf 100644 --- a/GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt +++ b/GEOSogcm_GridComp/GEOSseaice_GridComp/CMakeLists.txt @@ -5,7 +5,7 @@ option (BUILD_MIT_OCEAN "BUILD_MIT_OCEAN is turned off by default" OFF) #OFF by if ( NOT BUILD_MIT_OCEAN ) esma_add_library (${this} SRCS GEOS_SeaIceGridComp.F90 - SUBCOMPONENTS GEOSdataseaice_GridComp GEOSCICEDyna_GridComp CICE_GEOSPlug + SUBCOMPONENTS GEOSdataseaice_GridComp GEOSCICEDyna_GridComp CICE_GEOSPlug DEPENDENCIES MAPL CICE4 esmf) else() @@ -14,6 +14,5 @@ else() esma_add_library (${this} SRCS GEOS_SeaIceGridComp.F90 SUBCOMPONENTS GEOSdataseaice_GridComp GEOSMITDyna_GridComp - DEPENDENCIES MAPL - INCLUDES ${INC_ESMF}) + DEPENDENCIES MAPL esmf) endif() diff --git a/GEOSwgcm_GridComp/CMakeLists.txt b/GEOSwgcm_GridComp/CMakeLists.txt new file mode 100644 index 000000000..0576a2592 --- /dev/null +++ b/GEOSwgcm_GridComp/CMakeLists.txt @@ -0,0 +1,34 @@ +esma_set_this() + +set (alldirs + GEOSumwm_GridComp + GEOSwavewatch_GridComp + ) + +set (resource_files + WGCM.rc + ) + +if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_WgcmGridComp.F90) + + set_property( + SOURCE bl_seaspray.F90 + PROPERTY COMPILE_DEFINITIONS GEOS + ) + + esma_add_library (${this} + SRCS bl_seaspray.F90 GEOS_WgcmGridComp.F90 + SUBCOMPONENTS ${alldirs} + DEPENDENCIES MAPL esmf + ) + +else () + + esma_add_subdirectories (${alldirs}) + +endif() + + +install (FILES ${resource_files} + DESTINATION etc + ) diff --git a/GEOSwgcm_GridComp/GEOS_WgcmGridComp.F90 b/GEOSwgcm_GridComp/GEOS_WgcmGridComp.F90 new file mode 100644 index 000000000..69316e660 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOS_WgcmGridComp.F90 @@ -0,0 +1,1097 @@ + +#include "MAPL_Generic.h" + +!============================================================================= +!BOP + +! !MODULE: GEOS_WgcmGridCompMod -- A Module to compute wave properties + +! !INTERFACE: + +module GEOS_WgcmGridCompMod + +! !USES: + + use ESMF + use MAPL_Mod + + use GEOS_UMWMGridCompMod, only : UMWM_SetServices => SetServices + use GEOS_WaveWatchGridCompMod, only : WW3_SetServices => SetServices + + use bl_seaspray_mod, only : mabl_sea_spray => online_spray + + use, intrinsic :: ISO_FORTRAN_ENV + + implicit none + private + + character(len=*), parameter :: WGCM_CONFIG_FILE = 'WGCM.rc' + + character(len=*), parameter :: wave_model_ww3 = 'WW3' + character(len=*), parameter :: wave_model_umwm = 'UMWM' + character(len=*), parameter :: wave_model_data = 'WM.data' + character(len=*), parameter :: wave_model_idealized = 'JONSWAP' + + integer :: WM + +! Private state +! ------------- + + type WaveModel_State + private + + type(ESMF_Config) :: CF ! Private Config + + logical :: verbose = .false. ! verbose messages + + real :: dt = 0.0 ! time step, s + + character(len=ESMF_MAXSTR) :: wave_model ! name of the wave model + end type WaveModel_State + + +! Hook for the ESMF +! ----------------- + type WaveModel_Wrap + type (WaveModel_State), pointer :: ptr => null() + end type WaveModel_Wrap + + +! !PUBLIC MEMBER FUNCTIONS: + + public SetServices + +!============================================================================= + +! !DESCRIPTION: +! +! + +!EOP + +contains + +!BOP + +! ! IROUTINE: SetServices -- Sets ESMF services for this component + +! ! INTERFACE: + + subroutine SetServices(GC, RC) + +! ! ARGUMENTS: + + type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component + integer, optional :: RC ! return code + +! ! DESCRIPTION: This version uses the MAPL_GenericSetServices. This function sets +! the Initialize and Finalize services, as well as allocating +! our instance of a generic state and putting it in the +! gridded component (GC). Here we only need to set the run method and +! add the state variable specifications (also generic) to our instance +! of the generic state. This is the way our true state variables get into +! the ESMF_State INTERNAL, which is in the MAPL_MetaComp. + +!EOP + +!============================================================================= +! +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Config) :: CF ! global config + + type (WaveModel_State), pointer :: self ! private internal state + type (WaveModel_Wrap) :: wrap + +!============================================================================= + +! Begin... + +! Get my name and set-up traceback handle +! --------------------------------------- + + Iam = 'SetServices' + call ESMF_GridCompGet(GC, NAME=COMP_NAME, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Wrap the private internal state for storing in GC +! ------------------------------------------------- + + allocate(self, __STAT__) + wrap%ptr => self + +! Load private Config Attributes +! ------------------------------ + + self%CF = ESMF_ConfigCreate(__RC__) + + call ESMF_ConfigLoadFile(self%CF, WGCM_CONFIG_FILE, __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%verbose, label='verbose:', default=.false., __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%wave_model, label='wave_model:', default='__unknown__', __RC__) + + self%wave_model = ESMF_UtilStringUpperCase(self%wave_model, __RC__) + + + + +! Add a child component (the NUOPC wrapped ww3) +! --------------------------------------------- + WM = -1 + select case (self%wave_model) + case (wave_model_umwm) + WM = MAPL_AddChild(GC, NAME='UMWM', SS=UMWM_SetServices, __RC__) + case (wave_model_ww3) + WM = MAPL_AddChild(GC, NAME='WW3plug', SS=WW3_SetServices, __RC__) + case default + __raise__(MAPL_RC_ERROR, 'Unrecognized wave model name in ' // trim(WGCM_CONFIG_FILE)) + end select + + +! Set the Initialize, Run entry point +! ----------------------------------- + + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_INITIALIZE, Initialize, __RC__) + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_RUN, Run, __RC__) + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_FINALIZE, Finalize, __RC__) + + +! Store private internal state in GC +! ---------------------------------- + call ESMF_UserCompSetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + +! Set the state variable specs +! ----------------------------- + +! !INTERNAL STATE: + + + + +! !IMPORT STATE: + +! AGCM -> WGCM + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'U10M', & + LONG_NAME = '10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'V10M', & + LONG_NAME = '10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'U10N', & + LONG_NAME = 'equivalent_neutral_10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'V10N', & + LONG_NAME = 'equivalent_neutral_10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'RHOS', & + LONG_NAME = 'air_density_at_surface', & + UNITS = 'kg m-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 1.28, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TSKINW', & + LONG_NAME = 'open_water_skin_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 280.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TS', & + LONG_NAME = 'skin_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 280.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FRLAND', & + LONG_NAME = 'fraction_of_land', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FROCEAN', & + LONG_NAME = 'fraction_of_ocean', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FRACI', & + LONG_NAME = 'ice_covered_fraction_of_tile', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'PS', & + LONG_NAME = 'surface_pressure', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 101325.0, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'Q10M', & + LONG_NAME = '10-meter_specific_humidity', & + UNITS = 'kg kg', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.8, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'RH2M', & + LONG_NAME = 'near-surface_relative_humidity', & + UNITS = '%', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.8, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'T10M', & + LONG_NAME = '10-meter_air_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 288.0, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'LHFX', & + LONG_NAME = 'total_latent_energy_flux', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.0, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'SH', & + LONG_NAME = 'sensible_heat_flux_from_turbulence', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.0, & + RESTART = MAPL_RestartSkip, __RC__) + + +! OGCM -> WGCM + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TW', & + LONG_NAME = 'temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + RESTART = MAPL_RestartSkip, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'UW', & + LONG_NAME = 'zonal_velocity_of_surface_water', & + UNITS = 'm s-1 ', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'VW', & + LONG_NAME = 'meridional_velocity_of_surface_water', & + UNITS = 'm s-1 ', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'DW_WGCM', & + LONG_NAME = 'sea_floor_depth', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + +! !EXPORT STATE: + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'CHARNOCK', & + CHILD_ID = WM, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'USTAR', & + CHILD_ID = WM, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWH', & + CHILD_ID = WM, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DCP', & + CHILD_ID = WM, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EDF', & + CHILD_ID = WM, __RC__) + + + + ! + ! Sea spray diagnostics + ! + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EDFP', & + LONG_NAME = 'wave_energy_dissipation_flux_parameterized', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'sensible_heat_flux_from_turbulence', & + UNITS = 'W m-2', & + SHORT_NAME = 'SHFX', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + LONG_NAME = 'total_latent_energy_flux', & + UNITS = 'W m-2', & + SHORT_NAME = 'LHFX', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SHFX_TURB', & + LONG_NAME = 'sensible_heat_carried_by_turbulence', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LHFX_TURB', & + LONG_NAME = 'latent_heat_carried_by_turbulence', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SHFX_TOT', & + LONG_NAME = 'sensible_heat_medited_by_seaspray', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LHFX_TOT', & + LONG_NAME = 'latent_heat_mediated_by_seaspray', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SHFX_SPRAY', & + LONG_NAME = 'sensible_heat_contribution_from_sea_spray', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LHFX_SPRAY', & + LONG_NAME = 'latent_heat_contribution_from_sea_spray', & + UNITS = 'W m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + +! Set the Profiling timers +! ------------------------ + + call MAPL_TimerAdd(GC, name='TOTAL' , __RC__) + call MAPL_TimerAdd(GC, name='INITIALIZE' , __RC__) + call MAPL_TimerAdd(GC, name='RUN' , __RC__) + call MAPL_TimerAdd(GC, name='-SEA_SPRAY' , __RC__) + call MAPL_TimerAdd(GC, name='FINALIZE' , __RC__) + + +!ALT: we need to terminate child's import so they do not "bubble up". We will fill them explicitly + +! this should be irrelevant here because the children are not MAPL components +! call MAPL_TerminateImport() + +! Set generic init and final methods +! ---------------------------------- + + call MAPL_GenericSetServices(GC, __RC__) + + RETURN_(ESMF_SUCCESS) + + end subroutine SetServices + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: INITIALIZE -- Initialize method for the UMWM component + +! !INTERFACE: + + subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Grid) :: GRID + + type(ESMF_Alarm) :: run_alarm + type(ESMF_TimeInterval) :: ring_interval + real(ESMF_KIND_R8) :: time_step + + type (WaveModel_State), pointer :: self ! private internal state + type (WaveModel_Wrap) :: wrap + +! Local Variables + + type (ESMF_GridComp), pointer :: GCS(:) => null() + type (ESMF_State), pointer :: GIM(:) => null() + type (ESMF_State), pointer :: GEX(:) => null() + + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Initialize' + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + +! Get my internal private state +! ----------------------------- + call ESMF_UserCompGetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + self => wrap%ptr + + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'INITIALIZE', __RC__) + + +! Set the grid explicitly if the WM instance is WW3 +! ------------------------------------------------- + + ! this section needs to be executed only for WW3: + ! propagate the WW3 grid up to the WGCM. +#if 0 + if (self%wave_model == wave_model_ww3) then + call MAPL_Get(MAPL, GCS=GCS, GIM=GIM, GEX=GEX, __RC__) + call MAPL_Set(MAPL, ChildInit=.false., __RC__) + + call ESMF_GridCompInitialize(GCS(WM), importState=GIM(WM), & + exportState=GEX(WM), clock=CLOCK, userRC=STATUS) + VERIFY_(STATUS) + + call ESMF_GridCompGet(GCS(WM), grid=GRID, __RC__) + call ESMF_GridCompSet(GC, grid=GRID, __RC__) + end if +#endif + +! Get the grid +! ------------ + + call ESMF_GridCompGet(GC, grid=GRID, __RC__) + + +! Generic initialize +! ------------------ + call MAPL_GenericInitialize(GC, IMPORT, EXPORT, CLOCK, __RC__) + + +! Get parameters from generic state +! --------------------------------- + + call MAPL_Get(MAPL, RunAlarm=run_alarm, __RC__) + call ESMF_AlarmGet(run_alarm, ringInterval=ring_interval, __RC__) + + call ESMF_TimeIntervalGet(ring_interval, s_r8=time_step, __RC__) + self%dt = real(time_step) + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'INITIALIZE', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Initialize + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: RUN -- Run method for the UMWM component + +! !INTERFACE: + + subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + integer :: iSTAT + character(len=ESMF_MAXSTR) :: COMP_NAME + + +! Local derived type aliases + + type(WaveModel_State), pointer :: self => null() + type(WaveModel_Wrap) :: wrap + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_State) :: INTERNAL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + + type (ESMF_GridComp), pointer :: GCS(:) + type (ESMF_State), pointer :: GIM(:) + type (ESMF_State), pointer :: GEX(:) + + +! Pointers from Import state + real, pointer, dimension(:,:) :: U10M => null() + real, pointer, dimension(:,:) :: V10M => null() + real, pointer, dimension(:,:) :: RHOS => null() + real, pointer, dimension(:,:) :: PS => null() + real, pointer, dimension(:,:) :: TS => null() + real, pointer, dimension(:,:) :: T10M => null() + real, pointer, dimension(:,:) :: RH2M => null() + real, pointer, dimension(:,:) :: FRACI=> null() + + real, pointer, dimension(:,:) :: LHFX => null() + real, pointer, dimension(:,:) :: SHFX => null() + +! Pointers to my Export state + + real, pointer, dimension(:,:) :: WM_USTAR + real, pointer, dimension(:,:) :: WM_SWH + real, pointer, dimension(:,:) :: WM_DCP + real, pointer, dimension(:,:) :: WM_EDF + + ! + ! Sea spray diagnostics + ! + real, pointer, dimension(:,:) :: WM_EDFP => null() + + real, pointer, dimension(:,:) :: WM_LHFX => null() + real, pointer, dimension(:,:) :: WM_SHFX => null() + + real, pointer, dimension(:,:) :: SHFX_TURB => null() + real, pointer, dimension(:,:) :: LHFX_TURB => null() + real, pointer, dimension(:,:) :: SHFX_TOT => null() + real, pointer, dimension(:,:) :: LHFX_TOT => null() + real, pointer, dimension(:,:) :: SHFX_SPRAY => null() + real, pointer, dimension(:,:) :: LHFX_SPRAY => null() + +! Pointers to child's Export state +! N/A + +! Local variables + integer :: IM, JM + integer :: i, j + +! MABL sea spray + real :: spray_edf_factor + real :: spray_hss + real :: spray_hll + real :: spray_hwave + real :: spray_cwave + real :: spray_p + real :: spray_usr + real :: spray_w10m + real :: spray_massf + real :: spray_hs_tot + real :: spray_hl_tot + real :: spray_usr_new + real :: spray_S_bar1 + real :: spray_z_r + real :: spray_omega + real :: spray_alpha + real :: spray_vfm + + integer :: DO_SEA_SPRAY + + real, parameter :: SPRAY_SOURCE_STRENGTH = 0.4 + real, parameter :: SPRAY_FEEDBACK = 0.2 + +! TODO: need to be consistent across the wave models; move to a config file + real, parameter :: FRACTION_ICE_SUPPRESS_WAVES = 0.8 + + + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Run' + + call ESMF_GridCompGet(GC, name=COMP_NAME, GRID=GRID, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'RUN', __RC__) + + +! Get parameters from generic state +! --------------------------------- + call MAPL_Get (MAPL, IM=IM, JM=JM, GCS=GCS, GIM=GIM, GEX=GEX, __RC__) + + +! Get my internal private state +! ----------------------------- + call ESMF_UserCompGetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + self => wrap%ptr + + +! Run children (specific WM) +! -------------------------- + call MAPL_GenericRunChildren (GC, IMPORT, EXPORT, CLOCK, RC=STATUS) + VERIFY_(STATUS) + +! MABL sea spray parameterization, Bao et al, 2011 +! ------------------------------------------------ + call MAPL_TimerOn(MAPL, '-SEA_SPRAY') + + call MAPL_GetResource( MAPL, DO_SEA_SPRAY, Label="USE_SEA_SPRAY:", DEFAULT=1, __RC__) + +! Get pointers to inputs +! ---------------------- + call MAPL_GetPointer(IMPORT, U10M, 'U10M', __RC__) + call MAPL_GetPointer(IMPORT, V10M, 'V10M', __RC__) + call MAPL_GetPointer(IMPORT, T10M, 'T10M', __RC__) + call MAPL_GetPointer(IMPORT, RH2M, 'RH2M', __RC__) + call MAPL_GetPointer(IMPORT, RHOS, 'RHOS', __RC__) + call MAPL_GetPointer(IMPORT, TS, 'TS', __RC__) + call MAPL_GetPointer(IMPORT, PS, 'PS', __RC__) + call MAPL_GetPointer(IMPORT, FRACI, 'FRACI', __RC__) + call MAPL_GetPointer(IMPORT, LHFX, 'LHFX', __RC__) + call MAPL_GetPointer(IMPORT, SHFX, 'SH', __RC__) + + + call MAPL_GetPointer(EXPORT, WM_USTAR, 'USTAR', __RC__) + call MAPL_GetPointer(EXPORT, WM_SWH, 'SWH', __RC__) + call MAPL_GetPointer(EXPORT, WM_DCP, 'DCP', __RC__) + call MAPL_GetPointer(EXPORT, WM_EDF, 'EDF', __RC__) + + call MAPL_GetPointer(EXPORT, WM_LHFX, 'LHFX', __RC__) + call MAPL_GetPointer(EXPORT, WM_SHFX, 'SHFX', __RC__) + + ! sea spray diagnostics + call MAPL_GetPointer(EXPORT, WM_EDFP, 'EDFP', __RC__) + + call MAPL_GetPointer(EXPORT, LHFX_TURB, 'LHFX_TURB' , alloc=(DO_SEA_SPRAY/=0), __RC__) + call MAPL_GetPointer(EXPORT, SHFX_TURB, 'SHFX_TURB' , alloc=(DO_SEA_SPRAY/=0), __RC__) + call MAPL_GetPointer(EXPORT, LHFX_TOT, 'LHFX_TOT' , alloc=(DO_SEA_SPRAY/=0), __RC__) + call MAPL_GetPointer(EXPORT, SHFX_TOT, 'SHFX_TOT' , alloc=(DO_SEA_SPRAY/=0), __RC__) + call MAPL_GetPointer(EXPORT, LHFX_SPRAY, 'LHFX_SPRAY', alloc=(DO_SEA_SPRAY/=0), __RC__) + call MAPL_GetPointer(EXPORT, SHFX_SPRAY, 'SHFX_SPRAY', alloc=(DO_SEA_SPRAY/=0), __RC__) + +! Sanity diagnostics +! ------------------ + + ! heat fluxes + if (associated(WM_LHFX)) WM_LHFX = LHFX + if (associated(WM_SHFX)) WM_SHFX = SHFX + + + PARAMETERIZED_ENERGY_DISSIPATION_FLUX: if (associated(WM_EDFP)) then + + WM_EDFP = 1.0*(-0.4+0.25*sqrt(U10M**2 + V10M**2)) ! cEwave + where (WM_USTAR /= MAPL_UNDEF) + WM_EDFP = (RHOS/MAPL_RHOWTR) * WM_EDFP*WM_USTAR**2 + elsewhere + WM_EDFP = 0.0 + end where + + where (WM_EDFP < 0.0 .and. WM_USTAR /= MAPL_UNDEF) + WM_EDFP = (RHOS/MAPL_RHOWTR) * 3.5 * WM_USTAR**3.5 + end where + + WM_EDFP = WM_EDFP * MAPL_RHOWTR ! convert units from 'm3 s-3' to match the units of EDF 'kg s-3' + + end if PARAMETERIZED_ENERGY_DISSIPATION_FLUX + + + + DIAGNOSTICS_SPRAY_FLUXES: if ( associated(SHFX_SPRAY) .or. & + associated(LHFX_SPRAY) ) then + + ASSERT_(associated(SHFX_SPRAY)) + ASSERT_(associated(LHFX_SPRAY)) + + ASSERT_(associated(SHFX_TURB)) + ASSERT_(associated(LHFX_TURB)) + + ASSERT_(associated(SHFX_TOT)) + ASSERT_(associated(LHFX_TOT)) + + SHFX_TOT = SHFX + LHFX_TOT = LHFX + SHFX_TURB = SHFX + LHFX_TURB = LHFX + SHFX_SPRAY = 0.0 + LHFX_SPRAY = 0.0 + + if (self%wave_model == wave_model_umwm) then + ! scale up UMWM:EDF to agree with EDFP and WW3 + spray_edf_factor = 3.0 + else + spray_edf_factor = 1.0 + end if + + do j = 1, JM + do i = 1, IM + + spray_w10m = sqrt(U10M(i,j)**2 + V10M(i,j)**2) + + if ( (spray_w10m > 7.0) .and. & + (WM_USTAR(i,j) /= MAPL_UNDEF) .and. & + (WM_DCP(i,j) /= MAPL_UNDEF) .and. & + (WM_SWH(i,j) > 0.5) .and. & + (FRACI(i,j) < FRACTION_ICE_SUPPRESS_WAVES) ) then + + spray_hss = SHFX(i,j) ! SHWTR + spray_hll = LHFX(i,j) ! HLATWTR + spray_hwave = WM_SWH(i,j) + spray_cwave = WM_DCP(i,j) +#if(1) + spray_p = spray_edf_factor * WM_EDF(i,j) / MAPL_RHOWTR ! the factor 3 is to agree with EDFP + + ! protect against negative energy dissipation flux + if (spray_p < 0) then + spray_p = RHOS(i,j) * 3.5 * WM_USTAR(i,j)**3.5 + end if + + if (spray_p < tiny(spray_p)) then + cycle + end if +#else + spray_p = WM_EDFP(i,j) / MAPL_RHOWTR +#endif + spray_usr = WM_USTAR(i,j) + + + call mabl_sea_spray(SPRAY_SOURCE_STRENGTH, & + SPRAY_FEEDBACK, & + spray_w10m, & + 10.0, & + TS(i,j) - 273.15, & ! T:=(TSKINW!=MAPL_UNDEF)?TSKINW:TS + T10M(i,j) - 273.15, & + min(RH2M(i,j) * 0.01, 0.99), & ! s = ...? + PS(i,j) * 0.01, & + spray_hss, & + spray_hll, & + spray_hwave, & + spray_cwave, & + spray_p, & + spray_usr, & + spray_massf, & + spray_hs_tot, & + spray_hl_tot, & + spray_usr_new, & + spray_S_bar1, & + spray_z_r, & + spray_omega, & + spray_alpha, & + spray_vfm) + + if (abs(spray_hss - SHFX(i,j)) > tiny(spray_hss) .or. & + abs(spray_hll - LHFX(i,j)) > tiny(spray_hll)) then + print *, 'DEBUG::WAVES_PHYS ***Heat Fluxes do not match after SPRAY()' + end if + + SHFX_TURB(i,j) = spray_hss + LHFX_TURB(i,j) = spray_hll + + SHFX_SPRAY(i,j) = (spray_hs_tot - spray_hss) * (1 - FRACI(i,j)) + LHFX_SPRAY(i,j) = (spray_hl_tot - spray_hll) * (1 - FRACI(i,j)) + + SHFX_TOT(i,j) = spray_hss + (spray_hs_tot - spray_hss) * (1 - FRACI(i,j)) + LHFX_TOT(i,j) = spray_hll + (spray_hl_tot - spray_hll) * (1 - FRACI(i,j)) + end if + + + if (abs(SHFX_SPRAY(i,j)) > 2e2 .or. abs(LHFX_SPRAY(i,j)) > 2e2) then + print *, SHFX_SPRAY(i,j), & + LHFX_SPRAY(i,j), & + WM_USTAR(i,j), & + sqrt(U10M(i,j)**2 + V10M(i,j)**2), & + TS(i,j) - 273.15, & + T10M(i,j)- 273.15, & + RH2M(i,j) * 0.01, & ! s = ...? + PS(i,j) * 0.01, & + WM_SWH(i,j), & + WM_DCP(i,j), & +#if(1) + WM_EDF(i,j) +#else + WM_EDFP(i,j) +#endif + end if + + end do + end do + +#ifdef DEBUG + print *, ' *** DEBUG WM:SH_SPRAY = ', minval(SHFX_SPRAY), maxval(SHFX_SPRAY) + print *, ' *** DEBUG WM:LH_SPRAY = ', minval(LHFX_SPRAY), maxval(LHFX_SPRAY) +#endif + + + end if DIAGNOSTICS_SPRAY_FLUXES + + call MAPL_TimerOff(MAPL, '-SEA_SPRAY') + + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'RUN', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Run + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: FINALIZE -- Finalize method for the UMWM component + +! !INTERFACE: + + subroutine Finalize(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + +! Local global variables + + integer :: COUNTS(ESMF_MAXDIM) + +! Local Variables + + integer :: IM, JM, LM + integer :: IM_world, JM_world + integer :: COMM ! MPI communicator from VM + integer :: myPE + integer :: nPEs + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Finalize' + call ESMF_GridCompGet(GC, name=COMP_NAME, GRID=GRID, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'FINALIZE', __RC__) + +! Get parameters from generic state. +! ---------------------------------- + + call MAPL_Get(MAPL, IM=IM, JM=JM, LM=LM, __RC__) + + call MAPL_GridGet(GRID, globalCellCountPerDim=COUNTS, __RC__) + + IM_world = COUNTS(1) + JM_world = COUNTS(2) + +! Get layout from the grid +! ------------------------ + + call ESMF_VMGetCurrent(VM, __RC__) + + call ESMF_VMGet(VM, mpiCommunicator=COMM, localPet=myPE, petCount=nPEs, __RC__) + +! Get parameters +!--------------- + + + + + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'FINALIZE', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + +! Call GenericFinalize +! ---------------------- + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:BeforeGenericFinalize', __RC__) + + call MAPL_GenericFinalize(GC, IMPORT, EXPORT, CLOCK, __RC__) + VERIFY_(STATUS) + + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:AfterGenericFinalize', __RC__) + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Finalize + + + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module GEOS_WgcmGridCompMod + diff --git a/GEOSwgcm_GridComp/GEOSumwm_GridComp/.gitignore b/GEOSwgcm_GridComp/GEOSumwm_GridComp/.gitignore new file mode 100644 index 000000000..bfcc72354 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSumwm_GridComp/.gitignore @@ -0,0 +1,3 @@ +/@umwm +/umwm +/umwm@ diff --git a/GEOSwgcm_GridComp/GEOSumwm_GridComp/CMakeLists.txt b/GEOSwgcm_GridComp/GEOSumwm_GridComp/CMakeLists.txt new file mode 100644 index 000000000..87b892216 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSumwm_GridComp/CMakeLists.txt @@ -0,0 +1,24 @@ +esma_set_this () + + +esma_add_subdirectories( + umwm_cmake + ) + +esma_add_library (${this} + SRCS GEOS_UMWMGridComp.F90 + DEPENDENCIES MAPL umwm esmf + ) + + +file (GLOB_RECURSE rc_files RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.rc) +foreach ( file ${rc_files} ) + get_filename_component( dir ${file} DIRECTORY ) + install( FILES ${file} DESTINATION etc/${dir} ) +endforeach() + + +install ( + FILES UMWM_ExtData.yaml + DESTINATION etc +) diff --git a/GEOSwgcm_GridComp/GEOSumwm_GridComp/GEOS_UMWMGridComp.F90 b/GEOSwgcm_GridComp/GEOSumwm_GridComp/GEOS_UMWMGridComp.F90 new file mode 100644 index 000000000..174a11619 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSumwm_GridComp/GEOS_UMWMGridComp.F90 @@ -0,0 +1,2337 @@ +#include "MAPL_Generic.h" + +!============================================================================= +!BOP + +! !MODULE: GEOS_WgcmGridCompMod -- A Module to compute wave properties via the +! UMWM wave model + +! !INTERFACE: + +module GEOS_UMWMGridCompMod + +! !USES: + + use ESMF + use MAPL_Mod + +! UMWM modules + use UMWM_module, only: umwm_version => version + + use UMWM_module, only: umwm_isGlobal => isGlobal, & + umwm_restart => restart, & + umwm_gridfromfile => gridfromfile, & + umwm_topofromfile => topofromfile, & + umwm_fillEstuaries => fillEstuaries, & + umwm_fillLakes => fillLakes + + use UMWM_module, only: umwm_mm => mm, & + umwm_nm => nm, & + umwm_lat => lat, & + umwm_lon => lon, & + umwm_d_2d => d_2d, & + umwm_mask => mask + + use UMWM_module, only: umwm_om => om, & + umwm_pm => pm, & + umwm_fmin => fmin, & + umwm_fmax => fmax, & + umwm_fprog => fprog + + use UMWM_module, only: umwm_wspd => wspd, & + umwm_wdir => wdir, & + umwm_rhow0 => rhow0, & + umwm_rhow => rhow, & + umwm_rhoa0 => rhoa0, & + umwm_rhoa => rhoa, & + umwm_rhorat => rhorat, & + umwm_nu_water_ => nu_water_, & + umwm_fice => fice, & + umwm_uc => uc, & + umwm_vc => vc, & + umwm_d => d + + use UMWM_module, only: umwm_nu_air => nu_air, & + umwm_nu_water => nu_water, & + umwm_g => g, & + umwm_kappa => kappa, & + umwm_gustiness => gustiness, & + umwm_sfct => sfct, & + umwm_z => z, & + umwm_dmin => dmin, & + umwm_explim => explim, & + umwm_sin_fac => sin_fac, & + umwm_sin_diss1 => sin_diss1, & + umwm_sin_diss2 => sin_diss2, & + umwm_sds_fac => sds_fac, & + umwm_sds_power => sds_power, & + umwm_mss_fac => mss_fac, & + umwm_snl_fac => snl_fac, & + umwm_sdt_fac => sdt_fac, & + umwm_sbf_fac => sbf_fac, & + umwm_sbp_fac => sbp_fac, & + umwm_fice_lth => fice_lth, & + umwm_fice_uth => fice_uth + + use UMWM_module, only: umwm_e => e, & + umwm_ef => ef, & + umwm_k => k, & + umwm_cp0 => cp0, & + umwm_cg0 => cg0 + + use UMWM_module, only: umwm_im => im, & + umwm_imm => imm, & + umwm_istart => istart, & + umwm_iend => iend, & + umwm_iistart => iistart, & + umwm_iiend => iiend, & + umwm_ni => ni, & + umwm_mi => mi + + use UMWM_module, only: umwm_sumt => sumt, & + umwm_dtg => dtg, & + umwm_dta => dta, & + umwm_dtamin => dtamin + + use UMWM_module, only: umwm_ustar => ustar, & + umwm_cd => cd, & + umwm_ht => ht, & + umwm_hts => hts, & + umwm_htw => htw, & + umwm_mwp => mwp, & + umwm_mwd => mwd, & + umwm_mss => mss, & + umwm_mwl => mwl, & + umwm_dwd => dwd, & + umwm_dwl => dwl, & + umwm_dwp => dwp, & + umwm_dcp0 => dcp0, & + umwm_dcg0 => dcg0, & + umwm_dcp => dcp, & + umwm_dcg => dcg, & + umwm_momx => momx, & + umwm_momy => momy, & + umwm_cgmxx => cgmxx, & + umwm_cgmxy => cgmxy, & + umwm_cgmyy => cgmyy, & + umwm_epsx_ocn => epsx_ocn, & + umwm_epsy_ocn => epsy_ocn, & + umwm_epsx_atm => epsx_atm, & + umwm_epsy_atm => epsy_atm, & + umwm_taux => taux, & + umwm_tauy => tauy, & + umwm_taux_form => taux_form, & + umwm_tauy_form => tauy_form, & + umwm_taux_skin => taux_skin, & + umwm_tauy_skin => tauy_skin + + use UMWM_init, only: umwm_environment => environment, & + umwm_alloc => alloc, & + umwm_grid => grid, & + umwm_masks => masks, & + umwm_partition => partition, & + umwm_remap => remap, & + umwm_initialize => init + + use umwm_mpi, only: umwm_exchange_halo => exchange_halo + + use umwm_io, only: umwm_gatherfield => gatherfield + + use UMWM_source_functions, only: umwm_s_in => sin_d12, & + umwm_s_ds => sds_d12, & + umwm_s_nl => snl_d12, & + umwm_s_ice => s_ice + + use UMWM_stress, only: umwm_stress_ => stress + + use UMWM_physics, only: umwm_source => source, & + umwm_diag => diag + + use UMWM_advection, only: umwm_propagation => propagation, & + umwm_refraction => refraction + + + use UMWM_stokes, only: umwm_stokes_drift => stokes_drift + + use UMWM_util, only: umwm_dealloc => dealloc, & + umwm_remap_mn2i => remap_mn2i, & + umwm_remap_i2mn => remap_i2mn + + use UMWM_util, only: sigWaveHeight, meanWavePeriod + + use UMWM_module, only: umwm_nproc => nproc + + use, intrinsic :: iso_fortran_env + use, intrinsic :: ieee_arithmetic + + implicit none + private + + character(len=*), parameter :: UMWM_CONFIG_FILE = 'UMWM.rc' + + real, parameter :: FRACTION_ICE_SUPPRESS_WAVES = 0.8 + real, parameter :: NORTH_POLE_CAP_LATITUDE = 88.0 + + +! Private state +! ------------- + + type WaveModel_State + private + + type(ESMF_Config) :: CF ! Private Config + + logical:: verbose = .false. ! verbose messages + + real :: dt = 0.0 ! wave model time step, s + + integer :: n_split = 0 ! number of substeps for time-splitting + integer :: max_substeps = 0 ! max number of sub-steps + + + integer :: om = 0 ! number of frequency/wavenumber bins + integer :: pm = 0 ! number of direction bins + + real :: fmin = 0.0 ! lowest frequency bin, Hz + real :: fmax = 0.0 ! highest frequency bin, Hz + real :: fprog = 0.0 ! highest prognostic frequency bin, Hz + + real :: nu_air = 0.0 ! kinematic viscosity of air, m2 s-1 + real :: nu_water = 0.0 ! kinematic viscosity of water, m2 s-1 + real :: sfct = 0.0 ! surface tension, N m-1 + real :: gustiness = 0.0 ! random wind gustiness factor (should be between 0 and 0.2) + real :: dmin = 0.0 ! depth limiter, m + real :: explim = 0.0 ! exponent limiter (0.69 ~ 100% growth) + real :: sin_fac = 0.0 ! input factor from following winds + real :: sin_diss1 = 0.0 ! damping factor from opposing winds + real :: sin_diss2 = 0.0 ! damping factor from swell overrunning wind + real :: sds_fac = 0.0 ! breaking dissipation factor + real :: sds_power = 0.0 ! saturation spectrum power + real :: mss_fac = 0.0 ! mean-square-slope adjustment to Sds + real :: snl_fac = 0.0 ! wave energy downshifting factor + real :: sdt_fac = 0.0 ! dissipation due to turbulence factor + real :: sbf_fac = 0.0 ! bottom friction coefficient, m s-1 + real :: sbp_fac = 0.0 ! bottom percolation coefficient, m s-1 + + real :: fice_lth = 0.0 ! sea ice fraction - lower threshold for attenuation + real :: fice_uth = 0.0 ! sea ice fraction - upper threshold for attenuation + + real :: charnock_sf=0.0 ! value of Charnock when wave supported stress is 0 + + logical :: stokes = .true. ! output Stokes drift velocity fields + real, pointer, dimension(:) :: depths => null() ! depths for Stokes diagnostics + + end type WaveModel_State + + +! Hook for the ESMF +! ----------------- + type WaveModel_Wrap + type (WaveModel_State), pointer :: ptr => null() + end type WaveModel_Wrap + + +! !PUBLIC MEMBER FUNCTIONS: + + public SetServices + +!============================================================================= + +! !DESCRIPTION: +! +! + +!EOP + +contains + +!BOP + +! ! IROUTINE: SetServices -- Sets ESMF services for this component + +! ! INTERFACE: + + subroutine SetServices(GC, RC) + +! ! ARGUMENTS: + + type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component + integer, optional :: RC ! return code + +! ! DESCRIPTION: This version uses the MAPL_GenericSetServices. This function sets +! the Initialize and Finalize services, as well as allocating +! our instance of a generic state and putting it in the +! gridded component (GC). Here we only need to set the run method and +! add the state variable specifications (also generic) to our instance +! of the generic state. This is the way our true state variables get into +! the ESMF_State INTERNAL, which is in the MAPL_MetaComp. + +!EOP + +!============================================================================= +! +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Config) :: CF ! global config + + type (WaveModel_State), pointer :: self ! private internal state + type (WaveModel_Wrap) :: wrap + + integer :: NUM_FREQUENCY_BINS ! number of frequency/wavenumber bins + integer :: NUM_DIRECTIONS ! number of descrete directions + +!============================================================================= + +! Begin... + +! Get my name and set-up traceback handle +! --------------------------------------- + + Iam = 'SetServices' + call ESMF_GridCompGet(GC, NAME=COMP_NAME, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Wrap the private internal state for storing in GC +! ------------------------------------------------- + + allocate(self, __STAT__) + wrap%ptr => self + +! Load private Config Attributes +! ------------------------------ + + self%CF = ESMF_ConfigCreate(__RC__) + + call ESMF_ConfigLoadFile(self%CF, UMWM_CONFIG_FILE, __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%verbose, label='verbose:', default=.false., __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%om, label='FREQUENCIES:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%pm, label='DIRECTIONS:' , __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%fmin, label='MIN_FREQUENCY:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%fmax, label='MAX_FREQUENCY:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%fprog, label='MAX_PROGNFREQ:', __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%n_split, label='N_SPLIT:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%max_substeps, label='MAX_SUBSTEPS:',__RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%fice_lth, label='SEAICE_LTH:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%fice_uth, label='SEAICE_UTH:', __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%charnock_sf, label='CHARNOCK_SF:', __RC__) + + call ESMF_ConfigGetAttribute(self%CF, self%nu_air, label='nu_air:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%nu_water, label='nu_water:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sfct, label='sfct:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%gustiness, label='gustiness:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%dmin, label='dmin:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%explim, label='explim:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sin_fac, label='sin_fac:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sin_diss1, label='sin_diss1:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sin_diss2, label='sin_diss2:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sds_fac, label='sds_fac:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sds_power, label='sds_power:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%mss_fac, label='mss_fac:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%snl_fac, label='snl_fac:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sdt_fac, label='sdt_fac:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sbf_fac, label='sbf_fac:', __RC__) + call ESMF_ConfigGetAttribute(self%CF, self%sbp_fac, label='sbp_fac:', __RC__) + + + ASSERT_(self%om > 0) + ASSERT_(self%pm > 0) + +!!! ASSERT_(mod(self%pm,8) /= 0) + + ASSERT_(self%fmin > 0.0) + ASSERT_(self%fmax > 0.0) + ASSERT_(self%fmax > self%fmin) + ASSERT_(self%fprog >= self%fmin) + ASSERT_(self%fprog <= self%fmax) + + + +! Set the Initialize, Run entry point +! ----------------------------------- + + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_INITIALIZE, Initialize, __RC__) + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_RUN, Run, __RC__) + call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_FINALIZE, Finalize, __RC__) + + +! Store private internal state in GC +! ---------------------------------- + call ESMF_UserCompSetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + +! Set the state variable specs +! ----------------------------- + NUM_FREQUENCY_BINS = self%om + NUM_DIRECTIONS = self%pm + +! Set the state variable specs. +! ----------------------------- + +! !INTERNAL STATE: + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'E', & + LONG_NAME = 'sea_surface_wave_energy_spectrum', & + UNITS = 'm4 rad-1', & + DIMS = MAPL_DimsHorzOnly, & + UNGRIDDED_DIMS = (/NUM_FREQUENCY_BINS, NUM_DIRECTIONS/), & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.0, __RC__) + +! call MAPL_AddInternalSpec(GC, & +! SHORT_NAME = 'WM_K', & +! LONG_NAME = 'sea_surface_wave_wavenumber', & +! UNITS = 'rad m-1', & +! DIMS = MAPL_DimsHorzOnly, & +! UNGRIDDED_DIMS = (/NUM_FREQUENCY_BINS/), & +! VLOCATION = MAPL_VLocationNone, & +! ADD2EXPORT = .true., & +! RESTART = MAPL_RestartOptional, & +! DEFAULT = 1.0, __RC__) + + call MAPL_AddInternalSpec(GC, & + SHORT_NAME = 'USTAR', & + LONG_NAME = 'friction_velocity_of_air', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + ADD2EXPORT = .true., & + RESTART = MAPL_RestartOptional, & + DEFAULT = 0.2, __RC__) + +! !IMPORT STATE: + +! AGCM -> WM + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'U10M', & + LONG_NAME = '10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'V10M', & + LONG_NAME = '10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'U10N', & + LONG_NAME = 'equivalent_neutral_10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'V10N', & + LONG_NAME = 'equivalent_neutral_10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + +! call MAPL_AddImportSpec(GC, & +! SHORT_NAME = 'UA', & +! LONG_NAME = 'surface_eastward_wind', & +! UNITS = 'm s-1', & +! DIMS = MAPL_DimsHorzOnly, & +! VLOCATION = MAPL_VLocationNone, & +! RESTART = MAPL_RestartSkip, __RC__) +! +! call MAPL_AddImportSpec(GC, & +! SHORT_NAME = 'VA', & +! LONG_NAME = 'surface_northward_wind', & +! UNITS = 'm s-1', & +! DIMS = MAPL_DimsHorzOnly, & +! VLOCATION = MAPL_VLocationNone, & +! RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'RHOS', & + LONG_NAME = 'air_density_at_surface', & + UNITS = 'kg m-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 1.28, & + RESTART = MAPL_RestartOptional, __RC__) + +! call MAPL_AddImportSpec(GC, & +! SHORT_NAME = 'DZ', & +! LONG_NAME = 'surface_layer_height', & +! UNITS = 'm', & +! DIMS = MAPL_DimsHorzOnly, & +! VLOCATION = MAPL_VLocationNone, & +! RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TSKINW', & + LONG_NAME = 'open_water_skin_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 280.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TS', & + LONG_NAME = 'skin_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 280.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FRLAND', & + LONG_NAME = 'fraction_of_land', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FROCEAN', & + LONG_NAME = 'fraction_of_ocean', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FRACI', & + LONG_NAME = 'ice_covered_fraction_of_tile', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'PS', & + LONG_NAME = 'surface_pressure', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 101325.0, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'Q10M', & + LONG_NAME = '10-meter_specific_humidity', & + UNITS = 'kg kg', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.8, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'RH2M', & + LONG_NAME = 'near-surface_relative_humidity', & + UNITS = '%', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.8, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'T10M', & + LONG_NAME = '10-meter_air_temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 288.0, & + RESTART = MAPL_RestartSkip, __RC__) + + +! OGCM -> WM + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TW', & + LONG_NAME = 'temperature', & + UNITS = 'K', & + DIMS = MAPL_DimsHorzOnly, & + RESTART = MAPL_RestartSkip, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'UW', & + LONG_NAME = 'zonal_velocity_of_surface_water', & + UNITS = 'm s-1 ', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'VW', & + LONG_NAME = 'meridional_velocity_of_surface_water', & + UNITS = 'm s-1 ', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + DEFAULT = 0.0, & + RESTART = MAPL_RestartOptional, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'DW_WGCM', & + LONG_NAME = 'sea_floor_depth', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + +! call MAPL_AddImportSpec(GC, & +! SHORT_NAME = 'SSKINW', & +! LONG_NAME = 'water_skin_salinity', & +! UNITS = 'psu', & +! DIMS = MAPL_DimsHorzOnly, & +! VLOCATION = MAPL_VLocationNone, & +! DEFAULT = 30.0, & +! RESTART = MAPL_RestartSkip, __RC__) +! +! call MAPL_AddImportSpec(GC, & +! SHORT_NAME = 'HLATN', & +! LONG_NAME = 'total_latent_energy_flux', & +! UNITS = 'W m-2', & +! DIMS = MAPL_DimsHorzOnly, & +! VLOCATION = MAPL_VLocationNone, & +! DEFAULT = 0.0, & +! RESTART = MAPL_RestartSkip, __RC__) +! +! +! call MAPL_AddImportSpec(GC, & +! SHORT_NAME = 'SHOUT', & +! LONG_NAME = 'upward_sensible_heat_flux', & +! UNITS = 'W m-2', & +! DIMS = MAPL_DimsHorzOnly, & +! VLOCATION = MAPL_VLocationNone, & +! DEFAULT = 0.0, & +! RESTART = MAPL_RestartSkip, __RC__) +! + + +! !EXPORT STATE: + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'U10M', & + LONG_NAME = '10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'V10M', & + LONG_NAME = '10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'U10N', & + LONG_NAME = 'equivalent_neutral_10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'V10N', & + LONG_NAME = 'equivalent_neutral_10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'W10N', & + LONG_NAME = 'equivalent_neutral_10-meter_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'W10M', & + LONG_NAME = '10-meter_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'RHOS', & + LONG_NAME = 'air_density_at_surface', & + UNITS = 'kg m-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'UW', & + LONG_NAME = 'zonal_velocity_of_surface_water', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'VW', & + LONG_NAME = 'meridional_velocity_of_surface_water', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DW', & + LONG_NAME = 'sea_floor_depth', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LON2D', & + LONG_NAME = 'longitude', & + UNITS = 'degrees', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LAT2D', & + LONG_NAME = 'latitude', & + UNITS = 'degrees', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'NUW', & + LONG_NAME = 'sea_water_kinematic_viscosity', & + UNITS = 'm2 s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'FRACI', & + LONG_NAME = 'ice_covered_fraction_of_tile', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + + ! + ! UMWM diagnostics + ! + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWH', & + LONG_NAME = 'sea_surface_wave_significant_height', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWHW', & + LONG_NAME = 'sea_surface_wind_wave_significant_height', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWHS', & + LONG_NAME = 'sea_surface_swell_significant_height', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MWP', & + LONG_NAME = 'mean_wave_period', & + UNITS = 's', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MWD', & + LONG_NAME = 'mean_wave_direction', & + UNITS = 'rad', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MSS', & + LONG_NAME = 'mean_squared_slope', & + UNITS = 'rad', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'MWL', & + LONG_NAME = 'mean_wave_length', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DWD', & + LONG_NAME = 'dominant_wave_direction', & + UNITS = 'rad', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DWL', & + LONG_NAME = 'dominant_wave_length', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DWP', & + LONG_NAME = 'dominant_wave_period', & + UNITS = 's', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DCP0', & + LONG_NAME = 'dominant_phase_speed_intrinsic', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DCG0', & + LONG_NAME = 'dominant_group_speed_intrinsic', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DCP', & + LONG_NAME = 'dominant_phase_speed', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DCG', & + LONG_NAME = 'dominant_group_speed', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EDFX', & + LONG_NAME = 'wave_energy_dissipation_flux_x_component', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EDFY', & + LONG_NAME = 'wave_energy_dissipation_flux_y_component', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EDF', & + LONG_NAME = 'wave_energy_dissipation_flux', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EGFX', & + LONG_NAME = 'wave_energy_growth_flux_x_component', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EGFY', & + LONG_NAME = 'wave_energy_growth_flux_y_component', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EGF', & + LONG_NAME = 'wave_energy_growth_flux', & + UNITS = 'kg s-3', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'Z0', & + LONG_NAME = 'surface_roughness', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'CD', & + LONG_NAME = 'drag_coefficient_of_air', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'CHARNOCK', & + LONG_NAME = 'wave_model_charnock_coefficient', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAU', & + LONG_NAME = 'total drag', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAUX', & + LONG_NAME = 'total drag, x-component', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAUY', & + LONG_NAME = 'total drag, y-component', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAU_FORM', & + LONG_NAME = 'form drag', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAUX_FORM', & + LONG_NAME = 'form drag, x-component', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAUY_FORM', & + LONG_NAME = 'form drag, y-component', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAU_SKIN', & + LONG_NAME = 'skin drag', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAUX_SKIN', & + LONG_NAME = 'skin drag, x-component', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'TAUY_SKIN', & + LONG_NAME = 'skin drag, y-component', & + UNITS = 'N m-2', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + + +! Set the Profiling timers +! ------------------------ + + call MAPL_TimerAdd(GC, name='TOTAL' , __RC__) + call MAPL_TimerAdd(GC, name='INITIALIZE' , __RC__) + call MAPL_TimerAdd(GC, name='RUN' , __RC__) + call MAPL_TimerAdd(GC, name='-WM_SET' , __RC__) + call MAPL_TimerAdd(GC, name='-WM_INIT' , __RC__) + call MAPL_TimerAdd(GC, name='-WM_RUN' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_PHYSICS' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_DYNAMICS', __RC__) + call MAPL_TimerAdd(GC, name='--WM_ADVECT' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_REFRACT' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_S_IN' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_S_DS' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_S_NL' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_S_ICE' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_SOURCE' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_STRESS' , __RC__) + call MAPL_TimerAdd(GC, name='--WM_EXCHANGE_HALO', __RC__) + call MAPL_TimerAdd(GC, name='-WM_DIAG' , __RC__) + call MAPL_TimerAdd(GC, name='-WM_GET' , __RC__) + call MAPL_TimerAdd(GC, name='FINALIZE' , __RC__) + call MAPL_TimerAdd(GC, name='-WM_FINALIZE' , __RC__) + +! Set generic init and final methods +! ---------------------------------- + + call MAPL_GenericSetServices(GC, __RC__) + + RETURN_(ESMF_SUCCESS) + + end subroutine SetServices + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: INITIALIZE -- Initialize method for the UMWM component + +! !INTERFACE: + + subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + + type(ESMF_Alarm) :: run_alarm + type(ESMF_TimeInterval) :: ring_interval + real(ESMF_KIND_R8) :: time_step + + type (WaveModel_State), pointer :: self ! private internal state + type (WaveModel_Wrap) :: wrap + +! Local Variables + + integer :: COMM ! MPI communicator from VM + integer :: myPE + integer :: nPEs + integer :: IM, JM, LM + integer :: IM_world, JM_world + + real, pointer, dimension(:,:) :: LATS => NULL() + real, pointer, dimension(:,:) :: LONS => NULL() + + integer :: COUNTS(ESMF_MAXDIM) + + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Initialize' + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + +! Get my internal private state +! ----------------------------- + call ESMF_UserCompGetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + self => wrap%ptr + + +! Get layout from the grid +! ------------------------ + + call ESMF_VMGetCurrent(VM, __RC__) + + call ESMF_VMGet(VM, mpiCommunicator=COMM, localPet=myPE, petCount=nPEs, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'INITIALIZE', __RC__) + +! Get the grid +! ------------ + + call ESMF_GridCompGet( GC, grid=GRID, __RC__) + +! Call GenericInitialize +! ---------------------- + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:BeforeGenericInitialize', __RC__) + + call MAPL_GenericInitialize(GC, IMPORT, EXPORT, CLOCK, __RC__) + + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:AfterGenericInitialize', __RC__) + +! Get parameters from generic state. +! ---------------------------------- + + call MAPL_Get(MAPL, IM=IM, JM=JM, LM=LM, LATS=LATS, LONS=LONS, __RC__) + + call MAPL_GridGet(GRID, globalCellCountPerDim=COUNTS, __RC__) + + IM_world = COUNTS(1) + JM_world = COUNTS(2) + + +! Initialize UMWM +! --------------- + + !call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:BeforeGEOS_UMWM_INIT', __RC__) + + !call GEOS_UMWM_Initialize( COMM, ... , __RC__) + +! Get the time step +! ----------------- + call MAPL_Get(MAPL, RunAlarm=run_alarm, __RC__) + call ESMF_AlarmGet(run_alarm, ringInterval=ring_interval, __RC__) + + call ESMF_TimeIntervalGet(ring_interval, s_r8=time_step, __RC__) + self%dt = real(time_step) + + if (MAPL_AM_I_ROOT()) then + write (*, '(A, I0)') 'Wave model (dynamics) time step = ', nint(self%dt) + write (*, '(A, I0)') 'Wave model (dynamics) frequency bins = ', self%om + write (*, '(A, I0)') 'Wave model (dynamics) directions = ', self%pm + end if + + !call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:AfterGEOS_UMWM_INIT', __RC__) + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'INITIALIZE', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Initialize + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: RUN -- Run method for the UMWM component + +! !INTERFACE: + + subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Pointers from Internal state + real, pointer, dimension(:,:,:,:) :: WM_E => null() + real, pointer, dimension(:,:) :: WM_USTAR => null() + +! Pointers from Import state + real, pointer, dimension(:,:) :: U10N => null() + real, pointer, dimension(:,:) :: V10N => null() + real, pointer, dimension(:,:) :: U10M => null() + real, pointer, dimension(:,:) :: V10M => null() + real, pointer, dimension(:,:) :: RHOS => null() + + real, pointer, dimension(:,:) :: FRACICE => null() + + real, pointer, dimension(:,:) :: UW => null() + real, pointer, dimension(:,:) :: VW => null() + real, pointer, dimension(:,:) :: DW => null() + + real, pointer, dimension(:,:) :: TS => null() + real, pointer, dimension(:,:) :: TSKINW => null() + + real, pointer, dimension(:,:) :: PS => null() + real, pointer, dimension(:,:) :: Q10M => null() + real, pointer, dimension(:,:) :: T10M => null() + real, pointer, dimension(:,:) :: RH2M => null() + +! Pointers to Export state + real, pointer, dimension(:,:) :: WM_WIND_10N => null() + real, pointer, dimension(:,:) :: WM_WIND_10M => null() + + real, pointer, dimension(:,:) :: WM_U10N => null() + real, pointer, dimension(:,:) :: WM_V10N => null() + real, pointer, dimension(:,:) :: WM_U10M => null() + real, pointer, dimension(:,:) :: WM_V10M => null() + + real, pointer, dimension(:,:) :: WM_RHOS => null() + + real, pointer, dimension(:,:) :: WM_UW => null() + real, pointer, dimension(:,:) :: WM_VW => null() + real, pointer, dimension(:,:) :: WM_DW => null() + + real, pointer, dimension(:,:) :: WM_LON2D => null() + real, pointer, dimension(:,:) :: WM_LAT2D => null() + + real, pointer, dimension(:,:) :: WM_FRACICE => null() + + ! + ! UMWM diagnostics + ! + + real, pointer, dimension(:,:) :: WM_NUW => null() + + real, pointer, dimension(:,:) :: WM_SWH => null() + real, pointer, dimension(:,:) :: WM_SWHS => null() + real, pointer, dimension(:,:) :: WM_SWHW => null() + + real, pointer, dimension(:,:) :: WM_MWP => null() + real, pointer, dimension(:,:) :: WM_MWD => null() + real, pointer, dimension(:,:) :: WM_MSS => null() + real, pointer, dimension(:,:) :: WM_MWL => null() + real, pointer, dimension(:,:) :: WM_DWD => null() + real, pointer, dimension(:,:) :: WM_DWL => null() + real, pointer, dimension(:,:) :: WM_DWP => null() + real, pointer, dimension(:,:) :: WM_DCP0 => null() + real, pointer, dimension(:,:) :: WM_DCG0 => null() + real, pointer, dimension(:,:) :: WM_DCP => null() + real, pointer, dimension(:,:) :: WM_DCG => null() + + + real, pointer, dimension(:,:) :: WM_Z0 => null() + real, pointer, dimension(:,:) :: WM_CD => null() + real, pointer, dimension(:,:) :: WM_CHARNOCK => null() + + + real, pointer, dimension(:,:) :: WM_TAU => null() + real, pointer, dimension(:,:) :: WM_TAUX => null() + real, pointer, dimension(:,:) :: WM_TAUY => null() + + real, pointer, dimension(:,:) :: WM_TAU_FORM => null() + real, pointer, dimension(:,:) :: WM_TAUX_FORM => null() + real, pointer, dimension(:,:) :: WM_TAUY_FORM => null() + + real, pointer, dimension(:,:) :: WM_TAU_SKIN => null() + real, pointer, dimension(:,:) :: WM_TAUX_SKIN => null() + real, pointer, dimension(:,:) :: WM_TAUY_SKIN => null() + + real, pointer, dimension(:,:) :: WM_EDF => null() + real, pointer, dimension(:,:) :: WM_EDFX => null() + real, pointer, dimension(:,:) :: WM_EDFY => null() + + real, pointer, dimension(:,:) :: WM_EGF => null() + real, pointer, dimension(:,:) :: WM_EGFX => null() + real, pointer, dimension(:,:) :: WM_EGFY => null() + +! Local derived type aliases + + type(WaveModel_State), pointer:: self => null() + type(WaveModel_Wrap) :: wrap + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_State) :: INTERNAL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + +! Local global variables + + integer :: COUNTS(ESMF_MAXDIM) + +! Local Variables + + integer :: IM, JM, LM + integer :: IM_world, JM_world + integer :: COMM ! MPI communicator from VM + integer :: myPE + integer :: nPEs + + integer :: time_substeps + + integer :: i, j + integer :: o, p + + real, allocatable, dimension(:,:) :: tmp_global ! global 2d buffer + real, allocatable, dimension(:,:) :: tmp_global_x ! global 2d buffer (x-component) + real, allocatable, dimension(:,:) :: tmp_global_y ! global 2d buffer (y-component) + real, allocatable, dimension(:,:) :: tmp_local ! local 2d buffer + real, allocatable, dimension(:) :: tmp_unroll ! global 1d buffer + + real :: tau_, tau_form_, tau_skin_ + + real, pointer, dimension(:,:) :: LATS => NULL() + real, pointer, dimension(:,:) :: LONS => NULL() + + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Run' + + call ESMF_GridCompGet(GC, name=COMP_NAME, GRID=GRID, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'RUN', __RC__) + +! Get parameters from generic state. +! ---------------------------------- + + call MAPL_Get(MAPL, IM=IM, JM=JM, LM=LM, & + LATS=LATS, LONS=LONS, & + INTERNAL_ESMF_STATE=INTERNAL, __RC__) + + call MAPL_GridGet(GRID, globalCellCountPerDim=COUNTS, __RC__) + + IM_world = COUNTS(1) + JM_world = COUNTS(2) + +! Get layout from the grid +! ------------------------ + + call ESMF_VMGetCurrent(VM, __RC__) + + call ESMF_VMGet(VM, mpiCommunicator=COMM, localPet=myPE, petCount=nPEs, __RC__) + +! Get my internal private state +! ----------------------------- + call ESMF_UserCompGetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + self => wrap%ptr + +! Get pointers to inputs +! ---------------------- + call MAPL_GetPointer(INTERNAL, WM_E, 'E', __RC__) + call MAPL_GetPointer(INTERNAL, WM_USTAR, 'USTAR', __RC__) + + ! AGCM + call MAPL_GetPointer(IMPORT, U10N, 'U10N', __RC__) + call MAPL_GetPointer(IMPORT, V10N, 'V10N', __RC__) + + call MAPL_GetPointer(IMPORT, U10M, 'U10M', __RC__) + call MAPL_GetPointer(IMPORT, V10M, 'V10M', __RC__) + + call MAPL_GetPointer(IMPORT, RHOS, 'RHOS', __RC__) + + call MAPL_GetPointer(IMPORT, FRACICE, 'FRACI', __RC__) + + call MAPL_GetPointer(IMPORT, TS, 'TS', __RC__) + call MAPL_GetPointer(IMPORT, TSKINW, 'TSKINW', __RC__) + + call MAPL_GetPointer(IMPORT, PS, 'PS', __RC__) + call MAPL_GetPointer(IMPORT, Q10M, 'Q10M', __RC__) + call MAPL_GetPointer(IMPORT, T10M, 'T10M', __RC__) + call MAPL_GetPointer(IMPORT, RH2M, 'RH2M', __RC__) + + ! OGCM + call MAPL_GetPointer(IMPORT, UW, 'UW', __RC__) + call MAPL_GetPointer(IMPORT, VW, 'VW', __RC__) + call MAPL_GetPointer(IMPORT, DW, 'DW_WGCM', __RC__) + + + if (MAPL_AM_I_ROOT() .and. self%verbose) then + print *, 'DEBUG::UMWM DW = ', minval(DW), maxval(DW) + print *, 'DEBUG::UMWM VW = ', minval(VW), maxval(VW) + print *, 'DEBUG::UMWM W10N = ', minval(sqrt(U10N*U10N + V10N*V10N)), maxval(sqrt(U10N*U10N + V10N*V10N)) + print *, 'DEBUG::UMWM FRACICE = ', minval(FRACICE), maxval(FRACICE) + print *, 'DEBUG::UMWM TS = ', minval(TS), maxval(TS) + print *, 'DEBUG::UMWM TSKINW = ', minval(TSKINW), maxval(TSKINW) + + print *, 'DEBUG::UMWM E = ', minval(WM_E, mask=(WM_E/=MAPL_UNDEF)), maxval(WM_E, mask=(WM_E/=MAPL_UNDEF)) + print *, 'DEBUG::UMWM UST = ', minval(WM_USTAR, mask=(WM_USTAR/=MAPL_UNDEF)), maxval(WM_USTAR,mask=(WM_USTAR/=MAPL_UNDEF)) + end if + + + +! Get pointers from export state +! ------------------------------ + call MAPL_GetPointer(EXPORT, WM_WIND_10N, 'W10N', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_WIND_10M, 'W10M', alloc=.true., __RC__) + + call MAPL_GetPointer(EXPORT, WM_U10N, 'U10N', __RC__) + call MAPL_GetPointer(EXPORT, WM_V10N, 'V10N', __RC__) + call MAPL_GetPointer(EXPORT, WM_U10M, 'U10M', __RC__) + call MAPL_GetPointer(EXPORT, WM_V10M, 'V10M', __RC__) + + call MAPL_GetPointer(EXPORT, WM_RHOS, 'RHOS', __RC__) + + call MAPL_GetPointer(EXPORT, WM_UW, 'UW', __RC__) + call MAPL_GetPointer(EXPORT, WM_VW, 'VW', __RC__) + + call MAPL_GetPointer(EXPORT, WM_DW, 'DW', __RC__) + + call MAPL_GetPointer(EXPORT, WM_LON2D, 'LON2D', __RC__) + call MAPL_GetPointer(EXPORT, WM_LAT2D, 'LAT2D', __RC__) + + call MAPL_GetPointer(EXPORT, WM_NUW, 'NUW', __RC__) + + call MAPL_GetPointer(EXPORT, WM_FRACICE, 'FRACI', __RC__) + + + ! wave model diagnostics + call MAPL_GetPointer(EXPORT, WM_SWH, 'SWH', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_SWHS, 'SWHS', __RC__) + call MAPL_GetPointer(EXPORT, WM_SWHW, 'SWHW', __RC__) + + call MAPL_GetPointer(EXPORT, WM_MWP, 'MWP', __RC__) + call MAPL_GetPointer(EXPORT, WM_MWD, 'MWD', __RC__) + call MAPL_GetPointer(EXPORT, WM_MSS, 'MSS', __RC__) + call MAPL_GetPointer(EXPORT, WM_MWL, 'MWL', __RC__) + call MAPL_GetPointer(EXPORT, WM_DWD, 'DWD', __RC__) + call MAPL_GetPointer(EXPORT, WM_DWL, 'DWL', __RC__) + call MAPL_GetPointer(EXPORT, WM_DWP, 'DWP', __RC__) + call MAPL_GetPointer(EXPORT, WM_DCP0, 'DCP0', __RC__) + call MAPL_GetPointer(EXPORT, WM_DCG0, 'DCG0', __RC__) + call MAPL_GetPointer(EXPORT, WM_DCP, 'DCP', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_DCG, 'DCG', __RC__) + + + call MAPL_GetPointer(EXPORT, WM_Z0, 'Z0', __RC__) + call MAPL_GetPointer(EXPORT, WM_CD, 'CD', __RC__) + + call MAPL_GetPointer(EXPORT, WM_TAU, 'TAU', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_TAUX, 'TAUX', __RC__) + call MAPL_GetPointer(EXPORT, WM_TAUY, 'TAUY', __RC__) + call MAPL_GetPointer(EXPORT, WM_TAU_FORM, 'TAU_FORM', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_TAUX_FORM, 'TAUX_FORM', __RC__) + call MAPL_GetPointer(EXPORT, WM_TAUY_FORM, 'TAUY_FORM', __RC__) + call MAPL_GetPointer(EXPORT, WM_TAU_SKIN, 'TAU_SKIN', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_TAUX_SKIN, 'TAUX_SKIN', __RC__) + call MAPL_GetPointer(EXPORT, WM_TAUY_SKIN, 'TAUY_SKIN', __RC__) + + call MAPL_GetPointer(EXPORT, WM_EDF, 'EDF', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, WM_EDFX, 'EDFX', __RC__) + call MAPL_GetPointer(EXPORT, WM_EDFY, 'EDFY', __RC__) + + call MAPL_GetPointer(EXPORT, WM_EGF, 'EGF', __RC__) + call MAPL_GetPointer(EXPORT, WM_EGFX, 'EGFX', __RC__) + call MAPL_GetPointer(EXPORT, WM_EGFY, 'EGFY', __RC__) + + call MAPL_GetPointer(EXPORT, WM_CHARNOCK, 'CHARNOCK', alloc=.true., __RC__) + + +! Sanity diagnostics +! ------------------ + + ! wind + if (associated(WM_WIND_10N)) WM_WIND_10N = sqrt(U10N*U10N + V10N*V10N) + if (associated(WM_WIND_10M)) WM_WIND_10M = sqrt(U10M*U10M + V10M*V10M) + + if (associated(WM_U10N)) WM_U10N = U10N + if (associated(WM_V10N)) WM_V10N = V10N + if (associated(WM_U10M)) WM_U10M = U10M + if (associated(WM_V10M)) WM_V10M = V10M + + ! air density + if (associated(WM_RHOS)) WM_RHOS = RHOS + + ! surface currents + if (associated(WM_UW )) WM_UW = UW + if (associated(WM_VW )) WM_VW = VW + + ! ocean depth + if (associated(WM_DW )) WM_DW = DW + + ! sea-ice + if (associated(WM_FRACICE)) WM_FRACICE = FRACICE + + ! grid + if (associated(WM_LON2D)) WM_LON2D = (180.0/MAPL_PI) * LONS + if (associated(WM_LAT2D)) WM_LAT2D = (180.0/MAPL_PI) * LATS + + +! Call UMWM PHYSICS +! ----------------- + if (MAPL_AM_I_Root()) write (OUTPUT_UNIT,*) 'DEBUG::UMWM WM physics...' + + +! Wave model +! ----------------------------------------------------- +! 0. get ocean currents, etc... + +! ** For tiles not covered by sea-ice: +! 1. Initialize UMWM +! 2. Set UMWM state variables from the INTERNAL state +! 3. Update UMWM forcings from IMPORT state +! 4. Integrate sources in time +! 4.1 physics +! 5. Wave propagation +! 5.1 advection +! 5.2 refraction +! 6. Update UMWM diagnostics +! 7. Update INTERNAL state +! 8. Update EXPORTs +! 9. Free UMWM memory +! +! 99. interface with AGCM + + + call MAPL_TimerOn(MAPL, '-WM_SET' ) + + +! 1. Initialize UMWM +! ------------------------------------------------------ + umwm_isGlobal = .true. + umwm_restart = .true. + umwm_gridfromfile = .true. + umwm_topofromfile = .true. + + umwm_fillEstuaries = .false. + umwm_fillLakes = .false. + + umwm_g = MAPL_GRAV + umwm_kappa = MAPL_KARMAN + + umwm_z = 10.0 + + umwm_dtg = self%dt + + umwm_om = self%om + umwm_pm = self%pm + umwm_fmin = self%fmin + umwm_fmax = self%fmax + umwm_fprog = self%fprog + + umwm_fice_lth = self%fice_lth + umwm_fice_uth = self%fice_uth + + umwm_nu_air = self%nu_air + umwm_nu_water = self%nu_water + umwm_sfct = self%sfct + umwm_gustiness = self%gustiness + umwm_dmin = self%dmin + umwm_explim = self%explim + umwm_sin_fac = self%sin_fac + umwm_sin_diss1 = self%sin_diss1 + umwm_sin_diss2 = self%sin_diss2 + umwm_sds_fac = self%sds_fac + umwm_sds_power = self%sds_power + umwm_mss_fac = self%mss_fac + umwm_snl_fac = self%snl_fac + umwm_sdt_fac = self%sdt_fac + umwm_sbf_fac = self%sbf_fac + umwm_sbp_fac = self%sbp_fac + + + allocate(tmp_local(IM, JM), __STAT__) + allocate(tmp_global(IM_world, JM_world), __STAT__) + allocate(tmp_unroll(IM_world*JM_world), __STAT__) + + umwm_mm = IM_world ! domain size in x + umwm_nm = JM_world ! domain size in y + + call umwm_environment('init') + + call umwm_alloc(1) + + ! global grid + call set_global_2d(tmp_global, LONS, VM, GRID, __RC__) + umwm_lon = (180.0/MAPL_PI) * tmp_global + + call set_global_2d(tmp_global, LATS, VM, GRID, __RC__) + umwm_lat = (180.0/MAPL_PI) * tmp_global + + + ! ocean depth + tmp_local = DW + where ( (180.0/MAPL_PI) * LATS > NORTH_POLE_CAP_LATITUDE) tmp_local = tiny(0.0) + call set_global_2d(umwm_d_2d, tmp_local, VM, GRID, RC) + + ! maskout the North pole by treating it as land points + !!!where (umwm_lat > NORTH_POLE_CAP_LATITUDE) umwm_d_2d = tiny(umwm_d_2d) + + ! ...also mask out cells with high sea-ice fraction + !tmp_local = FRACICE + !where (tmp_local == MAPL_UNDEF) tmp_local = 0.0 + !call set_global_2d(tmp_global, tmp_local, VM, GRID, __RC__) + !where (tmp_global >= FRACTION_ICE_SUPPRESS_WAVES) umwm_d_2d = tiny(umwm_d_2d) + + call umwm_grid() !!! TODO: all arrays are time invariant, no need to do math at every time step + call umwm_masks() + + call umwm_partition() + + call umwm_alloc(2) + call umwm_remap() + + call MAPL_TimerOff(MAPL, '-WM_SET' ) + + + UMWM_WAVE_MODEL: if (.true.) then !!! umwm_im > 0 .or. .true.) then + + call MAPL_TimerOn(MAPL, '-WM_SET' ) + + ! wind speed + call set_global_2d(tmp_global, WM_WIND_10N, VM, GRID, __RC__) + umwm_wspd = umwm_remap_mn2i(tmp_global) + + + ! wind direction + call set_global_2d(tmp_global, atan2(V10N, U10N), VM, GRID, __RC__) + umwm_wdir = umwm_remap_mn2i(tmp_global) + + ! air density + call set_global_2d(tmp_global, RHOS, VM, GRID, __RC__) + umwm_rhoa = umwm_remap_mn2i(tmp_global) + + ! temperature dependent water viscosity assuming salinity of 35g/kg + call seawater_viscosity(tmp_local, TS, 35e-3, MAPL_RHO_SEAWATER, __RC__) + call set_global_2d(tmp_global, tmp_local, VM, GRID, __RC__) + tmp_unroll = umwm_remap_mn2i(tmp_global) + umwm_nu_water_ = tmp_unroll(umwm_istart:umwm_iend) + !!!umwm_nu_water_ = (1.2 + umwm_nproc/200.0)*1e-6 + + + ! ocean currents + tmp_local = UW + where (tmp_local == MAPL_UNDEF) tmp_local = 0.0 + call set_global_2d(tmp_global, tmp_local, VM, GRID, __RC__) + umwm_uc = umwm_remap_mn2i(tmp_global) + + tmp_local = VW + where (tmp_local == MAPL_UNDEF) tmp_local = 0.0 + call set_global_2d(tmp_global, tmp_local, VM, GRID, __RC__) + umwm_vc = umwm_remap_mn2i(tmp_global) + + ! sea ice + tmp_local = FRACICE + where (tmp_local == MAPL_UNDEF) tmp_local = 0.0 + where (tmp_local > 1.0) tmp_local = 1.0 + where (tmp_local <= 0.0) tmp_local = tiny(0.0) + call set_global_2d(tmp_global, tmp_local, VM, GRID, __RC__) + umwm_fice = umwm_remap_mn2i(tmp_global) + + ! water density + umwm_rhow = MAPL_RHO_SEAWATER ! constant value, no need to gather/broadcast + umwm_rhow0 = MAPL_RHO_SEAWATER ! ...dito + umwm_rhorat = umwm_rhoa / umwm_rhow ! ...dito + + call MAPL_TimerOff(MAPL, '-WM_SET' ) + + + call MAPL_TimerOn(MAPL, '-WM_INIT' ) + + call umwm_initialize() + + call MAPL_TimerOff(MAPL, '-WM_INIT' ) + + + call MAPL_TimerOn(MAPL, '-WM_SET' ) + ! wave emergy + do p = 1, umwm_pm + do o = 1, umwm_om + where (WM_E(:,:,o,p) == MAPL_UNDEF) WM_E(:,:,o,p) = 0.0 + call set_global_2d(tmp_global, WM_E(:,:,o,p), VM, GRID, __RC__) + tmp_unroll = umwm_remap_mn2i(tmp_global) + umwm_e(o,p,umwm_istart:umwm_iend) = tmp_unroll(umwm_istart:umwm_iend) + end do + end do + + ! friction velocity + where (WM_USTAR == MAPL_UNDEF) WM_USTAR = 0.0 + call set_global_2d(tmp_global, WM_USTAR, VM, GRID, __RC__) + tmp_unroll = umwm_remap_mn2i(tmp_global) + umwm_ustar = tmp_unroll(umwm_istart:umwm_iend) + + call MAPL_TimerOff(MAPL, '-WM_SET' ) + + + if (MAPL_AM_I_ROOT() .and. self%verbose) then + write (*, '(A)' ) 'UMWM is initialized' + end if + + call MAPL_TimerOn(MAPL, '-WM_RUN' ) + + umwm_sumt = 0.0 + time_substeps = 0 + + ADVANCE_IN_TIME: do while (umwm_sumt < umwm_dtg) + + call MAPL_TimerOn(MAPL, '--WM_PHYSICS' ) + +#ifdef DEBUG + if (MAPL_AM_I_ROOT()) write (*, '(A)' ) 'UMWM integrate source functions...' +#endif + + call MAPL_TimerOn(MAPL, '--WM_S_IN') + call umwm_s_in() ! compute source input term Sin + call MAPL_TimerOff(MAPL, '--WM_S_IN') + + call MAPL_TimerOn(MAPL, '--WM_S_DS') + call umwm_s_ds() ! compute source dissipation term Sds + call MAPL_TimerOff(MAPL, '--WM_S_DS') + + call MAPL_TimerOn(MAPL, '--WM_S_NL') + call umwm_s_nl() ! compute non-linear source term Snl + call MAPL_TimerOff(MAPL, '--WM_S_NL') + + call MAPL_TimerOn(MAPL, '--WM_S_ICE') + call umwm_s_ice() ! compute sea ice attenuation term Sice + call MAPL_TimerOff(MAPL, '--WM_S_ICE') + + + call MAPL_TimerOn(MAPL, '--WM_SOURCE') + call umwm_source() ! integrate source functions + call MAPL_TimerOff(MAPL, '--WM_SOURCE') + + call MAPL_TimerOn(MAPL, '--WM_EXCHANGE_HALO') + call umwm_exchange_halo() ! exchange halo points + call MAPL_TimerOff(MAPL, '--WM_EXCHANGE_HALO') + + call MAPL_TimerOff(MAPL, '--WM_PHYSICS' ) + + + call MAPL_TimerOn(MAPL, '--WM_DYNAMICS') + + call umwm_propagation() + umwm_e(:,:,umwm_istart:umwm_iend) = umwm_ef(:,:,umwm_istart:umwm_iend) + + + call umwm_refraction() + umwm_e(:,:,umwm_istart:umwm_iend) = umwm_ef(:,:,umwm_istart:umwm_iend) + + call MAPL_TimerOff(MAPL, '--WM_DYNAMICS') + + + call MAPL_TimerOn(MAPL, '--WM_STRESS' ) + call umwm_stress_('atm') ! compute wind stress and drag coefficient + call umwm_stress_('ocn') ! compute stress into ocean top and bottom + call MAPL_TimerOff(MAPL, '--WM_STRESS' ) + + + time_substeps = time_substeps + 1 +#ifdef DEBUG + if (MAPL_AM_I_ROOT()) write (*, '(F5.3)' ) umwm_sumt/umwm_dtg +#endif + end do ADVANCE_IN_TIME + + call MAPL_TimerOff(MAPL, '-WM_RUN' ) + +#ifdef DEBUG + if (self%verbose) print *, 'DEBUG::UMWM time substeps =', time_substeps +#endif + + if (MAPL_AM_I_ROOT() .and. self%verbose) then + write (*, '(A)' ) 'UMWM time integration is done for this time step.' + end if + + + call MAPL_TimerOn(MAPL, '-WM_DIAG') + +!!! call umwm_stokes_drift() + call umwm_diag() + + call MAPL_TimerOff(MAPL, '-WM_DIAG') + + + if (MAPL_AM_I_ROOT() .and. self%verbose) then + write (*, '(A)' ) 'UMWM diagnostics is done for this time step.' + end if + + + call MAPL_TimerOn(MAPL, '-WM_GET' ) + ! copy out state variables and diagnostics + + do p = 1, umwm_pm + do o = 1, umwm_om + call umwm_gatherfield(umwm_e(o,p,umwm_istart:umwm_iend), tmp_global) + call ArrayScatter(WM_E(:,:,o,p), tmp_global, GRID, __RC__) + where (isnan(WM_E(:,:,o,p))) WM_E(:,:,o,p) = MAPL_UNDEF + end do + end do + + + call umwm_gatherfield(umwm_ustar, tmp_global) + call ArrayScatter(WM_USTAR, tmp_global, GRID, __RC__ ) + where (isnan(WM_USTAR)) WM_USTAR = MAPL_UNDEF + + call MAPL_TimerOff(MAPL, '-WM_GET' ) + + + if (MAPL_AM_I_ROOT() .and. self%verbose) then + print *, 'DEBUG::UMWM _E = ', minval(WM_E, mask=(WM_E/=MAPL_UNDEF)), maxval(WM_E, mask=(WM_E/=MAPL_UNDEF)) + print *, 'DEBUG::UMWM _UST = ', minval(WM_USTAR, mask=(WM_USTAR/=MAPL_UNDEF)), maxval(WM_USTAR, mask=(WM_USTAR/=MAPL_UNDEF)) + end if + + end if UMWM_WAVE_MODEL + + + if (associated(WM_NUW)) then + call umwm_gatherfield(umwm_nu_water_, tmp_global) + call ArrayScatter(WM_NUW, tmp_global, GRID, __RC__) + where (isnan(WM_NUW)) WM_NUW = MAPL_UNDEF + end if + + if (associated(WM_SWH)) then + call umwm_gatherfield(umwm_ht, tmp_global) + call ArrayScatter(WM_SWH, tmp_global, GRID, __RC__ ) + where (isnan(WM_SWH)) WM_SWH = MAPL_UNDEF + end if + + if (associated(WM_SWHS)) then + call umwm_gatherfield(umwm_hts, tmp_global) + call ArrayScatter(WM_SWHS, tmp_global, GRID, __RC__ ) + where (isnan(WM_SWHS)) WM_SWHS = MAPL_UNDEF + end if + + if (associated(WM_SWHW)) then + call umwm_gatherfield(umwm_htw, tmp_global) + call ArrayScatter(WM_SWHW, tmp_global, GRID, __RC__ ) + where (isnan(WM_SWHW)) WM_SWHW = MAPL_UNDEF + end if + + if (associated(WM_MWP)) then + call umwm_gatherfield(umwm_mwp, tmp_global) + call ArrayScatter(WM_MWP, tmp_global, GRID, __RC__ ) + where (isnan(WM_MWP)) WM_MWP = MAPL_UNDEF + end if + + if (associated(WM_MWD)) then + call umwm_gatherfield(umwm_mwd, tmp_global) + call ArrayScatter(WM_MWD, tmp_global, GRID, __RC__ ) + where (isnan(WM_MWD)) WM_MWD = MAPL_UNDEF + end if + + if (associated(WM_MSS)) then + call umwm_gatherfield(umwm_mss, tmp_global) + call ArrayScatter(WM_MSS, tmp_global, GRID, __RC__ ) + where (isnan(WM_MSS)) WM_MSS = MAPL_UNDEF + end if + + if (associated(WM_MWL)) then + call umwm_gatherfield(umwm_mwl, tmp_global) + call ArrayScatter(WM_MWL, tmp_global, GRID, __RC__ ) + where (isnan(WM_MWL)) WM_MWL = MAPL_UNDEF + end if + + if (associated(WM_DWD)) then + call umwm_gatherfield(umwm_dwd, tmp_global) + call ArrayScatter(WM_DWD, tmp_global, GRID, __RC__ ) + where (isnan(WM_DWD)) WM_DWD = MAPL_UNDEF + end if + + if (associated(WM_DWL)) then + call umwm_gatherfield(umwm_dwl, tmp_global) + call ArrayScatter(WM_DWL, tmp_global, GRID, __RC__ ) + where (isnan(WM_DWL)) WM_DWL = MAPL_UNDEF + end if + + if (associated(WM_DWP)) then + call umwm_gatherfield(umwm_dwp, tmp_global) + call ArrayScatter(WM_DWP, tmp_global, GRID, __RC__ ) + where (isnan(WM_DWP)) WM_DWP = MAPL_UNDEF + end if + + if (associated(WM_DCP0)) then + call umwm_gatherfield(umwm_dcp0, tmp_global) + call ArrayScatter(WM_DCP0, tmp_global, GRID, __RC__ ) + where (isnan(WM_DCP0)) WM_DCP0 = MAPL_UNDEF + end if + + if (associated(WM_DCG0)) then + call umwm_gatherfield(umwm_dcg0, tmp_global) + call ArrayScatter(WM_DCG0, tmp_global, GRID, __RC__ ) + where (isnan(WM_DCG0)) WM_DCG0 = MAPL_UNDEF + end if + + if (associated(WM_DCP)) then + call umwm_gatherfield(umwm_dcp, tmp_global) + call ArrayScatter(WM_DCP, tmp_global, GRID, __RC__ ) + where (isnan(WM_DCP)) WM_DCP = MAPL_UNDEF + end if + + if (associated(WM_DCG)) then + call umwm_gatherfield(umwm_dcg, tmp_global) + call ArrayScatter(WM_DCG, tmp_global, GRID, __RC__ ) + where (isnan(WM_DCG)) WM_DCG = MAPL_UNDEF + end if + + if (associated(WM_CD)) then + call umwm_gatherfield(umwm_cd, tmp_global) + call ArrayScatter(WM_CD, tmp_global, GRID, __RC__ ) + where (isnan(WM_CD)) WM_CD = MAPL_UNDEF + end if + + if (associated(WM_TAU)) then + allocate(tmp_global_x(IM_world, JM_world), __STAT__) + allocate(tmp_global_y(IM_world, JM_world), __STAT__) + + call umwm_gatherfield(umwm_taux, tmp_global_x) + call umwm_gatherfield(umwm_tauy, tmp_global_y) + + where(isnan(tmp_global_x) .or. isnan(tmp_global_x)) + tmp_global = MAPL_UNDEF + elsewhere + tmp_global = sqrt(tmp_global_x**2 + tmp_global_y**2) + end where + + call ArrayScatter(WM_TAU, tmp_global, GRID, __RC__ ) + + deallocate(tmp_global_x) + deallocate(tmp_global_y) + end if + + if (associated(WM_TAU_FORM)) then + allocate(tmp_global_x(IM_world, JM_world), __STAT__) + allocate(tmp_global_y(IM_world, JM_world), __STAT__) + + call umwm_gatherfield(umwm_taux_form, tmp_global_x) + call umwm_gatherfield(umwm_tauy_form, tmp_global_y) + + where(isnan(tmp_global_x) .or. isnan(tmp_global_x)) + tmp_global = MAPL_UNDEF + elsewhere + tmp_global = sqrt(tmp_global_x**2 + tmp_global_y**2) + end where + + call ArrayScatter(WM_TAU_FORM, tmp_global, GRID, __RC__ ) + + deallocate(tmp_global_x) + deallocate(tmp_global_y) + end if + + if (associated(WM_TAU_SKIN)) then + allocate(tmp_global_x(IM_world, JM_world), __STAT__) + allocate(tmp_global_y(IM_world, JM_world), __STAT__) + + call umwm_gatherfield(umwm_taux_skin, tmp_global_x) + call umwm_gatherfield(umwm_tauy_skin, tmp_global_y) + + where(isnan(tmp_global_x) .or. isnan(tmp_global_x)) + tmp_global = MAPL_UNDEF + elsewhere + tmp_global = sqrt(tmp_global_x**2 + tmp_global_y**2) + end where + + call ArrayScatter(WM_TAU_SKIN, tmp_global, GRID, __RC__ ) + + deallocate(tmp_global_x) + deallocate(tmp_global_y) + end if + + if (associated(WM_EDF)) then + allocate(tmp_global_x(IM_world, JM_world), __STAT__) + allocate(tmp_global_y(IM_world, JM_world), __STAT__) + + call umwm_gatherfield(umwm_epsx_ocn, tmp_global_x) + call umwm_gatherfield(umwm_epsy_ocn, tmp_global_y) + + where(isnan(tmp_global_x) .or. isnan(tmp_global_x)) + tmp_global = MAPL_UNDEF + elsewhere + tmp_global = sqrt(tmp_global_x**2 + tmp_global_y**2) + end where + + call ArrayScatter(WM_EDF, tmp_global, GRID, __RC__ ) + + deallocate(tmp_global_x) + deallocate(tmp_global_y) + end if + + if (associated(WM_EDFX)) then + call umwm_gatherfield(umwm_epsx_ocn, tmp_global) + call ArrayScatter(WM_EDFX, tmp_global, GRID, __RC__ ) + where (isnan(WM_EDFX)) WM_EDFX = MAPL_UNDEF + end if + + if (associated(WM_EDFY)) then + call umwm_gatherfield(umwm_epsy_ocn, tmp_global) + call ArrayScatter(WM_EDFY, tmp_global, GRID, __RC__ ) + where (isnan(WM_EDFY)) WM_EDFY = MAPL_UNDEF + end if + + if (associated(WM_EGF)) then + allocate(tmp_global_x(IM_world, JM_world), __STAT__) + allocate(tmp_global_y(IM_world, JM_world), __STAT__) + + call umwm_gatherfield(umwm_epsx_atm, tmp_global_x) + call umwm_gatherfield(umwm_epsy_atm, tmp_global_y) + + where(isnan(tmp_global_x) .or. isnan(tmp_global_x)) + tmp_global = MAPL_UNDEF + elsewhere + tmp_global = sqrt(tmp_global_x**2 + tmp_global_y**2) + end where + + call ArrayScatter(WM_EGF, tmp_global, GRID, __RC__ ) + + deallocate(tmp_global_x) + deallocate(tmp_global_y) + end if + + if (associated(WM_EGFX)) then + call umwm_gatherfield(umwm_epsx_atm, tmp_global) + call ArrayScatter(WM_EGFX, tmp_global, GRID, __RC__ ) + where (isnan(WM_EGFX)) WM_EGFX = MAPL_UNDEF + end if + + if (associated(WM_EGFY)) then + call umwm_gatherfield(umwm_epsy_atm, tmp_global) + call ArrayScatter(WM_EGFY, tmp_global, GRID, __RC__ ) + where (isnan(WM_EGFY)) WM_EGFY = MAPL_UNDEF + end if + + !TODO: implement in UMWM rather than in GEOS + DIAGNOSTICS_CHARNOCK: if (associated(WM_CHARNOCK)) then + + do j = 1, JM + do i = 1, IM + tau_ = WM_TAU(i,j) + tau_form_ = WM_TAU_FORM(i,j) + tau_skin_ = WM_TAU_SKIN(i,j) + + if (tau_ /= MAPL_UNDEF) then + if (tau_ > tiny(tau_)) then + WM_CHARNOCK(i,j) = self%charnock_sf / sqrt(1 - min(0.99, tau_form_/tau_)) + else + WM_CHARNOCK(i,j) = 0.0185 + end if + else + WM_CHARNOCK(i,j) = MAPL_UNDEF + end if + + end do + end do + + where (FRACICE > FRACTION_ICE_SUPPRESS_WAVES) WM_CHARNOCK = 0.0 + + !TODO : temporary workaround until W2A recognizes MAPL_UNDEF + where (WM_CHARNOCK == MAPL_UNDEF) WM_CHARNOCK = 0.0 + + end if DIAGNOSTICS_CHARNOCK + + + DIAGNOSTICS_Z0: if (associated(WM_Z0)) then + + WM_Z0 = MAPL_UNDEF + + where (WM_CHARNOCK /= MAPL_UNDEF .and. WM_USTAR /= MAPL_UNDEF) +! WM_Z0 = WM_CHARNOCK * WM_USTAR**2 / MAPL_GRAV + WM_Z0 = (0.11*MAPL_NUAIR)/max(1e-6, WM_USTAR) + WM_CHARNOCK * WM_USTAR**2 / MAPL_GRAV + end where + + ! TODO: for now default to GEOS:OCEANICEZ0=1e-3 m over sea ice + where (FRACICE > FRACTION_ICE_SUPPRESS_WAVES) WM_Z0 = 1.0e-3 + + end if DIAGNOSTICS_Z0 + + +! Free the memory used by UMWM +! ----------------------------- + call umwm_dealloc() + call umwm_environment('stop') + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'RUN', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Run + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: FINALIZE -- Finalize method for the UMWM component + +! !INTERFACE: + + subroutine Finalize(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + +! Local global variables + + integer :: COUNTS(ESMF_MAXDIM) + +! Local Variables + + integer :: IM, JM, LM + integer :: IM_world, JM_world + integer :: COMM ! MPI communicator from VM + integer :: myPE + integer :: nPEs + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Finalize' + call ESMF_GridCompGet(GC, name=COMP_NAME, GRID=GRID, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'FINALIZE', __RC__) + +! Get parameters from generic state. +! ---------------------------------- + + call MAPL_Get(MAPL, IM=IM, JM=JM, LM=LM, __RC__) + + call MAPL_GridGet(GRID, globalCellCountPerDim=COUNTS, __RC__) + + IM_world = COUNTS(1) + JM_world = COUNTS(2) + +! Get layout from the grid +! ------------------------ + + call ESMF_VMGetCurrent(VM, __RC__) + + call ESMF_VMGet(VM, mpiCommunicator=COMM, localPet=myPE, petCount=nPEs, __RC__) + +! Get parameters +!--------------- + +! Call UMWM_FINALIZE +! ------------ + + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:BeforeGEOS_UMWM_FINALIZE', __RC__) + + call MAPL_TimerOn(MAPL, '-WM_FINALIZE', __RC__) + + !call GEOS_UMWM_FINALIZE( ... , __RC__) + + call MAPL_TimerOff(MAPL, '-WM_FINALIZE', __RC__) + + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:AfterGEOS_UMWM_FINALIZE', __RC__) + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'FINALIZE', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + +! Call GenericFinalize +! ---------------------- + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:BeforeGenericFinalize', __RC__) + + call MAPL_GenericFinalize(GC, IMPORT, EXPORT, CLOCK, __RC__) + VERIFY_(STATUS) + + call MAPL_MemUtilsWrite(VM, 'GEOSUMWM_GridComp:AfterGenericFinalize', __RC__) + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Finalize + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: set_global_2d -- gather a GEOS 2D variable into a global 2D array, +! ! used to update/set the UMWM forcings + +! !INTERFACE: + + subroutine set_global_2d(var_global, var_local, VM, GRID, RC) + + implicit none + +! !ARGUMENTS: + + real, dimension(:,:), intent(in ) :: var_local + real, dimension(:,:), intent(out) :: var_global + + type(ESMF_Grid), intent(in) :: GRID + type(ESMF_VM), intent(in) :: VM + + integer, intent(out) :: RC + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + + +! Local Variables +! none + + Iam = 'UMWMGridComp::set_global_2d()' + + call ArrayGather(var_local, var_global, GRID, __RC__) + call MAPL_CommsBcast(VM, DATA=var_global, N=size(var_global), ROOT=0, __RC__) + + RETURN_(ESMF_SUCCESS) + + end subroutine set_global_2d + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: seawater_viscosity +! ! + +! !INTERFACE: + + subroutine seawater_viscosity(nu, T, S, rho, RC) + + implicit none + +! !ARGUMENTS: + + real, dimension(:,:), intent(in ) :: T ! temperature of water, K + real, intent(in ) :: S ! salinity, kg/kg + real, intent(in ) :: rho ! density of water, kg/m3 + real, dimension(:,:), intent(out) :: nu ! kinematic viscosity, m2/s + + integer, intent(out) :: RC + +! ! DESCRIPTION: parameterization of kinematic sea water viscosity -- +! ! based on Thermophysical properties of seawater: +! ! A review of existing correlations and data, Desalination and Water Treatment, +! ! Vol. 16, pp.354-380, April 2010. +! ! ...with corrections from http://web.mit.edu/seawater/ and +! ! http://web.mit.edu/lienhard/www/Thermophysical_properties_of_seawater-DWT-16-354-2010.pdf + + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + + +! Local Variables +! + real, allocatable, dimension(:,:) :: Tc + real, allocatable, dimension(:,:) :: mu_w + real, allocatable, dimension(:,:) :: A, B + + + Iam = 'UMWMGridComp::seawater_viscosity()' + + allocate(Tc, mold=T, __STAT__) + allocate(mu_w, mold=T, __STAT__) + allocate(A, mold=T, __STAT__) + allocate(B, mold=T, __STAT__) + + Tc = max(0.0, T - 273.15) + + ! dynamic viscosity of pure water, IAPWS 2008 + mu_w = 4.2844e-5 + 1.0/(0.157*(Tc + 64.993)**2 - 91.296) + + A = 1.541 + 1.998e-2*Tc - 9.520e-5*Tc**2 + B = 7.974 - 7.561e-2*Tc + 4.724e-4*Tc**2 + + nu = mu_w*(1 + A*S + B*S**2)/rho + + RETURN_(ESMF_SUCCESS) + + end subroutine seawater_viscosity + + + + +end module GEOS_UMWMGridCompMod + + + diff --git a/GEOSwgcm_GridComp/GEOSumwm_GridComp/UMWM.rc b/GEOSwgcm_GridComp/GEOSumwm_GridComp/UMWM.rc new file mode 100644 index 000000000..88b017fbd --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSumwm_GridComp/UMWM.rc @@ -0,0 +1,43 @@ +# +# Resource file for the University of Miamy Wave Model (UMWM) +# + +verbose: .true. + +FREQUENCIES: 37 # number of frequency/wavenumber bins +DIRECTIONS: 36 # number of direction bins + +MIN_FREQUENCY: 3.13e-2 # lowest frequency bin, Hz +MAX_FREQUENCY: 2.0 # highest frequency bin, Hz +MAX_PROGNFREQ: 2.0 # highest prognostic frequency bin, Hz + +N_SPLIT: 1 # substep time-splitting +MAX_SUBSTEPS: 20 # max number of sub-steps + +SEAICE_LTH: 0.30 # Sea ice fraction - lower threshold for attenuation +SEAICE_UTH: 0.75 # Sea ice fraction - upper threshold for attenuation + +CHARNOCK_SF: 0.013 # Value of Charnock when wave supported stress is 0 + +STOKES:.true. +STOKE_DEPTHS: 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 1.2 1.4 1.6 1.8 2.0 2.4 2.8 3.2 3.6 4.0 4.5 5.0 6 7 8 9 10 12 14 16 18 20 24 28 32 40 50 60 70 80 90 100 + +# ------------------------------------------------------------------- +# misc parameters +# ------------------------------------------------------------------- + nu_air: 1.56e-5 # kinematic viscosity of air, m2 s-1 + nu_water: 1.20e-6 # kinematic viscosity of water (~15 C), m2 s-1 + sfct: 0.07 # surface tension, N m-1 +gustiness: 0.0 # random wind gustiness factor (0 ~ 0.2) + dmin: 10.0 # depth limiter, m + explim: 0.9 # exponent limiter (0.69 ~ 100% growth) + sin_fac: 0.11 # input factor from following winds +sin_diss1: 0.10 # damping factor from opposing winds +sin_diss2: 0.001 # damping factor from swell overrunning wind + sds_fac: 42.0 # breaking dissipation factor +sds_power: 2.4 # saturation spectrum power + mss_fac: 360 # mean-square-slope adjustment to Sds + snl_fac: 5.0 # wave energy downshifting factor + sdt_fac: 0.002 # dissipation due to turbulence factor + sbf_fac: 0.003 # bottom friction coefficient, m s-1 + sbp_fac: 0.003 # bottom percolation coefficient, m s-1 diff --git a/GEOSwgcm_GridComp/GEOSumwm_GridComp/UMWM_ExtData.yaml b/GEOSwgcm_GridComp/GEOSumwm_GridComp/UMWM_ExtData.yaml new file mode 100644 index 000000000..aef2867f4 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSumwm_GridComp/UMWM_ExtData.yaml @@ -0,0 +1,29 @@ +Exports: + DW_WGCM: + collection: /dev/null + linear_transformation: [-3682.0, 0.0] + +# -- +# +# Comment: +# configuration: GEOS/WGCM/UMWM +# description: realistic currents and ocean depth +# +# Samplings: +# static: +# extrapolation: persist_closest +# +# Collections: +# gebco_terrain_model_for_ocean_and_land: +# template: /discover/nobackup/projects/gmao/geos-wmma/data/gebco2008.ocean_depth.nc4 +# s2s_ana_ocean: +# template: /discover/nobackup/projects/gmao/geos-wmma/data/S2S-2_1_ANA_001/S2S-2_1_ANA_001.geosgcm_ocn2d_720x361.%y4%m2%d2_1200z.nc4 +# +# Exports: +# DATA_UW;DATA_VW: +# collection: /dev/null +# variable: none;none +# DW_WGCM: +# collection: gebco_terrain_model_for_ocean_and_land +# sample: static +# variable: elevation diff --git a/GEOSwgcm_GridComp/GEOSumwm_GridComp/umwm_cmake/CMakeLists.txt b/GEOSwgcm_GridComp/GEOSumwm_GridComp/umwm_cmake/CMakeLists.txt new file mode 100644 index 000000000..d7ecc0f89 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSumwm_GridComp/umwm_cmake/CMakeLists.txt @@ -0,0 +1,36 @@ +esma_set_this (OVERRIDE umwm) + +list (APPEND UMWM_SRCS + src/umwm_mpi.F90 + src/umwm_io.F90 + src/umwm_util.F90 + src/umwm_module.F90 + src/umwm_constants.F90 + src/umwm_init.F90 + src/umwm_sheltering.F90 + src/umwm_source_functions.F90 + src/umwm_physics.F90 + src/umwm_advection.F90 + src/umwm_stress.F90 + src/umwm_stokes.F90 +) + +esma_mepo_style(umwm UMWM_rel_path REL_PATH ..) +set (UMWM_path ${CMAKE_CURRENT_SOURCE_DIR}/${UMWM_rel_path}) + +set (SRCS) +foreach (file ${UMWM_SRCS}) + list (APPEND SRCS ${UMWM_path}/${file}) +endforeach () + +esma_add_library (${this} + SRCS ${SRCS} + DEPENDENCIES esmf NetCDF::NetCDF_Fortran +) + +target_compile_definitions(${this} PRIVATE MPI ESMF GEOS) + +if (CMAKE_Fortran_COMPILER_ID MATCHES Intel AND CMAKE_BUILD_TYPE MATCHES Release) + target_compile_options (${this} PRIVATE "-ftrapuv") +endif () + diff --git a/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/.gitignore b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/.gitignore new file mode 100644 index 000000000..0852f34e6 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/.gitignore @@ -0,0 +1,4 @@ +/@ww3 +/ww3 +/ww3@ + diff --git a/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/CMakeLists.txt b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/CMakeLists.txt new file mode 100644 index 000000000..8abfc994f --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/CMakeLists.txt @@ -0,0 +1,26 @@ +esma_set_this () + +set (alldirs + ww3_multi_esmf + ) + +if (EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/GEOS_WaveWatchGridComp.F90) + + esma_add_library (${this} + SRCS GEOS_WaveWatchGridComp.F90 + SUBCOMPONENTS ${alldirs} + DEPENDENCIES MAPL esmf + ) + +else () + + esma_add_subdirectories (${alldirs}) + +endif() + + +file (GLOB_RECURSE rc_files RELATIVE ${CMAKE_CURRENT_SOURCE_DIR} *.rc) +foreach ( file ${rc_files} ) + get_filename_component( dir ${file} DIRECTORY ) + install( FILES ${file} DESTINATION etc/${dir} ) +endforeach() diff --git a/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/GEOS_WaveWatchGridComp.F90 b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/GEOS_WaveWatchGridComp.F90 new file mode 100644 index 000000000..c7fc934f9 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/GEOS_WaveWatchGridComp.F90 @@ -0,0 +1,800 @@ + +#include "MAPL_Generic.h" + +!============================================================================= +!BOP + +! !MODULE: GEOS_WgcmGridCompMod -- A Module to compute wave properties via the +! wavewatch3 wave model + +! !INTERFACE: + +#define RUN_COUPLED + +module GEOS_WaveWatchGridCompMod + +! !USES: + + use ESMF + use MAPL_Mod + use NUOPC + use NUOPC_Model, only: label_Advance, label_DataInitialize + +! WW3 modules + use WMMAPLMD, only : WW3_SetServices => SetServices + + use, intrinsic :: ISO_FORTRAN_ENV + + implicit none + private + + +! Private state +! ------------- + + type WaveModel_State + private + + type(ESMF_Config) :: CF ! Private Config + + logical:: verbose = .false. ! verbose messages + + real :: dt = 0.0 ! wave model time step, s + + logical :: stokes = .true. ! output Stokes drift velocity fields + real, pointer, dimension(:) :: depths => null() ! depths for Stokes diagnostics + + end type WaveModel_State + + +! Hook for the ESMF +! ----------------- + type WaveModel_Wrap + type (WaveModel_State), pointer :: ptr => null() + end type WaveModel_Wrap + + +! !PUBLIC MEMBER FUNCTIONS: + + public SetServices + + integer :: WW3GC +!============================================================================= + +! !DESCRIPTION: +! +! + +!EOP + +contains + +!BOP + +! ! IROUTINE: SetServices -- Sets ESMF services for this component + +! ! INTERFACE: + + subroutine SetServices(GC, RC) + +! ! ARGUMENTS: + + type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component + integer, optional :: RC ! return code + +! ! DESCRIPTION: This version uses the MAPL_GenericSetServices. This function sets +! the Initialize and Finalize services, as well as allocating +! our instance of a generic state and putting it in the +! gridded component (GC). Here we only need to set the run method and +! add the state variable specifications (also generic) to our instance +! of the generic state. This is the way our true state variables get into +! the ESMF_State INTERNAL, which is in the MAPL_MetaComp. + +!EOP + +!============================================================================= +! +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Config) :: CF ! global config + + type (WaveModel_State), pointer :: self ! private internal state + type (WaveModel_Wrap) :: wrap + + +!============================================================================= + +! Begin... + +! Get my name and set-up traceback handle +! --------------------------------------- + + Iam = 'SetServices' + call ESMF_GridCompGet(GC, NAME=COMP_NAME, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Wrap the private internal state for storing in GC +! ------------------------------------------------- + + allocate(self, __STAT__) + wrap%ptr => self + +! Load private Config Attributes +! ------------------------------ + + self%CF = ESMF_ConfigCreate(__RC__) + +! call ESMF_ConfigLoadFile(self%CF, UMWM_CONFIG_FILE, __RC__) + +! process the config .... + +! add a child component (the NUOPC wrapped ww3) + ! this internally executes the SetServices method + ! of the child + WW3GC = MAPL_AddChild(GC, NAME='WW3', SS=WW3_SetServices, RC=STATUS) + VERIFY_(STATUS) + +! add import, export (and possibly internal) state variables + + +! Set the Initialize, Run entry point +! ----------------------------------- + +!ALT call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_INITIALIZE, Initialize, __RC__) +!ALT call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_RUN, Run, __RC__) +!ALT call MAPL_GridCompSetEntryPoint(GC, ESMF_METHOD_FINALIZE, Finalize, __RC__) + + +! Store private internal state in GC +! ---------------------------------- + call ESMF_UserCompSetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + +! Set the state variable specs. +! ----------------------------- + +! !INTERNAL STATE: + + +! !IMPORT STATE: + +!ALT: we need to zero these 3 +! impFieldName(i) = 'seahgt' +! impFieldStdName(i) = 'sea_surface_height_above_sea_level' +! impFieldName(i) = 'uucurr' +! impFieldStdName(i) = 'surface_eastward_sea_water_velocity' +! impFieldName(i) = 'vvcurr' +! impFieldStdName(i) = 'surface_northward_sea_water_velocity' + +! the next 3 are needed but have different names: 'uutrue','vvtrue','seaice' + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'U10M', & + LONG_NAME = '10-meter_eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'V10M', & + LONG_NAME = '10-meter_northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FRACI', & + LONG_NAME = 'ice_covered_fraction_of_tile', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, & + RESTART = MAPL_RestartSkip, __RC__) + + +! AGCM -> WGCM + + +! OGCM -> WGCM + + + +! !EXPORT STATE: + ! Name change: 'charno', 'z0rlen' + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'CHARNOCK', & + LONG_NAME = 'wave_model_charnock_coefficient', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'Z0', & + LONG_NAME = 'surface_roughness', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'USTAR', & + CHILD_ID = WW3GC, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'DCP', & + CHILD_ID = WW3GC, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'SWH', & + CHILD_ID = WW3GC, __RC__) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'EDF', & + CHILD_ID = WW3GC, __RC__) + + + + +! Set the Profiling timers +! ------------------------ + + call MAPL_TimerAdd(GC, name='TOTAL' , __RC__) + call MAPL_TimerAdd(GC, name='INITIALIZE' , __RC__) + call MAPL_TimerAdd(GC, name='RUN' , __RC__) + call MAPL_TimerAdd(GC, name='FINALIZE' , __RC__) + + + +!ALT: we need to terminate child's import so they do not "bubble up". We will fill them explicitly + +! this should be irrelevant here because the children are not MAPL components +! call MAPL_TerminateImport() + +! Set generic init and final methods +! ---------------------------------- + + call MAPL_GenericSetServices(GC, __RC__) + + RETURN_(ESMF_SUCCESS) + + end subroutine SetServices + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +#if 0 +- execute all of required NUOPC phases (0,1,3) +- phase 0 : general init +- phase 1: ww3 init, advertise the import and export fields +- phase 3: create grids, realize the fields +- create regridding route handles (import and export) +- regrid imports +#endif + +#if 0 +!BOP + +! ! IROUTINE: INITIALIZE -- Initialize method for the WM component + +! !INTERFACE: + + subroutine Initialize(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + + type(ESMF_Alarm) :: run_alarm + type(ESMF_TimeInterval) :: ring_interval + real(ESMF_KIND_R8) :: time_step + + type (WaveModel_State), pointer :: self ! private internal state + type (WaveModel_Wrap) :: wrap + +! Local Variables + + integer :: COMM ! MPI communicator from VM + integer :: myPE + integer :: nPEs + integer :: IM, JM, LM + integer :: IM_world, JM_world + integer :: I, J, K, L + + real, pointer, dimension(:,:) :: LATS => NULL() + real, pointer, dimension(:,:) :: LONS => NULL() + + integer :: COUNTS(ESMF_MAXDIM) + type (ESMF_GridComp), pointer :: GCS(:) => null() + type (ESMF_State), pointer :: GIM(:) => null() + type (ESMF_State), pointer :: GEX(:) => null() + + integer :: phases(3), p + character(len=ESMF_MAXSTR) :: lbl + character(len=ESMF_MAXSTR), parameter :: phase_lbl(2) = (/'IPDv03p1', 'IPDv03p3'/) + + type(ESMF_Time) :: currTime + type(ESMF_Field) :: field + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Initialize' + call ESMF_GridCompGet(GC, name=COMP_NAME, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + +! Get my internal private state +! ----------------------------- + call ESMF_UserCompGetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + self => wrap%ptr + + +! Get layout from the grid +! ------------------------ + + call ESMF_VMGetCurrent(VM, __RC__) + + call ESMF_VMGet(VM, mpiCommunicator=COMM, localPet=myPE, petCount=nPEs, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'INITIALIZE', __RC__) + +! Get parameters from generic state. +! ---------------------------------- + + call MAPL_Get(MAPL, GCS=GCS, GIM=GIM, GEX=GEX, RC=STATUS) + VERIFY_(STATUS) + + call MAPL_Set(MAPL, ChildInit=.false., RC=STATUS) + VERIFY_(STATUS) + + phases = [0,6,7] +! DO P=1,7 +! lbl='' +! k=p +! call NUOPC_CompSearchRevPhaseMap(GCS(WW3GC), & +! methodFlag=ESMF_METHOD_INITIALIZE, & +! phaseIndex=k, & +! phaseLabel=lbl, & +! rc=status) +! VERIFY_(STATUS) +! ASSERT_(lbl == phase_lbl(p)) +! print *,'WW3GC:phase ',p,k,trim(lbl) +! END DO + + !ALT at this point PHASES should be [0,6,7] + DO P = 1,3 + call ESMF_GridCompInitialize(GCS(WW3GC), importState=GIM(WW3GC), & + exportState=GEX(WW3GC), clock=clock, phase=PHASES(P), & + userRC=status ) + if (status /= 0) print *,'WW3GC_INIT: status ', status,' phase',P + VERIFY_(STATUS) + END DO + call ESMF_GridCompSet(GCS(WW3GC), clock=clock, __RC__) + +! time stamping + call ESMF_ClockGet(clock, currTime=currTime, rc=status) + VERIFY_(STATUS) +#if 0 + call ESMF_StateGet(GIM(WW3GC), "uutrue", field, rc=status) + VERIFY_(STATUS) + call NUOPC_SetTimestamp(field, currTime, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(GIM(WW3GC), "vvtrue", field, rc=status) + VERIFY_(STATUS) + call NUOPC_SetTimestamp(field, currTime, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(GIM(WW3GC), "seaice", field, rc=status) + VERIFY_(STATUS) + call NUOPC_SetTimestamp(field, currTime, rc=status) + VERIFY_(STATUS) +! print *,'calling DataInitialize' + call ESMF_MethodExecute (GCS(WW3GC), label=label_DataInitialize, RC=STATUS) + VERIFY_(STATUS) +#endif +! Get the grid +! ------------ +! this might be involved. If the call below does not work, we need to get a +! field for let say import state and then extract the grid + +#ifdef RUN_COUPLED + call ESMF_GridCompGet( GCS(WW3GC), grid=GRID, __RC__) + ! make this grid my own + call ESMF_GridCompSet( GC, grid=GRID, __RC__) +#endif + + +!ALT this is bad!!! + call MAPL_GridCompSetEntryPoint ( GCS(WW3GC), ESMF_METHOD_WRITERESTART, MAPL_GenericRecord, RC=STATUS) + VERIFY_(STATUS) + +! Call GenericInitialize +! ---------------------- + call MAPL_GenericInitialize(GC, IMPORT, EXPORT, CLOCK, __RC__) + + +! Get the time step +! ----------------- + call MAPL_Get(MAPL, RunAlarm=run_alarm, __RC__) + call ESMF_AlarmGet(run_alarm, ringInterval=ring_interval, __RC__) + + call ESMF_TimeIntervalGet(ring_interval, s_r8=time_step, __RC__) + self%dt = real(time_step) + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'INITIALIZE', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Initialize + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: RUN -- Run method for the WM component + +! !INTERFACE: + + subroutine Run(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + integer :: iSTAT + character(len=ESMF_MAXSTR) :: COMP_NAME + + +! Local derived type aliases + + type(WaveModel_State), pointer :: self => null() + type(WaveModel_Wrap) :: wrap + + type(MAPL_MetaComp), pointer :: MAPL + type (ESMF_State) :: INTERNAL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + +! Local Variables + + integer :: isd, ied, jsd, jed ! halo indexes + integer :: isc, iec, jsc, jec ! comp indexes + integer :: hwn + integer :: hwe + integer :: hws + integer :: hww + integer :: i1, in, j1, jn + +! Pointers from Import state + real, pointer :: U10M(:,:) => null() + real, pointer :: V10M(:,:) => null() + real, pointer :: fraci(:,:) => null() + +! Pointers to child's Import state + + real, pointer, dimension(:,:) :: uutrue => null() + real, pointer, dimension(:,:) :: vvtrue => null() + real, pointer, dimension(:,:) :: seaice => null() + +! Pointers to my Export state + + real, pointer, dimension(:,:) :: z0 => null() + real, pointer, dimension(:,:) :: charnock => null() + + +! Pointers to child's Export state + + real, pointer, dimension(:,:) :: z0rlen => null() + real, pointer, dimension(:,:) :: charno => null() + + type (ESMF_GridComp), pointer :: GCS(:) + type (ESMF_State), pointer :: GIM(:) + type (ESMF_State), pointer :: GEX(:) + + type (ESMF_Clock) :: myclock + type (ESMF_Time) :: currTime + type (ESMF_Field) :: field + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Run' + + call ESMF_GridCompGet(GC, name=COMP_NAME, GRID=GRID, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'RUN', __RC__) + +! Get parameters from generic state. +! ---------------------------------- + call MAPL_Get ( MAPL, GCS=GCS, GIM=GIM, GEX=GEX, RC=STATUS ) + VERIFY_(STATUS) + + call MAPL_GRID_INTERIOR(GRID,I1,IN,J1,JN) + i1 = i1-1 + j1 = j1-1 + +! Get my internal private state +! ----------------------------- + call ESMF_UserCompGetInternalState(GC, 'WaveModel_State', wrap, STATUS) + VERIFY_(STATUS) + + self => wrap%ptr + +! Get pointers to inputs +! ---------------------- + +#ifdef RUN_COUPLED + call MAPL_GetPointer(IMPORT, U10M, 'U10M', __RC__) + call MAPL_GetPointer(IMPORT, V10M, 'V10M', __RC__) + call MAPL_GetPointer(IMPORT, FRACI, 'FRACI', __RC__) + +! Get pointers to child's imports + call MAPL_GetPointer(GIM(WW3GC), UUTRUE, 'uutrue', __RC__) + call MAPL_GetPointer(GIM(WW3GC), VVTRUE, 'vvtrue', __RC__) + call MAPL_GetPointer(GIM(WW3GC), SEAICE, 'seaice', __RC__) + + isd = lbound(uutrue,1) + ied = ubound(uutrue,1) + jsd = lbound(uutrue,2) + jed = ubound(uutrue,2) + ! (isc:iec,jsc:jec) is the "computational" domain. + ! these should be used _only_ for WW3GC vars + +! Copy in. We need to be careful about the haloed vars + hww = lbound(u10m,1) + i1 - isd + hwe = ied - ubound(u10m,1) - i1 + hws = lbound(u10m,2) + j1 - jsd + hwn = jed - ubound(u10m,2) - j1 + + isc = isd + hwe + iec = ied - hww + jsc = jsd + hws + jec = jed - hwn + + uutrue = 0.0 + vvtrue = 0.0 + seaice = 0.0 + uutrue(isc:iec, jsc:jec) = u10m + vvtrue(isc:iec, jsc:jec) = v10m + seaice(isc:iec, jsc:jec) = fraci +#endif + +! Call WW3 +! ----------------- + if (MAPL_AM_I_Root()) write (OUTPUT_UNIT,*) 'DEBUG::WW3GC WW3 run...' + +!@ call ESMF_GridCompRun (GCS(WW3GC), importState=GIM(WW3GC), & +!@ exportState=GEX(WW3GC), clock=CLOCK, userRC=STATUS, RC = istat ) +!@ VERIFY_(STATUS) +! print *,'calling modelAdvance' + + myclock = ESMF_ClockCreate(clock, rc=status) + VERIFY_(STATUS) + call ESMF_ClockAdvance(myclock, rc=status) + VERIFY_(STATUS) + + call NUOPC_SetTimestamp(GEX(WW3GC), myclock, rc=status) + VERIFY_(STATUS) + +!ALT: i am not sure if we need to time stamp import state + call ESMF_ClockGet(myclock, currTime=currTime, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(GIM(WW3GC), "uutrue", field, rc=status) + VERIFY_(STATUS) + call NUOPC_SetTimestamp(field, currTime, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(GIM(WW3GC), "vvtrue", field, rc=status) + VERIFY_(STATUS) + call NUOPC_SetTimestamp(field, currTime, rc=status) + VERIFY_(STATUS) + call ESMF_StateGet(GIM(WW3GC), "seaice", field, rc=status) + VERIFY_(STATUS) + call NUOPC_SetTimestamp(field, currTime, rc=status) + VERIFY_(STATUS) + + call ESMF_MethodExecute (GCS(WW3GC), label=label_Advance, RC=STATUS) + VERIFY_(STATUS) + +! Get pointers from export state +! ------------------------------ +#ifdef ENABLE_EXPORTS + call MAPL_GetPointer(EXPORT, Z0, 'Z0', alloc=.true., __RC__) + call MAPL_GetPointer(EXPORT, CHARNOCK, 'CHARNOCK', alloc=.true., __RC__) + call MAPL_GetPointer(GEX(WW3GC), z0rlen, 'z0rlen', __RC__) + call MAPL_GetPointer(GEX(WW3GC), charno, 'charno', __RC__) + + ! Copy out. Again take only "computational" domain + if(associated(z0)) z0 = z0rlen(isc:iec, jsc:jec) + if(associated(charnock)) charnock = charno(isc:iec, jsc:jec) +#endif + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'RUN', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Run + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!BOP + +! ! IROUTINE: FINALIZE -- Finalize method for the WM component + +! !INTERFACE: + + subroutine Finalize(GC, IMPORT, EXPORT, CLOCK, RC) + +! !ARGUMENTS: + + type(ESMF_GridComp), intent(inout) :: GC ! Gridded component + type(ESMF_State), intent(inout) :: IMPORT ! Import state + type(ESMF_State), intent(inout) :: EXPORT ! Export state + type(ESMF_Clock), intent(inout) :: CLOCK ! The clock + integer, optional, intent( out) :: RC ! Error code: + +! ! DESCRIPTION: + +!EOP + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: Iam + integer :: STATUS + character(len=ESMF_MAXSTR) :: COMP_NAME + +! Local derived type aliases + + type(MAPL_MetaComp), pointer :: MAPL + type(ESMF_Grid) :: GRID + type(ESMF_VM) :: VM + +! Local global variables + + integer :: COUNTS(ESMF_MAXDIM) + +! Local Variables + + integer :: IM, JM, LM + integer :: IM_world, JM_world + integer :: COMM ! MPI communicator from VM + integer :: myPE + integer :: nPEs + +!============================================================================= + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + Iam = 'Finalize' + call ESMF_GridCompGet(GC, name=COMP_NAME, GRID=GRID, __RC__) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the state +! --------------------------------- + + call MAPL_GetObjectFromGC(GC, MAPL, __RC__) + + +! Start the timers +! ---------------- + + call MAPL_TimerOn(MAPL, 'TOTAL', __RC__) + call MAPL_TimerOn(MAPL, 'FINALIZE', __RC__) + + +! Get parameters from generic state. +! ---------------------------------- +! None + + +! Stop the timers +! --------------- + + call MAPL_TimerOff(MAPL, 'FINALIZE', __RC__) + call MAPL_TimerOff(MAPL, 'TOTAL', __RC__) + + +! Call GenericFinalize +! ---------------------- + call MAPL_GenericFinalize(GC, IMPORT, EXPORT, CLOCK, __RC__) + VERIFY_(STATUS) + + +! All Done +! -------- + + RETURN_(ESMF_SUCCESS) + + end subroutine Finalize + +#endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +end module GEOS_WaveWatchGridCompMod + diff --git a/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/ww3_multi_esmf/CMakeLists.txt b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/ww3_multi_esmf/CMakeLists.txt new file mode 100644 index 000000000..def626e20 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/ww3_multi_esmf/CMakeLists.txt @@ -0,0 +1,102 @@ +esma_set_this () + + +list( APPEND WW3ESMF_FTN + constants.ftn + w3adatmd.ftn + w3arrymd.ftn + w3cspcmd.ftn + w3dispmd.ftn + w3fldsmd.ftn + w3flx1md.ftn + w3gdatmd.ftn + w3gsrumd.ftn + w3idatmd.ftn + w3initmd.ftn + w3iobcmd.ftn + w3iogomd.ftn + w3iogrmd.ftn + w3iopomd.ftn + w3iorsmd.ftn + w3iosfmd.ftn + w3iotrmd.ftn + w3nmlmultimd.ftn + w3odatmd.ftn + w3parall.ftn + w3partmd.ftn + w3pro3md.ftn + w3profsmd.ftn + w3sbt1md.ftn + w3sdb1md.ftn + w3servmd.ftn + w3snl1md.ftn + w3sln1md.ftn + w3fld1md.ftn + w3fld2md.ftn + w3src4md.ftn + w3srcemd.ftn + w3timemd.ftn + w3triamd.ftn + w3updtmd.ftn + w3uqckmd.ftn + w3wavemd.ftn + w3wdasmd.ftn + w3wdatmd.ftn + wmmaplmd.ftn + wmfinlmd.ftn + wmgridmd.ftn + wminiomd.ftn + wminitmd.ftn + wmiopomd.ftn + wmmdatmd.ftn + wmscrpmd.ftn + wmunitmd.ftn + wmupdtmd.ftn + wmwavemd.ftn + SCRIP/scrip_constants.f + SCRIP/scrip_errormod.f90 + SCRIP/scrip_grids.f + SCRIP/scrip_interface.ftn + SCRIP/scrip_iounitsmod.f90 + SCRIP/scrip_kindsmod.f90 + SCRIP/scrip_netcdfmod.f90 + SCRIP/scrip_remap_conservative.f + SCRIP/scrip_remap_read.f + SCRIP/scrip_remap_vars.f + SCRIP/scrip_remap_write.f + SCRIP/scrip_timers.f +) + +esma_mepo_style(ww3 WW3_rel_path REL_PATH ..) +set (WW3_path ${CMAKE_CURRENT_SOURCE_DIR}/${WW3_rel_path}) + +get_filename_component(aux_dir ${WW3_path}/model/aux ABSOLUTE) +get_filename_component(ftn_dir ${WW3_path}/model/ftn ABSOLUTE) + +message(STATUS "WW3 aux_dir ${aux_dir}") +message(STATUS "WW3 ftn_dir ${ftn_dir}") + +add_executable(w3adc "${aux_dir}/w3adc.f") + +set (WW3ESMF_F90) +foreach(src_file ${WW3ESMF_FTN}) + STRING(REGEX REPLACE ".ftn" ".F90" gen_src_file ${src_file}) + STRING(REGEX REPLACE "/" "_" gen_log_file ${gen_src_file}) + add_custom_command( + OUTPUT ${gen_src_file} + BYPRODUCTS ${gen_src_file} + DEPENDS w3adc ${ftn_dir}/${src_file} + COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/run_w3adc.sh ${ftn_dir} ${src_file} > ${gen_log_file}.w3adc.log 2>&1 + COMMENT "Running w3adc ${src_file}") + list(APPEND WW3ESMF_F90 ${gen_src_file}) +endforeach() + + +esma_add_library (${this} + SRCS ${WW3ESMF_F90} + DEPENDENCIES MAPL esmf NetCDF::NetCDF_Fortran + ) + +target_include_directories (${this} PRIVATE + $ + ) diff --git a/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/ww3_multi_esmf/run_w3adc.sh b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/ww3_multi_esmf/run_w3adc.sh new file mode 100755 index 000000000..bef344bf4 --- /dev/null +++ b/GEOSwgcm_GridComp/GEOSwavewatch_GridComp/ww3_multi_esmf/run_w3adc.sh @@ -0,0 +1,29 @@ +#!/bin/bash +set -eux + +if [ $# -ne 2 ]; then + echo "Error in run_w3adc.sh" + exit 1 +fi + +ftn_dir=$1 +filename=$2 + +switches=$(cat ${ftn_dir}/../esmf/switch | tr '\n' ' ') + +extension="${filename##*.}" +basename="${filename%.*}" +inputname="${filename//\//_}.input" + +mkdir -p $( dirname ${filename} ) + +if [[ $extension == "ftn" ]]; then + echo "0 0" > ${inputname} + echo "'${ftn_dir}/${filename}' '${basename}.F90'" >> ${inputname} + echo "'${switches}'" >> ${inputname} + ./w3adc < ${inputname} +else + cp ${ftn_dir}/${filename} ${filename} +fi + +echo "Done running w3adc for ${filename}" diff --git a/GEOSwgcm_GridComp/WGCM.rc b/GEOSwgcm_GridComp/WGCM.rc new file mode 100644 index 000000000..051f42228 --- /dev/null +++ b/GEOSwgcm_GridComp/WGCM.rc @@ -0,0 +1,3 @@ +verbose: .true. + +wave_model: WW3 # Wave model: UMWM, WW3, JONSWAP, None diff --git a/GEOSwgcm_GridComp/bl_seaspray.F90 b/GEOSwgcm_GridComp/bl_seaspray.F90 new file mode 100644 index 000000000..e58a5d415 --- /dev/null +++ b/GEOSwgcm_GridComp/bl_seaspray.F90 @@ -0,0 +1,720 @@ + MODULE bl_seaspray_mod + +!------------------------------------------------------------------- +! From: +! Jian-Wen Bao [jian-wen.bao@noaa.gov] & Chris Fairall [chris.fairall@noaa.gov] (NOAA) +! Reference: +! Bao et al., Mon Wea Rev, 2011. 10.1175/MWR-D-11-00007.1 +! +! Code was provided by Jian-Wen Bao on 02/17/2015 +!------------------------------------------------------------------- +! Input variables +! +! UU ----------- wind speed at the lowest atm. level [m/s] +! ZU ----------- height of the lowest atm. model level [m] +! Ts ----------- sea surface temperature [C] +! Ta ----------- air temperature at the lowest model level [C] +! MR ----------- Mixing ratio at the lowest model level +! Patm ----------- Pressure at the lowest model level [mb] +! hwave ----------- significant wave height [m/s] +! cwave ----------- Phase speed of breaking wave [m] +! p ----------- Wave energy dissipation [(m/s)^3] +! usr ----------- Friction velocity [m/s] +! hss ----------- Sensible heat flux [W/m^2] +! hll ----------- Latent heat flux [W/m^2] +! +! Output variable +! +! usr_new --------- New friction velocity [m/s] +! fxh_seaspray ---- New sensible heat flux [W/m^2] +! fxe_seaspray ---- New latent heat flux [W/m^2] +! +! Implemented by Laura Bianco +!-------------------------------------------------------- + + +!-------------------------------------------------------- +! Example: +! +! real UU,ZU,Ts,Ta,MR,Patm,hwave,cwave,p,usr,hss_GFDL,hll_GFDL +! real usr_new,fxh_seaspray,fxe_seaspray +! real s,hss,hll,massf,hs_tot,hl_tot +! real S_bar1 +! real z_r,omega,alpha,vfm +! real sourcestrength_tune, feedback_tune +! +! ! Introducing the variables +! +! sourcestrength_tune = 0.4 ! Scales droplet mass flux, 0.5 = midway between Anreas/Fairall and de Leeuw +! feedback_tune = 0.2 ! Doesn't change droplet contribution to enthalphy flux, but changes balance +! ! between droplet Hs and Hl +! +! UU = 50. ! Wind speed +! ZU = 25. ! Reference height for bulk data +! Ts = 29. ! SST +! Ta = 27. ! Air T +! Patm = 980. ! Atmospheric pressure +! s = 0.90 ! Saturatoin ratio (Relative humidity % /100) +! hss = -999.0 ! Sensible heat flux +! hll = -999.0 ! Latent heat flux + +! ! Start of spray-mediated fluxes +! call execute_spray_param (sourcestrength_tune,feedback_tune,UU,ZU, +! & Ts,Ta,s,Patm,hss,hll,hwave,cwave,p,usr,massf,hs_tot, +! & hl_tot,usr_new,S_bar1,z_r,omega,alpha,vfm) +! +! print *, 'hss (W/m^2) = ', hss, 'hss_spray (W/m^2) = ', hs_tot +! print *, 'hll (W/m^2) = ', hll, 'hll_spray (W/m^2) = ', hl_tot +! print *, 'usr (m/s) = ', usr, 'usr_spray (m/s) = ', usr_new +! +! end +!-------------------------------------------------------- + + implicit none + + private + +#ifdef GEOS + public :: online_spray +#else + public :: execute_spray_param +#endif + + contains + + ! End of spray-mediated fluxes. + + + +#ifdef GEOS +!******************************************************** +! ESRL/PSD spray parameterization + + subroutine online_spray(sourcestrength_tune,feedback_tune, & + u,zu,ts,ta,s,Patm,hss,hll,hwave,cwave,p,usr, & + massf,hs_tot,hl_tot,usr_new,S_bar1,z_r, & + omega,alpha,vfm) + + implicit none + + real, intent(in) :: sourcestrength_tune,feedback_tune,u,zu,ts,ta, & + s,Patm,hwave,cwave,p + real, intent(inout) :: hss,hll + real, intent(out)::usr,massf,hs_tot,hl_tot,usr_new,S_bar1, & + z_r,omega,alpha + ! Output from spray_param subroutine. + real, intent(out) :: vfm + + ! Set constants and calculations + real :: Q, Le, gamma1, beta, wetdep + real :: rhoa ! Air density + !real, parameter :: tdk = 273.15 ! Celsius to Kelvin + real, parameter :: tdk = 273.6 ! Celsius to Kelvin + !real, parameter :: Rdgas = 287.05 ! Gas constant, dry air + real, parameter :: Rdgas = 287.1 ! Gas constant, dry air + real, parameter :: grav = 9.83 ! Gravitational acceleration + real, parameter :: kon = 0.40 ! von Karman constant + real, parameter :: rhow = 1e3 ! Water density + real, parameter :: cpa = 1004.67 ! Specific heat air + real, parameter :: cpw = 4.2e3 ! Specific heat water + + ! Wave properties + real :: h + + real, parameter :: nit = 3 ! Number of iterations of spray param + + + ! Gunn and Kinzer variables to compute iterated ustar. + real, parameter :: rho_0 = 1.20 ! Reference density + real, parameter :: Beta1 = 4.7 + real :: z + real :: sigma + real :: hsource + real :: k2,S_r + real :: cdzn,z0,U10 + + integer :: i ! Iteration of droplet buoyancy + + ! Calculated constants + Q = qsat(ta,Patm)*s/1e3 ! Saturation ratio (RH%/100) + Le = (2.501-0.00237*ts)*1e6 ! Latent heat vaporation + rhoa = Patm*100/(Rdgas*(ta+tdk)*(1+0.61*Q)) ! Air density + sigma = (rhow-rhoa)/rhoa + gamma1 = 241*17.501/(ta+241)**2 + beta = 1/(1+1e-3*qsat(ta,Patm)*Le/cpa*gamma1) + wetdep = (1-s)*(1-beta)/gamma1 + + + call find_ust(u,kon,zu,rhoa,rhow,hwave,cwave,p,usr,h,z0) + + z_r = z0 + z = zu + + ! Iterate spray_param until usr is stabilized (depends on massflux). + + call spray_param(sourcestrength_tune,feedback_tune,u,zu,hss, & + hll,ts,ta,s,Patm,usr,hwave,cwave,p,h, & + grav,kon,Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow, & + gamma1,beta,massf,U10,hs_tot,hl_tot,vfm) + + do i = 1,nit + + ! Droplet buoyancy + + ! Fall speed calculation + + k2 = 2.2*1e3*(rho_0/rhoa)**0.5 ! [cm^(1/2) s^(-1)] + k2 = k2*1e-2 ! [(m/s^2)^0.5] + + omega = vfm/(kon*usr) ! From Lykossov (2001) + + !hsource = 0.05 ! Set a height scale for the source (m) + hsource = 0.01*h ! Set a height scale for the source (m) + + sigma = (rhow-rhoa)/rhoa + S_r = massf/sigma/vfm/rhoa*(h/hsource)**omega ! Compute surface source from parameterization at wave height + alpha = (Beta1*grav*kon**2*z_r*sigma*S_r)/(usr**2) + + if (omega /= 1) then + + S_bar1 = (omega**-1)*log(1+((alpha*omega**2)/ & + (1-omega))*((z/z_r)**(1-omega)-1)) + + else + + S_bar1 = log(1+alpha*log(z/z_r)) + + endif + + usr_new = u*kon/(log(z/z0)+S_bar1) ! u* + cdzn = (usr_new/u)**2 ! Drag coefficient + +!! hss = -999.0 ! Sensible heat flux +!! hll = -999.0 ! Latent heat flux + + call spray_param(sourcestrength_tune,feedback_tune,u,zu,hss, & + hll,ts,ta,s,Patm,usr_new,hwave,cwave,p,h, & + grav,kon,Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow, & + gamma1,beta,massf,U10,hs_tot,hl_tot,vfm) + + end do + + return + + end subroutine online_spray +#endif + + +!******************************************************** +! ESRL/PSD spray parameterization + + subroutine execute_spray_param(sourcestrength_tune,feedback_tune, & + u,zu,ts,ta,s,Patm,hss,hll,hwave,cwave,p,usr, & + massf,hs_tot,hl_tot,usr_new,S_bar1,z_r, & + omega,alpha,vfm) + + implicit none + + real, intent(in) :: sourcestrength_tune,feedback_tune,u,zu,ts,ta, & + s,Patm + real, intent(inout) :: hss,hll + real, intent(out)::usr,massf,hs_tot,hl_tot,usr_new,S_bar1, & + z_r,omega,alpha + ! Output from spray_param subroutine. + real, intent(out) :: vfm + + ! Set constants and calculations + real :: Q, Le, gamma1, beta, wetdep + real :: rhoa ! Air density + !real, parameter :: tdk = 273.15 ! Celsius to Kelvin + real, parameter :: tdk = 273.6 ! Celsius to Kelvin + !real, parameter :: Rdgas = 287.05 ! Gas constant, dry air + real, parameter :: Rdgas = 287.1 ! Gas constant, dry air + real, parameter :: grav = 9.83 ! Gravitational acceleration + real, parameter :: kon = 0.40 ! von Karman constant + real, parameter :: rhow = 1e3 ! Water density + real, parameter :: cpa = 1004.67 ! Specific heat air + real, parameter :: cpw = 4.2e3 ! Specific heat water + + ! Wave properties + real :: hwave,cwave,p,h + + real, parameter :: nit = 3 ! Number of iterations of spray param + + + ! Gunn and Kinzer variables to compute iterated ustar. + real, parameter :: rho_0 = 1.20 ! Reference density + real, parameter :: Beta1 = 4.7 + real :: z + real :: sigma + real :: hsource + real :: k2,S_r + real :: cdzn,z0,U10 + + integer :: i ! Iteration of droplet buoyancy + + ! Calculated constants + Q = qsat(ta,Patm)*s/1e3 ! Saturation ratio (RH%/100) + Le = (2.501-0.00237*ts)*1e6 ! Latent heat vaporation + rhoa = Patm*100/(Rdgas*(ta+tdk)*(1+0.61*Q)) ! Air density + sigma = (rhow-rhoa)/rhoa + gamma1 = 241*17.501/(ta+241)**2 + beta = 1/(1+1e-3*qsat(ta,Patm)*Le/cpa*gamma1) + wetdep = (1-s)*(1-beta)/gamma1 + + call find_ust(u,kon,zu,rhoa,rhow,hwave,cwave,p,usr,h,z0) + + z_r = z0 + z = zu + + ! Iterate spray_param until usr is stabilized (depends on massflux). + + call spray_param(sourcestrength_tune,feedback_tune,u,zu,hss, & + hll,ts,ta,s,Patm,usr,hwave,cwave,p,h, & + grav,kon,Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow, & + gamma1,beta,massf,U10,hs_tot,hl_tot,vfm) + + do i = 1,nit + + ! Droplet buoyancy + + ! Fall speed calculation + + k2 = 2.2*1e3*(rho_0/rhoa)**0.5 ! [cm^(1/2) s^(-1)] + k2 = k2*1e-2 ! [(m/s^2)^0.5] + + omega = vfm/(kon*usr) ! From Lykossov (2001) + + !hsource = 0.05 ! Set a height scale for the source (m) + hsource = 0.01*h ! Set a height scale for the source (m) + + sigma = (rhow-rhoa)/rhoa + S_r = massf/sigma/vfm/rhoa*(h/hsource)**omega ! Compute surface source from parameterization at wave height + alpha = (Beta1*grav*kon**2*z_r*sigma*S_r)/(usr**2) + + if (omega /= 1) then + + S_bar1 = (omega**-1)*log(1+((alpha*omega**2)/ & + (1-omega))*((z/z_r)**(1-omega)-1)) + + else + + S_bar1 = log(1+alpha*log(z/z_r)) + + endif + + usr_new = u*kon/(log(z/z0)+S_bar1) ! u* + cdzn = (usr_new/u)**2 ! Drag coefficient + + hss = -999.0 ! Sensible heat flux + hll = -999.0 ! Latent heat flux + + call spray_param(sourcestrength_tune,feedback_tune,u,zu,hss, & + hll,ts,ta,s,Patm,usr_new,hwave,cwave,p,h, & + grav,kon,Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow, & + gamma1,beta,massf,U10,hs_tot,hl_tot,vfm) + + end do + + return + + end subroutine execute_spray_param + +!***************************************************************** + + subroutine find_ust(u,kon,zu,rhoa,rhow,hwave,cwave,p, & + usr,h,z0) + + implicit none + real :: z0 + real :: cd10n + real :: cdhf ! sqrt(drag coefficient) + real :: cdzn ! Drag coefficient + real :: usr ! Ustar (m/s) + real :: hwave ! Wave significant height (m) + real :: cwave ! Wave phase speed (m/s) + real :: h ! Wave top height above mean sea level (m) + real :: U10 ! 10m wind speed + real :: p ! Energy input by breaking of waves (m/s)^3 right behind the breaker + real :: u,kon,zu,rhoa,rhow,wab,cw10,aa,ab,ac + integer :: i + real, parameter :: grav = 9.83 + real, parameter :: pi = 3.14159265359 + integer :: ustx + real :: cEwave,twave,a,b,charn + real :: ustw + +#ifdef GEOS + ustx = -4 +#else + ustx = -1 +#endif + ! -1 uses parametrized wave state (cwave, hwave, and p all parameterized) + ! It also finds initial ustar to feed into spray parameterization + ! -2 uses cwave from input and hwave and p parameterized + ! -3 uses cwave and hwave from input and p parameterized + ! -4 uses cwave, hwave, and p from input + ! -5 uses cwave and p from input and hwave parameterized + + select case (ustx) + + case (-1) + + U10 = u*log(10/1e-3)/log(zu/1e-3) + do i = 1,3 + cwave = 7.+10.*U10/75. ! Parameterized cwave + wab = min(2.,cwave/U10) + cw10 = U10 + aa = 0.241+1.9e-3*cw10-7e-6*cw10**2-0.123/exp(cw10/10) + ab = 0.0797-10.5e-3*cw10+9.4e-5*cw10**2-0.181/exp(cw10/10) + ac = -0.159+9.3e-3*cw10-9.1e-5*cw10**2+0.229/exp(cw10/10) + cd10n = (0.94+0.06*(1.-exp(-U10/10.))) & + *(aa+ab*wab+ac*wab*wab)*1e-2 + z0 = 10./exp(kon/sqrt(cd10n)) + cdzn = (kon/log(zu/z0))**2 + cdhf = sqrt(cdzn) + usr = u*cdhf + U10 = usr/sqrt(cd10n) + enddo + hwave = 5.+10.*U10/80. ! Parameterized hwave + h = hwave/2. ! Wave top height above mean sea level + cEwave = 1.*(-0.4+0.25*U10) + p = rhoa*cEwave*usr**2/rhow ! Parameterized p + if (p .lt. 0.0) then + p = rhoa/rhow*3.5*usr**3.5 ! If p<0 we use the old parameterization + endif + + case (-2) + + z0 = zu/exp(kon*u/usr) + cd10n = (kon/log(10./z0))**2 + U10 = usr/sqrt(cd10n) + + hwave = 5.+10.*U10/80. ! parameterized hwave + h = hwave/2 + cEwave = 1.*(-0.4+0.25*U10) + p = rhoa*cEwave*usr**2/rhow ! parameterized p + if (p .lt. 0.0) then + p = rhoa/rhow*3.5*usr**3.5 + endif + + case (-3) + + z0 = zu/exp(kon*u/usr) + cd10n = (kon/log(10./z0))**2 + U10 = usr/sqrt(cd10n) + + h = hwave/2 + cEwave = 1.*(-0.4+0.25*U10) + p = rhoa*cEwave*usr**2/rhow ! parameterized p + if (p .lt. 0.0) then + p = rhoa/rhow*3.5*usr**3.5 + endif + + case (-4) + + z0 = zu/exp(kon*u/usr) + cd10n = (kon/log(10./z0))**2 + U10 = usr/sqrt(cd10n) + + h = hwave/2 + + case (-5) + + z0 = zu/exp(kon*u/usr) + cd10n = (kon/log(10./z0))**2 + U10 = usr/sqrt(cd10n) + hwave = 5.+10.*U10/80. ! parameterized hwave + + h = hwave/2 + + end select + + return + + end subroutine find_ust + +!************************************************************ + + subroutine spray_param(sourcestrength,feedtune,Uz,zu,hss, & + hll,ts,ta,s,Patm,ust,hwave,cwave,p,h, & + grav,kon,Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow, & + gamma1,beta,massf,U10,hs_tot,hl_tot,vfm) + + !Input + !sourcestrength 1.0 = original Andreas and Fairall; reccommended ~ 0.3 + !Uz Wind speed (m/s) at height zu + !zu Height (m) of bulk met data + !hss Sensible heat carried by turbulence from bulk algorithm (set to -999 if not available) + !hll Latent heat flux carried by water vapor from bulk algorithm (set to -999 if not available) + !ts Sea surface temperature (C) at zu + !ta Air temperature (C) at zu + !s Water vapor Saturation ratio (= RH (%)/100) at zu + !Patm Pressure (mb) + !ust Friction velocity (m/s) from wave model + !hwave Significant wave height (m) + !cwave Phase speed of breaking waves (m/s) + !p Wave energy dissipation (m/s)^3 + !h Wave top height (m) + !grav Gravitational acceleration constant (m/s^2) + !kon von Karman constant + !Q Specific humidity (RH%/100) + !tdk Celsius to Kelvin + !Rdgas Gas constant, dry air + !Le Latent heat vaporization + !cpa Air specific heat + !rhoa Air density + !cpw Water specific heat + !rhow Water density + !visa Air kinematic viscosity + + !Output + !hsd Sensible heat carried by droplet mass flux + !hld Latent heat flux carried by droplet evaporation, including feedback effects + !hss Sensible heat carried by turbulence if not passed by input + !hll Latent heat flux carried by water vapor, if not passed by input + !feed Feedback coefficient (0 to 1) computed in the model, a small value means no feedback + !massf Mass flux of sea spray in kg/m^2/s + !U10 Wind speed at 10-m height, used for other calculations + !hs_tot Total sensible heat flux realized above dropletlayer=hss+hsd_hs_epsilon+rho*cp*U*Ch*dtf + !hl_tot Total latent heat flux realized above dropletlayer=hll+hld-rho*cp*U*Ch*dtf + !hs_eps Heat energy dissipated in the atmospheric surface layer + !hsde Total droplet heat transfer before feedback + !rmx 1-third power of third moment of droplet size spectral density (micron) + !vmx Mass weighted droplet fall velocity (m/s) + + !Comments + !Evaporation in the droplet layer cools air by dtf and increases saturation by dqf + !dtf is determined integrating the flux profile through the evaporation layer + !Total enthalpy transfer to the atmosphere (neglecting dissipation) is hss+hll+hsdr + !Total sensible tansfer is hss+hsdr-hldr+rho*Le*U*Ch*dtq + !Total latent transfer is hll+hldr-rho*cp*U*Ch*dtf + + !References + !Fairall et al, 1994, GLobal Atmos Ocean Syst., 2, 121-142 + !Bao et al., 2000, Mon Wea Rev., 128, 2190-2210 + + implicit none + + !Input + real :: sourcestrength, feedtune + real :: Uz,zu,hss,hll,ts,ta,s,Patm,ust,hwave,cwave,p,h,grav,kon, & + Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow,gamma1,beta + !Output + real :: hsd,hld,tau,feed,massf,U10, & + hs_tot,hl_tot,dtf,hs_eps,hsde + + !For U10 and bulk fluxes + real :: ustr,z0,charn,cd10n,cdzn2,dti,dt + real :: zot,rmy,visa,Rr + + !From drop_source + real :: rm,vfm + + !Source area and volume + real :: sfcc,sfcc2,sfcb,Sa,Sv + + !Fluxes + real :: wetdep,qll0 + + !For feedback + !Flux gradient model + real :: zl,zm,Gh4,Gq4,Zo4,qqs0_4,bow,qllp0,sp4,Hso4,Hlo4,hsde4, & + Dtf0,Dqf0,hld4,Hst4,Hlt4,Dtf4,Dqf4,Qs4,Q4,bow4,hsd4, & + hsdl4,qllp4,feed4,hs_tot4,hl_tot4,dqf + !Bao enthalpy model + real :: baotime,dtime,hsde5,tw,hsde50,hld5,fe0,fe,numx05, & + denx05,tap0,dtf5,sp5,bow5,hsd5,hsdl5,numx5,denx5,tap, & + qllp5,dqf5,feed5,hs_tot5,hl_tot5 + + real, parameter :: pi = 3.14159265359 + real :: ctznh,hh + integer :: i,j + integer :: feedt + +! print *, sourcestrength,feedtune,Uz,zu,hss +! print *, hll,ts,ta,s,Patm,ust,hwave,cwave,p,h +! print *, grav,kon,Q,tdk,Rdgas,Le,cpa,rhoa,cpw,rhow +! print *, gamma1,beta,massf,U10,hs_tot,hl_tot,vfm + + visa = 1.326e-5*(1+6.542e-3*ta+8.301e-6*ta**2-4.84e-9*ta**3) + + !Estimate u10 and bulk fluxes + if (ust > 0) then + ustr = ust + z0 = zu/exp(kon*Uz/ustr) + z0 = max(z0,1e-4) + else + charn = 0.018 + ustr = 0.04*Uz + do i = 1,10 + z0 = charn*ustr**2/grav + cd10n = min(3.5e-3,(kon/log(10/z0))**2) ! cd is not allowed to exceed 3.5e-3 + z0 = 10/exp(kon/sqrt(cd10n)) + cdzn2 = (kon/log(zu/z0))**2 + ustr = Uz*sqrt(cdzn2) + enddo + endif + tau = rhoa*ustr**2 + U10 = ustr*log(10/z0)/kon + dt = ts-0.3-ta + Rr = ustr*z0/visa + zot = min(1.1e-5,5.5e-5*Rr**-0.6) ! coare 3.0 scalar roughtnes + ctznh = 0.4/log(zu/zot) + + if (hll .lt. -900) then + hll = rhoa*Le*ctznh*ustr*1e-3* & + (0.98*qsat(ts-0.3,Patm)-qsat(ta,Patm)*s) ! Direct turbulent moisture flux, no feedback + endif + + if (hss .lt. -900) then + hss = rhoa*cpa*ctznh*dt*ustr ! Direct turbulent sensible, no feedback + endif +! print *, 'hss =', hss, 'hll = ', hll + h = hwave/2 + hh = max(0.03*h,10*z0) ! Gust level height + vfm = (Uz+cwave/2-ustr/0.4*log(zu/hh))*0.07*1.15-0.3 ! Estimate mean fall velocity +#ifdef GEOS + vfm = max(vfm,1e-6) +#else + vfm = max(vfm,0.0) +#endif + rm = (50*vfm**0.7+14) ! Estimate mass mean radius (micron) + rm = (150*vfm**0.8+5) ! Estimate mass mean radius (micron) + rmy = 55*vfm**0.7+20. + Sv = 1.e-5*(1+(h/3)**0.1)*(rmy/50)**2.5 ! Normalized source volume m/s + Sa = 1.2*(p/6e-4)**0.15*(rmy/73)**-1 ! Normalized source area 1/s + massf = sourcestrength*rhow*p*Sv + + ! Droplet and turbulent fluxes + wetdep = (1-s)*(1-beta)/gamma1 ! Wet bulb depression + qll0 = sourcestrength*Sa*p*h*rhoa*Le*1e-3*qsat(ta,Patm)*beta & ! Estimate of qll from parameterization + *(1-s)*(1-0.27*(1+1/(1-s))**(1.0/3.0)) + hsde = 0.92*cpw*massf*(dt+wetdep) ! Droplet enthalpy flux; 0.92 is loss of heat not + ! transfered from very large droplets + hs_eps = 0.5*rhoa*ustr**3/kon*(log(h/10)+kon*U10/ustr)! Dissipation heating in droplet layer + + feedt = int(feedtune) + + select case (feedt) + + case (-999) + zl = 0.1*h + zm = h + Gh4 = rhoa*cpa*0.4*ustr + Gq4 = rhoa*Le*0.4*ustr + Zo4 = 10/exp(kon**2/1.1e-3/log(10/z0)) + qqs0_4 = 0.92*sourcestrength*p*Sv*rhow*cpw*(dt+wetdep) + bow = dt/wetdep + qllp0 = qll0 + bow/(1+bow)*hsde + sp4 = s + Hso4 = hss + Hlo4 = hll + hsde4 = hsde + Dtf0 = 0 + Dqf0 = 0 + do i = 1,20 + hld4 = sourcestrength*Sa*p*h*rhoa*Le*1e-3*qsat(ta,Patm)* & + beta*(1-sp4)*(1-0.27*(1+1/(1-sp4))**(1.0/3.0)) + Hst4 = Hso4+qqs0_4-hld4 + Hlt4 = Hlo4+hld4 + Dtf4 = -(Hst4-Hso4)*(1-zl/(zm-zl)*log(zm/zl))/Gh4 + Dqf4 = (Hlt4-Hlo4)*(1-zl/(zm-zl)*log(zm/zl))/Gq4 + Dtf0 = Dtf0-0.2*(Dtf0-Dtf4) + Dqf0 = Dqf0-0.2*(Dqf0-Dqf4) + Qs4 = qsat(ta-Dtf0,Patm)/1e3 ! Specific humidity (kg/kg) + Q4 = Q+Dqf4 + sp4 = Q4/Qs4 + bow4 = (ts-(ta-Dtf4))/(wetdep-Dtf4) + hsd4 = hsde4*bow4/(1+bow4) + hsdl4 = hsde4-hsd4 + end do + qllp4 = hld4+hsdl4 + feed4 = (qllp4-rhoa*Le*U10*1.1e-3*Dqf4)/qllp0 + hs_tot4 = hss+hsd4-hld4+hs_eps+rhoa*cpa*U10*1e-3*Dtf4 + hld4 = hld4+hsdl4 + hl_tot4 = hll+hld4-rhoa*Le*U10*1e-3*Dqf4 + + hld = hld4 + hsd = hsd4 + hs_tot = hs_tot4 + hl_tot = hl_tot4 + feed = feed4 + dtf = Dtf4 + dqf = Dqf4 + + case default + baotime = 40*feedtune + dtime = 0.5*h/vfm*baotime + hsde5 = hsde + bow = dt/wetdep + tw = ta-wetdep + hsde50 = bow/(1+bow)*hsde + hld5 = sourcestrength*Sa*p*h*rhoa*Le*1e-3*qsat(ta,Patm)* & + beta*(1-s)*(1-0.27*(1+1/(1-s))**(1.0/3.0)) + qllp0 = qll0+bow/(1+bow)*hsde + fe0 = hld5/Le/massf + fe = fe0 + numx05 = cpw*massf/h*(dt+(1-fe)*(ta-tw))-Le*fe*massf/h + denx05 = cpa*rhoa+cpa*fe*massf/h*dtime + tap0 = -dtime*numx05/denx05 + tap = tap0 + dtf5 = 0 + do i = 1,20 ! Feedback parameterization + dtf5 = dtf5+0.1*(tap-dtf5) ! Change in air temperature caused by droplet evaporation + dtf5 = max(dtf5,-0.1) + sp5 = s+dtf5*gamma1/(1-beta) ! Saturation ratio, after feedback effects + !print *, s, dtf5, gamma1, beta + sp5 = min(sp5,0.98) ! Doesn't allow to exceed seawater saturation + bow5 = (ts-(ta-dtf5))/(wetdep-dtf5) ! Ratio of droplet sensible to evap heats to get to wet bulb temp + hsd5 = hsde5*bow5/(1.0+bow5) + hsdl5 = hsde5-hsd5 + hld5 = sourcestrength*Sa*p*h*rhoa*Le*1e-3* & + qsat(ta,Patm)*beta*(1-sp5)* & + (1.0-0.27*(1.0+1.0/(1.0-sp5))**(1.0/3.0)) + fe = hld5/Le/massf + numx5 = cpw*massf/h*(dt+dtf5+(1.0-fe)* & + (ta-dtf5-tw))-Le*fe*massf/h + denx5 = cpa*rhoa+cpa*fe*massf/h*dtime + tap = -dtime*numx5/denx5 + enddo + qllp5 = hld5+hsdl5 + dqf5 = cpa/Le*dtf5 + feed5 = (qllp5-rhoa*Le*U10*1.1e-3*dqf5)/qllp0 + hs_tot5 = hss+hsd5-hld5+hs_eps+rhoa*cpa*U10*1e-3*dtf5 ! With this formulation the term -hld5 might + ! make hs_tot5 too negative. + ! The next line is the new formulation with -hld5 removed. + ! hs_tot5 = hss+hsd5+hs_eps+rhoa*cpa*U10*1e-3*dtf5 + hld5 = hld5 + hsdl5 !lb note: Chirs's code is hld4 = hld5 + hsdl5 but I think it is wrong + hl_tot5 = hll+hld5-rhoa*Le*U10*1e-3*dqf5 + + hld = hld5 + hsd = hsd5 + hs_tot = hs_tot5 + hl_tot = hl_tot5 + feed = feed5 + dtf = dtf5 + dqf = dqf5 + end select + + return + + end subroutine spray_param + +!********************************************************** + + real function qsat(ta,Patm) + + implicit none + real :: ta, Patm + real :: es + es = 6.112*exp(17.502*ta/(ta+241.0))*(1.0007+3.46e-6*Patm) + qsat = es*622/(Patm-0.378*es) + + return + + end function qsat + +!************************************************************ + +end module bl_seaspray_mod